Metabase


The simplest, fastest way to get business intelligence and analytics to everyone in your company 😋




(this space intentionally left almost blank)

namespaces

 

Metabase Backend Developer Documentation

Welcome to Metabase! Here are links to useful resources.

Project Management

Dev Environment

Important Parts of the Codebase

Important Libraries


Put everything needed for REPL development within easy reach

(ns dev
  (:require
   [clojure.core.async :as a]
   [clojure.string :as str]
   [dev.debug-qp :as debug-qp]
   [dev.explain :as dev.explain]
   [dev.model-tracking :as model-tracking]
   [honey.sql :as sql]
   [java-time :as t]
   [malli.dev :as malli-dev]
   [metabase.api.common :as api]
   [metabase.config :as config]
   [metabase.core :as mbc]
   [metabase.db.connection :as mdb.connection]
   [metabase.db.env :as mdb.env]
   [metabase.db.setup :as mdb.setup]
   [metabase.driver :as driver]
   [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn]
   [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute]
   [metabase.models.database :refer [Database]]
   [metabase.query-processor :as qp]
   [metabase.query-processor.timezone :as qp.timezone]
   [metabase.server :as server]
   [metabase.server.handler :as handler]
   [metabase.sync :as sync]
   [metabase.test :as mt]
   [metabase.test.data.impl :as data.impl]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [methodical.core :as methodical]
   [potemkin :as p]
   [toucan2.connection :as t2.connection]
   [toucan2.core :as t2]
   [toucan2.pipeline :as t2.pipeline]))
(set! *warn-on-reflection* true)
(comment
  debug-qp/keep-me
  model-tracking/keep-me)
(defn tap>-spy [x]
  (doto x tap>))
(p/import-vars
 [debug-qp
  process-query-debug
  pprint-sql]
 [dev.explain
  explain-query]
 [model-tracking
  track!
  untrack!
  untrack-all!
  reset-changes!
  changes])
(def initialized?
  (atom nil))
(defn init!
  []
  (mbc/init!)
  (reset! initialized? true))

Returns a UTC timestamp in format yyyy-MM-dd'T'HH:mm:ss that you can used to postfix for migration ID.

(defn migration-timestamp
  []
  (t/format (t/formatter "yyyy-MM-dd'T'HH:mm:ss") (t/zoned-date-time (t/zone-id "UTC"))))

Finds in-memory Databases for which the underlying in-mem h2 db no longer exists.

(defn deleted-inmem-databases
  []
  (let [h2-dbs (t2/select :model/Database :engine :h2)
        in-memory? (fn [db] (some-> db :details :db (str/starts-with? "mem:")))
        can-connect? (fn [db]
                       (binding [metabase.driver.h2/*allow-testing-h2-connections* true]
                         (try
                           (driver/can-connect? :h2 (:details db))
                           (catch org.h2.jdbc.JdbcSQLNonTransientConnectionException _
                             false)
                           (catch Exception e
                             (log/error e "Error checking in-memory database for deletion")
                             ;; we don't want to delete these, so just pretend we could connect
                             true))))]
    (remove can-connect? (filter in-memory? h2-dbs))))

Delete any in-memory Databases to which we can't connect (in order to trigger cleanup of their related tasks, which will otherwise spam logs).

(defn prune-deleted-inmem-databases!
  []
  (when-let [outdated-ids (seq (map :id (deleted-inmem-databases)))]
    (t2/delete! :model/Database :id [:in outdated-ids])))
(defn start!
  []
  (server/start-web-server! #'handler/app)
  (when-not @initialized?
    (init!))
  (when config/is-dev?
    (prune-deleted-inmem-databases!)
    (with-out-str (malli-dev/start!))))
(defn stop!
  []
  (malli-dev/stop!)
  (server/stop-web-server!))
(defn restart!
  []
  (stop!)
  (start!))

Unmap all interned vars in a namespace. Reset the namespace to a blank slate! Perfect for when you rename everything and want to make sure you didn't miss a reference or when you redefine a multimethod.

(ns-unmap-all ns)

(defn ns-unmap-all
  ([]
   (ns-unmap-all *ns*))
  ([a-namespace]
   (doseq [[symb] (ns-interns a-namespace)]
     (ns-unmap a-namespace symb))
   (doseq [[symb varr] (ns-refers a-namespace)
           :when (not= (the-ns (:ns (meta varr)))
                       (the-ns 'clojure.core))]
     (ns-unmap a-namespace symb))))

Remove all aliases for other namespaces from the current namespace.

(ns-unalias-all ns)

(defn ns-unalias-all
  ([]
   (ns-unalias-all *ns*))
  ([a-namespace]
   (doseq [[symb] (ns-aliases a-namespace)]
     (ns-unalias a-namespace symb))))

Rather than requiring all models in the ns declaration, make it easy to require the ones you need for your current session

(defmacro require-model
  [model-sym]
  `(require [(symbol (str "metabase.models." (quote ~model-sym))) :as (quote ~model-sym)]))

Execute the body with the given permissions.

(defmacro with-permissions
  [permissions & body]
  `(binding [api/*current-user-permissions-set* (delay ~permissions)]
     ~@body))

Execute a SQL query against a JDBC database. Useful for testing SQL syntax locally.

(query-jdbc-db :oracle SELECT to_date('1970-01-01', 'YYYY-MM-DD') FROM dual")

sql-args can be either a SQL string or a tuple with a SQL string followed by any prepared statement args. By default this method uses the same methods to set prepared statement args and read columns from results as used by the :sql-jdbc Query Processor, but you pass the optional third arg options, as nil to use the driver's default behavior.

You can query against a dataset other than the default test data DB by passing in a [driver dataset] tuple as the first arg:

(dev/query-jdbc-db [:sqlserver 'test-data-with-time] ["SELECT * FROM dbo.users WHERE dbo.users.lastlogintime > ?" (java-time/offset-time "16:00Z")])

(defn query-jdbc-db
  {:arglists '([driver sql]            [[driver dataset] sql]
               [driver honeysql-form]  [[driver dataset] honeysql-form]
               [driver [sql & params]] [[driver dataset] [sql & params]])}
  [driver-or-driver+dataset sql-args]
  (let [[driver dataset] (u/one-or-many driver-or-driver+dataset)
        [sql & params]   (if (map? sql-args)
                           (sql/format sql-args)
                           (u/one-or-many sql-args))
        canceled-chan    (a/promise-chan)]
    (try
      (driver/with-driver driver
        (letfn [(thunk []
                  (let [db (mt/db)]
                    (sql-jdbc.execute/do-with-connection-with-options
                     driver
                     db
                     {:session-timezone (qp.timezone/report-timezone-id-if-supported driver db)}
                     (fn [conn]
                       (with-open [stmt (sql-jdbc.execute/prepared-statement driver conn sql params)
                                   rs   (sql-jdbc.execute/execute-prepared-statement! driver stmt)]
                         (let [rsmeta (.getMetaData rs)]
                           {:cols (sql-jdbc.execute/column-metadata driver rsmeta)
                            :rows (reduce conj [] (sql-jdbc.execute/reducible-rows driver rs rsmeta canceled-chan))}))))))]
          (if dataset
            (data.impl/do-with-dataset (data.impl/resolve-dataset-definition *ns* dataset) thunk)
            (thunk))))
      (catch InterruptedException e
        (a/>!! canceled-chan :cancel)
        (throw e)))))

Run migrations for the Metabase application database. Possible directions are :up (default), :force, :down, and :release-locks. When migrating :down pass along a version to migrate to (44+).

(defn migrate!
  ([]
   (migrate! :up))
  ([direction & [version]]
   (mdb.setup/migrate! (mdb.connection/db-type) (mdb.connection/data-source)
                       direction version)))
(methodical/defmethod t2.connection/do-with-connection :model/Database
  "Support running arbitrary queries against data warehouse DBs for easy REPL debugging. Only works for SQL+JDBC drivers
  right now!
    ;; use Honey SQL
    (t2/query (t2/select-one Database :engine :postgres, :name \"test-data\")
              {:select [:*], :from [:venues]})
    ;; use it with `select`
    (t2/select :conn (t2/select-one Database :engine :postgres, :name \"test-data\")
               \"venues\")
    ;; use it with raw SQL
    (t2/query (t2/select-one Database :engine :postgres, :name \"test-data\")
              \"SELECT * FROM venues;\")"
  [database f]
  (t2.connection/do-with-connection (sql-jdbc.conn/db->pooled-connection-spec database) f))
(methodical/defmethod t2.pipeline/build [#_query-type     :default
                                         #_model          :default
                                         #_resolved-query :mbql]
  [_query-type _model _parsed-args resolved-query]
  resolved-query)
(methodical/defmethod t2.pipeline/compile [#_query-type  :default
                                           #_model       :default
                                           #_built-query :mbql]
  "Run arbitrary MBQL queries. Only works for SQL right now!
    ;; Run a query against a Data warehouse DB
    (t2/query (t2/select-one Database :name \"test-data\")
              (mt/mbql-query venues))
    ;; Run MBQL queries against the application database
    (t2/query (dev/with-app-db (mt/mbql-query core_user {:aggregation [[:min [:get-year $date_joined]]]})))
    =>
    [{:min 2023}]"
  [_query-type _model built-query]
  ;; make sure we use the application database when compiling the query and not something goofy like a connection for a
  ;; Data warehouse DB, if we're using this in combination with a Database as connectable
  (let [{:keys [query params]} (binding [t2.connection/*current-connectable* nil]
                                 (qp/compile built-query))]
    (into [query] params)))

Add the application database as a Database. Currently only works if your app DB uses broken-out details!

(defn app-db-as-data-warehouse
  []
  (binding [t2.connection/*current-connectable* nil]
    (or (t2/select-one Database :name "Application Database")
        (let [details (#'metabase.db.env/broken-out-details
                       (mdb.connection/db-type)
                       @#'metabase.db.env/env)
              app-db  (first (t2/insert-returning-instances! Database
                                                             {:name    "Application Database"
                                                              :engine  (mdb.connection/db-type)
                                                              :details details}))]
          (sync/sync-database! app-db)
          app-db))))

Use the app DB as a Database and bind it so [[metabase.test/db]], [[metabase.test/mbql-query]], and the like use it.

(defmacro with-app-db
  [& body]
  `(let [db# (app-db-as-data-warehouse)]
     (mt/with-driver (:engine db#)
       (mt/with-db db#
         ~@body))))
 

TODO -- I think this should be moved to something like [[metabase.test.util.debug-qp]]

(ns dev.debug-qp
  (:require
   [clojure.pprint :as pprint]
   [clojure.string :as str]
   [clojure.walk :as walk]
   [lambdaisland.deep-diff2 :as ddiff]
   [medley.core :as m]
   [metabase.db.query :as mdb.query]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.field :refer [Field]]
   [metabase.models.table :refer [Table]]
   [metabase.query-processor :as qp]
   [metabase.query-processor.reducible :as qp.reducible]
   [metabase.util :as u]
   [toucan2.core :as t2]))

[[->sorted-mbql-query-map]]

(def ^:private mbql-clause->sort-order
  (into {}
        (map-indexed (fn [i k]
                       [k i]))
        [;; top-level keys
         :database
         :type
         :query
         :native
         ;; inner-query and join keys
         :source-table
         :source-query
         :source-metadata
         :alias
         :joins
         :expressions
         :breakout
         :aggregation
         :condition
         :fields
         :strategy
         :filter
         :order-by
         :page
         :limit]))
(defn- sorted-mbql-query-map []
  ;; stuff in [[mbql-clause->sort-order]] should always get sorted according to that order. Everything else should go at
  ;; the end, with non-namespaced stuff first and namespaced stuff last; otherwise sort alphabetically
  (sorted-map-by (fn [x y]
                   (let [order   (fn [k]
                                   (or (mbql-clause->sort-order k)
                                       (when (and (keyword? k) (namespace k))
                                         Integer/MAX_VALUE)
                                       (dec Integer/MAX_VALUE)))
                         x-order (order x)
                         y-order (order y)]
                     (if (= x-order y-order)
                       (compare (str x) (str y))
                       (compare x-order y-order))))))

Whether to shorten something like :metabase.query-processor.util.add-alias-info/source-table to ::add/source-table if an alias exists for the keyword namespace in the current namespace ([[ns]]).

(def ^:dynamic *shorten-namespaced-keywords?*
  true)
(defn- alias-for-namespace-in-*ns* [ns-symb]
  (let [a-namespace (find-ns (symbol ns-symb))]
    (some
     (fn [[ns-alias aliased-namespace]]
       (when (= aliased-namespace a-namespace)
         ns-alias))
     (ns-aliases *ns*))))

Convert MBQL query to a special map type that keeps the keys sorted in the 'preferred' order (e.g. order roughly matches that of SQL, i.e. things like source query and joins come before order by or limit), which is easier to look at (maybe).

(defn ->sorted-mbql-query-map
  [query]
  (walk/postwalk
   (fn [form]
     (cond
       (map? form)
       (into (sorted-mbql-query-map) form)
       (and *shorten-namespaced-keywords?*
            (keyword? form)
            (namespace form))
       (if-let [ns-alias (alias-for-namespace-in-*ns* (symbol (namespace form)))]
         (symbol (format "::%s/%s" ns-alias (name form)))
         form)
       :else
       form))
   query))

[[add-names]]

(defn- field-and-table-name [field-id]
  (let [{field-name :name, table-id :table_id} (t2/select-one [Field :name :table_id] :id field-id)]
    [(t2/select-one-fn :name Table :id table-id) field-name]))
(defn- add-table-id-name [table-id]
  (list 'do
        (symbol (format "#_%s" (pr-str (t2/select-one-fn :name Table :id table-id))))
        table-id))

Walk a MBQL snippet x and add comment forms with the names of the Fields referenced to any :field clauses nil encountered. Helpful for debugging!

(defn add-names
  [x]
  (-> (walk/postwalk
       (fn add-names* [form]
         (letfn [(add-name-to-field-id [id]
                   (when id
                     (let [[field-name table-name] (field-and-table-name id)]
                       (symbol (format "#_\"%s.%s\"" field-name table-name)))))
                 (field-id->name-form [field-id]
                   (list 'do (add-name-to-field-id field-id) field-id))]
           (mbql.u/replace form
             [:field (id :guard pos-int?) opts]
             [:field id (add-name-to-field-id id) (cond-> opts
                                                    (pos-int? (:source-field opts))
                                                    (update :source-field field-id->name-form))]
             (m :guard (every-pred map? (comp pos-int? :source-table)))
             (add-names* (update m :source-table add-table-id-name))
             (m :guard (every-pred map? (comp pos-int? :metabase.query-processor.util.add-alias-info/source-table)))
             (add-names* (update m :metabase.query-processor.util.add-alias-info/source-table add-table-id-name))
             (m :guard (every-pred map? (comp pos-int? :fk-field-id)))
             (-> m
                 (update :fk-field-id field-id->name-form)
                 add-names*)
             ;; don't recursively replace the `do` lists above, other we'll get vectors.
             (_ :guard (every-pred list? #(= (first %) 'do)))
             &match)))
       x)
      ->sorted-mbql-query-map))

[[process-query-debug]]

see docstring for [[process-query-debug]] for descriptions of what these do.

(def ^:private ^:dynamic *print-full?*     true)
(def ^:private ^:dynamic *print-metadata?* false)
(def ^:private ^:dynamic *print-names?*    true)
(def ^:private ^:dynamic *validate-query?* false)

Replace field metadata in x with ....

(defn- remove-metadata
  [x]
  (walk/prewalk
   (fn [form]
     (if (map? form)
       (reduce
        (fn [m k]
          (m/update-existing m k (constantly '...)))
        form
        [:cols :results_metadata :source-metadata])
       form))
   x))
(defn- format-output [x]
  (cond-> x
    (not *print-metadata?*) remove-metadata
    *print-names?*          add-names))
(defn- print-diff [before after]
  (assert (not= before after))
  (ddiff/pretty-print (ddiff/diff before after)
                      ;; the default printer is very (too?) colorful.
                      ;; this is one that strips color except for the diffs:
                      (ddiff/printer {:color-scheme
                                      {:lambdaisland.deep-diff2.printer-impl/deletion  [:red]
                                       :lambdaisland.deep-diff2.printer-impl/insertion [:green]
                                       :lambdaisland.deep-diff2.printer-impl/other     [:white]
                                       :delimiter       nil
                                       :tag             nil
                                       :nil             nil
                                       :boolean         nil
                                       :number          nil
                                       :string          nil
                                       :character       nil
                                       :keyword         nil
                                       :symbol          nil
                                       :function-symbol nil
                                       :class-delimiter nil
                                       :class-name      nil}}))
  (println))
(defn- print-transform-result [before after]
  (when *print-full?*
    (println (u/pprint-to-str 'cyan (format-output after))))
  (print-diff before after))
(defn- print-error [location middleware-var e]
  (println (format "Error %s in %s:\n%s"
                   location
                   middleware-var
                   (u/pprint-to-str 'red (Throwable->map e)))))

Writes the debugger event to the standard output. Uses colors and deep diffing to show changes made by middlewares.

This is the default printer of process-query-debug.

(defmulti print-formatted-event
  first)
(defmethod print-formatted-event ::transformed-query
  [[_ middleware-var before after]]
  (println (format "[pre] %s transformed query:" middleware-var))
  (print-transform-result before after))
(defmethod print-formatted-event ::pre-process-query-error
  [[_ middleware-var e]]
  (print-error "pre-processing query" middleware-var e))
(defmethod print-formatted-event ::transformed-metadata
  [[_ middleware-var before after]]
  (println (format "[post] %s transformed metadata:" middleware-var))
  (print-transform-result before after))
(defmethod print-formatted-event ::post-process-metadata-error
  [[_ middleware-var e]]
  (print-error "post-processing result metadata" middleware-var e))
(defmethod print-formatted-event ::post-process-result-error
  [[_ middleware-var e]]
  (print-error "post-processing result" middleware-var e))
(defmethod print-formatted-event ::transformed-result
  [[_ middleware-var before after]]
  (println (format "[post] %s transformed result:" middleware-var))
  (print-transform-result before after))
(defmethod print-formatted-event ::error-reduce-row
  [[_ middleware-var e]]
  (print-error "reducing row" middleware-var e))
(defmethod print-formatted-event ::transformed-row
  [[_ middleware-var before after]]
  (println (format "[post] %s transformed row" middleware-var))
  (print-transform-result before after))
(def ^:private ^:dynamic *printer* print-formatted-event)
(defn- debug-query-changes [middleware-var middleware]
  (fn [next-middleware]
    (fn [query-before rff context]
      (try
        ((middleware
          (fn [query-after rff context]
            (when-not (= query-before query-after)
              (*printer* [::transformed-query middleware-var query-before query-after]))
            (when *validate-query?*
              (try
                (mbql.s/validate-query query-after)
                (catch Throwable e
                  (when (::our-error? (ex-data e))
                    (throw e))
                  (throw (ex-info (format "%s middleware produced invalid query" middleware-var)
                                  {::our-error? true
                                   :middleware  middleware-var
                                   :before      query-before
                                   :query       query-after}
                                  e)))))
            (next-middleware query-after rff context)))
         query-before rff context)
        (catch Throwable e
          (when (::our-error? (ex-data e))
            (throw e))
          (*printer* [::pre-process-query-error middleware-var e])
          (throw (ex-info "Error pre-processing query"
                          {::our-error? true
                           :middleware  middleware-var
                           :query       query-before}
                          e)))))))
(defn- debug-rffs [middleware-var middleware before-rff-xform after-rff-xform]
  (fn [next-middleware]
    (fn [query rff-after context]
      ((middleware
        (fn [query rff-before context]
          (next-middleware query (before-rff-xform rff-before) context)))
       query (after-rff-xform rff-after) context))))
(defn- debug-metadata-changes [middleware-var middleware]
  (let [before (atom nil)]
    (debug-rffs
     middleware-var
     middleware
     (fn before-rff-xform [rff]
       (fn [metadata-before]
         (reset! before metadata-before)
         (try
           (rff metadata-before)
           (catch Throwable e
             (when (::our-error? (ex-data e))
               (throw e))
             (*printer* [::post-process-metadata-error middleware-var e])
             (throw (ex-info "Error post-processing result metadata"
                             {::our-error? true
                              :middleware  middleware-var
                              :metadata    metadata-before}
                             e))))))
     (fn after-rff-xform [rff]
       (fn [metadata-after]
         (when-not (= @before metadata-after)
           (*printer* [::transformed-metadata middleware-var @before metadata-after]))
         (rff metadata-after))))))
(defn- debug-rfs [middleware-var middleware before-xform after-xform]
  (debug-rffs
   middleware-var
   middleware
   (fn before-rff-xform [rff]
     (fn [metadata]
       (let [rf (rff metadata)]
         (before-xform rf))))
   (fn after-rff-xform [rff]
     (fn [metadata]
       (let [rf (rff metadata)]
         (after-xform rf))))))
(defn- debug-result-changes [middleware-var middleware]
  (let [before (atom nil)]
    (debug-rfs
     middleware-var
     middleware
     (fn before-xform [rf]
       (fn
         ([] (rf))
         ([result]
          (reset! before result)
          (try
            (rf result)
            (catch Throwable e
              (when (::our-error? (ex-data e))
                (throw e))
              (*printer* [::post-process-result-error middleware-var e])
              (throw (ex-info "Error post-processing result"
                              {::our-error? true
                               :middleware  middleware-var
                               :result      result}
                              e)))))
         ([result row] (rf result row))))
     (fn after-xform [rf]
       (fn
         ([] (rf))
         ([result]
          (when-not (= @before result)
            (*printer* [::transformed-result middleware-var @before result]))
          (rf result))
         ([result row] (rf result row)))))))
(defn- debug-row-changes [middleware-var middleware]
  (let [before (atom nil)]
    (debug-rfs
     middleware-var
     middleware
     (fn before-xform [rf]
       (fn
         ([] (rf))
         ([result]
          (rf result))
         ([result row]
          (reset! before row)
          (try
            (rf result row)
            (catch Throwable e
              (when (::our-error? (ex-data e))
                (throw e))
              (*printer* [::error-reduce-row middleware-var e])
              (throw (ex-info "Error reducing row"
                              {::our-error? true
                               :middleware  middleware-var
                               :result      result
                               :row         row}
                              e)))))))
     (fn after-xform [rf]
       (fn
         ([] (rf))
         ([result]
          (rf result))
         ([result row]
          (when-not (= @before row)
            (*printer* [::transformed-row @before row]))
          (rf result row)))))))

The default set of middleware applied to queries ran via [[process-query-debug]]. Analogous to [[qp/default-middleware]].

(defn- default-debug-middleware
  []
  (into
   []
   (comp cat (keep identity))
   [@#'qp/execution-middleware
    @#'qp/compile-middleware
    @#'qp/post-processing-middleware
    ;; Normally, pre-processing middleware are applied to the query left-to-right, but in debug mode we convert each
    ;; one into a transducing middleware and compose them, which causes them to be applied right-to-left. So we need
    ;; to reverse the order here.
    (reverse @#'qp/pre-processing-middleware)
    @#'qp/around-middleware]))

Takes a pre-processing middleware function, and converts it to a transducing middleware with the signature:

(f (f query rff context)) -> (f query rff context)

(defn- alter-pre-processing-middleware
  [middleware]
  (fn [qp-or-query]
    (if (map? qp-or-query)
      ;; If we're passed a map, this means the middleware var is still being called on a query directly. This happens
      ;; if pre-processing middleware calls other pre-processing middleware, such as [[upgrade-field-literals]] which
      ;; calls [[resolve-fields]]. Fallback to the original middleware function in this case.
      (middleware qp-or-query)
      (fn [query rff context]
        (qp-or-query
         (middleware query)
         rff
         context)))))

Takes a pre-processing middleware function, and converts it to a transducing middleware with the signature:

(f (f query rff context)) -> (f query rff context)

(defn- alter-post-processing-middleware
  [middleware]
  (fn [qp]
    (fn [query rff context]
      (qp query (middleware query rff) context))))

Implementation function for [[with-altered-middleware]]. Temporarily alters the root bindings for pre- and post-processing middleware vars, changing them to transducing middleware which can individually be wrapped with debug middleware in [[process-query-debug]].

(defn- with-altered-middleware-fn
  [f]
  (let [pre-processing-middleware-vars  @#'qp/pre-processing-middleware
        post-processing-middleware-vars @#'qp/post-processing-middleware
        pre-processing-original-fns     (zipmap pre-processing-middleware-vars
                                                (map deref pre-processing-middleware-vars))
        post-processing-original-fns    (zipmap post-processing-middleware-vars
                                                (map deref post-processing-middleware-vars))]
    (try
      (mapv #(alter-var-root % alter-pre-processing-middleware) pre-processing-middleware-vars)
      (mapv #(alter-var-root % alter-post-processing-middleware) post-processing-middleware-vars)
      (f)
      (finally
        (mapv (fn [[middleware-var middleware-fn]]
                (alter-var-root middleware-var (constantly middleware-fn)))
              (merge pre-processing-original-fns post-processing-original-fns))))))

Temporarily redefines pre-processing and post-processing middleware vars to equivalent transducing middlewares, so that [[process-query-debug]] can print the transformations for each middleware individually.

(defmacro ^:private with-altered-middleware
  [& body]
  `(with-altered-middleware-fn (fn [] ~@body)))

Process a query using a special QP that wraps all of the normal QP middleware and prints any transformations done during pre or post-processing.

Options:

  • :print-full? -- whether to print the entire query/result/etc. after each transformation

  • :print-metadata? -- whether to print metadata columns such as :colsor :source-metadata in the query/results

  • :print-names? -- whether to print comments with the names of fields/tables as part of :field forms and for :source-table

  • :validate-query? -- whether to validate the query after each preprocessing step, so you can figure out who's breaking it. (TODO -- mbql-to-native middleware currently leaves the old mbql :query in place, which cases query to fail at that point -- manually comment that behavior out if needed

  • :printer -- the function to process the debug events, defaults to print-formatted-event

(defn process-query-debug
  [query & {:keys [print-full? print-metadata? print-names? validate-query? printer context]
            :or   {print-full? true, print-metadata? false, print-names? true, validate-query? false
                   printer print-formatted-event}}]
  (binding [*print-full?*               print-full?
            *print-metadata?*           print-metadata?
            *print-names?*              print-names?
            *validate-query?*           validate-query?
            *printer*                   printer
            pprint/*print-right-margin* 80]
    (with-altered-middleware
      (let [middleware (for [middleware-var (default-debug-middleware)
                             :when          middleware-var]
                         (->> middleware-var
                              (debug-query-changes middleware-var)
                              (debug-metadata-changes middleware-var)
                              (debug-result-changes middleware-var)
                              (debug-row-changes middleware-var)))
            qp         (qp.reducible/sync-qp (#'qp/base-qp middleware))]
        (if context
          (qp query context)
          (qp query))))))

[[to-mbql-shorthand]]

(defn- strip-$ [coll]
  (into []
        (map (fn [x] (if (= x ::$) ::no-$ x)))
        coll))
(defn- can-symbolize? [x]
  (mbql.u/match-one x
    (_ :guard string?)
    (not (re-find #"\s+" x))
    [:field (id :guard pos-int?) nil]
    (every? can-symbolize? (field-and-table-name id))
    [:field (field-name :guard string?) (opts :guard #(= (set (keys %)) #{:base-type}))]
    (can-symbolize? field-name)
    [:field _ (opts :guard :join-alias)]
    (and (can-symbolize? (:join-alias opts))
         (can-symbolize? (mbql.u/update-field-options &match dissoc :join-alias)))
    [:field _ (opts :guard :temporal-unit)]
    (and (can-symbolize? (name (:temporal-unit opts)))
         (can-symbolize? (mbql.u/update-field-options &match dissoc :temporal-unit)))
    [:field _ (opts :guard :source-field)]
    (let [source-field-id (:source-field opts)]
      (and (can-symbolize? [:field source-field-id nil])
           (can-symbolize? (mbql.u/update-field-options &match dissoc :source-field))))
    _
    false))
(defn- expand [form table]
  (try
    (mbql.u/replace form
      ([:field (id :guard pos-int?) nil] :guard can-symbolize?)
      (let [[table-name field-name] (field-and-table-name id)
            field-name              (some-> field-name u/lower-case-en)
            table-name              (some-> table-name u/lower-case-en)]
        (if (= table-name table)
          [::$ field-name]
          [::$ table-name field-name]))
      ([:field (field-name :guard string?) (opts :guard #(= (set (keys %)) #{:base-type}))] :guard can-symbolize?)
      [::* field-name (name (:base-type opts))]
      ([:field _ (opts :guard :temporal-unit)] :guard can-symbolize?)
      (let [without-unit (mbql.u/update-field-options &match dissoc :temporal-unit)
            expansion    (expand without-unit table)]
        [::! (name (:temporal-unit opts)) (strip-$ expansion)])
      ([:field _ (opts :guard :source-field)] :guard can-symbolize?)
      (let [without-source-field   (mbql.u/update-field-options &match dissoc :source-field)
            expansion              (expand without-source-field table)
            source-as-field-clause [:field (:source-field opts) nil]
            source-expansion       (expand source-as-field-clause table)]
        [::-> source-expansion expansion])
      ([:field _ (opts :guard :join-alias)] :guard can-symbolize?)
      (let [without-join-alias (mbql.u/update-field-options &match dissoc :join-alias)
            expansion          (expand without-join-alias table)]
        [::& (:join-alias opts) expansion])
      [:field (id :guard pos-int?) opts]
      (let [without-opts [:field id nil]
            expansion    (expand without-opts table)]
        (if (= expansion without-opts)
          &match
          [:field [::% (strip-$ expansion)] opts]))
      (m :guard (every-pred map? (comp pos-int? :source-table)))
      (-> (update m :source-table (fn [table-id]
                                    [::$$ (some-> (t2/select-one-fn :name Table :id table-id) u/lower-case-en)]))
          (expand table))
      (m :guard (every-pred map? (comp pos-int? :fk-field-id)))
      (-> (update m :fk-field-id (fn [fk-field-id]
                                   (let [[table-name field-name] (field-and-table-name fk-field-id)
                                         field-name              (some-> field-name u/lower-case-en)
                                         table-name              (some-> table-name u/lower-case-en)]
                                     (if (= table-name table)
                                       [::% field-name]
                                       [::% table-name field-name]))))
          (expand table)))
    (catch Throwable e
      (throw (ex-info (format "Error expanding %s: %s" (pr-str form) (ex-message e))
                      {:form form, :table table}
                      e)))))
(defn- no-$ [x]
  (mbql.u/replace x [::$ & args] (into [::no-$] args)))
(defn- symbolize [form]
  (mbql.u/replace form
    [::-> x y]
    (symbol (format "%s->%s" (symbolize x) (str/replace (symbolize y) #"^\$" )))
    [::no-$ & args]
    (str/join \. args)
    [(qualifier :guard #{::$ ::& ::! ::%}) & args]
    (symbol (str (name qualifier) (str/join \. (symbolize (no-$ args)))))
    [::* field-name base-type]
    (symbol (format "*%s/%s" field-name base-type))
    [::$$ table-name]
    (symbol (format "$$%s" table-name))))
(defn- query-table-name [{:keys [source-table source-query], :as inner-query}]
  (cond
    (pos-int? source-table)
    (u/lower-case-en (or (t2/select-one-fn :name Table :id source-table)
                         (throw (ex-info (format "Table %d does not exist!" source-table)
                                         {:source-table source-table, :inner-query inner-query}))))
    source-query
    (recur source-query)))
(defn to-mbql-shorthand
  ([query]
   (let [query (mbql.normalize/normalize query)]
     (to-mbql-shorthand query (query-table-name (:query query)))))
  ([query table-name]
   (let [symbolized (-> query (expand table-name) symbolize ->sorted-mbql-query-map)
         table-symb (some-> table-name symbol)]
     (if (:query symbolized)
       (list 'mt/mbql-query table-symb (cond-> (:query symbolized)
                                         table-name (dissoc :source-table)))
       (list 'mt/$ids table-symb symbolized)))))
(defn expand-symbolize [x]
  (-> x (expand "orders") symbolize))

tests are in [[dev.debug-qp-test]] (in ./dev/test/dev dir)

Pretty print a SQL string.

(defn pprint-sql
  [driver sql]
  #_{:clj-kondo/ignore [:discouraged-var]}
   (println (mdb.query/format-sql sql driver)))
 
(ns  dev.debug-qp-test
  (:require [clojure.test :refer :all]
            [dev.debug-qp :as debug-qp]
            [metabase.test :as mt]))
(deftest add-names-test
  (testing "Joins"
    (is (= [{:strategy     :left-join
             :alias        "CATEGORIES__via__CATEGORY_ID"
             :condition    [:=
                            [:field
                             (mt/id :venues :category_id)
                             (symbol "#_\"VENUES.CATEGORY_ID\)
                             nil]
                            [:field
                             (mt/id :categories :id)
                             (symbol "#_\"CATEGORIES.ID\)
                             {:join-alias "CATEGORIES__via__CATEGORY_ID"}]]
             :source-table (list 'do (symbol "#_\"CATEGORIES\) (mt/id :categories))
             :fk-field-id  (list 'do (symbol "#_\"VENUES.CATEGORY_ID\) (mt/id :venues :category_id))}]
           (debug-qp/add-names
            [{:strategy     :left-join
              :alias        "CATEGORIES__via__CATEGORY_ID"
              :condition    [:=
                             [:field (mt/id :venues :category_id) nil]
                             [:field (mt/id :categories :id) {:join-alias "CATEGORIES__via__CATEGORY_ID"}]]
              :source-table (mt/id :categories)
              :fk-field-id  (mt/id :venues :category_id)}])))))
(deftest to-mbql-shorthand-test
  (mt/dataset test-data
    (testing "Normal Field ID clause"
      (is (= '$user_id
             (debug-qp/expand-symbolize [:field (mt/id :orders :user_id) nil])))
      (is (= '$products.id
             (debug-qp/expand-symbolize [:field (mt/id :products :id) nil]))))
    (testing "Field literal name"
      (is (= '*wow/Text
             (debug-qp/expand-symbolize [:field "wow" {:base-type :type/Text}])))
      (is (= [:field "w o w" {:base-type :type/Text}]
             (debug-qp/expand-symbolize [:field "w o w" {:base-type :type/Text}]))))
    (testing "Field with join alias"
      (is (= '&P.people.source
             (debug-qp/expand-symbolize [:field (mt/id :people :source) {:join-alias "P"}])))
      (is (= [:field '%people.id {:join-alias "People - User"}]
             (debug-qp/expand-symbolize [:field (mt/id :people :id) {:join-alias "People - User"}])))
      (is (= '&Q.*ID/BigInteger
             (debug-qp/expand-symbolize [:field "ID" {:base-type :type/BigInteger, :join-alias "Q"}]))))
    (testing "Field with source-field"
      (is (= '$product_id->products.id
             (debug-qp/expand-symbolize [:field (mt/id :products :id) {:source-field (mt/id :orders :product_id)}])))
      (is (= '$product_id->*wow/Text
             (debug-qp/expand-symbolize [:field "wow" {:base-type :type/Text, :source-field (mt/id :orders :product_id)}]))))
    (testing "Binned field - no expansion (%id only)"
      (is (= [:field '%people.source {:binning {:strategy :default}}]
             (debug-qp/expand-symbolize [:field (mt/id :people :source) {:binning {:strategy :default}}]))))
    (testing "Field with temporal unit"
      (is (= '!default.created_at
             (debug-qp/expand-symbolize [:field (mt/id :orders :created_at) {:temporal-unit :default}]))))
    (testing "Field with join alias AND temporal unit"
      (is (= '!default.&P1.created_at
             (debug-qp/expand-symbolize [:field (mt/id :orders :created_at) {:temporal-unit :default, :join-alias "P1"}]))))
    (testing "source table"
      (is (= '(mt/mbql-query orders
                {:joins [{:source-table $$people}]})
             (debug-qp/to-mbql-shorthand
              {:database (mt/id)
               :type     :query
               :query    {:source-table (mt/id :orders)
                          :joins        [{:source-table (mt/id :people)}]}}))))))
(deftest to-mbql-shorthand-joins-test
  (testing :fk-field-id
    (is (= '(mt/$ids venues
              [{:strategy     :left-join
                :alias        "CATEGORIES__via__CATEGORY_ID"
                :condition    [:= $category_id &CATEGORIES__via__CATEGORY_ID.categories.id]
                :source-table $$categories
                :fk-field-id  %category_id}])
           (debug-qp/to-mbql-shorthand
            [{:strategy     :left-join
              :alias        "CATEGORIES__via__CATEGORY_ID"
              :condition    [:=
                             [:field (mt/id :venues :category_id) nil]
                             [:field (mt/id :categories :id) {:join-alias "CATEGORIES__via__CATEGORY_ID"}]]
              :source-table (mt/id :categories)
              :fk-field-id  (mt/id :venues :category_id)}]
            "venues")))))
 
(ns dev.explain
  (:require
   [clojure.string :as str]
   [honey.sql :as sql]
   [toucan2.core :as t2]))

Explain a sql query or a honeysql query with option to analyze the query.

(defn explain-query
  ([queryable]
   (explain-query queryable false))
  ([queryable analyze?]
   (->> (t2/query
         (str/join
          " "
          (remove nil? ["EXPLAIN"
                        (when analyze? "ANALYZE")
                        "(" (if (map? queryable) (first (sql/format queryable {:inline true})) queryable) ")"])))
        (map #(get % (keyword "query plan"))))))
 
(ns dev.fe-helpers)

Returns the root Redux state, the JS object holding the complete state of the app.

This is hacky - it reaches deep into the internals of Redux, and may break in the future. That seems acceptable for a dev time helper.

(defn redux-state
  []
  (let [root  (js/document.querySelector "#root")
        store (.. root -_reactRootContainer -_internalRoot -current -child -memoizedProps -store)]
    (.getState store)))

Retrieves the current query's card from the Redux state.

Undefined behavior if there is not currently a single question loaded in the UI.

(defn current-card
  []
  (.. (redux-state) -qb -card))

Gets the legacy query for the currently loaded question.

(defn current-legacy-query-js
  []
  (.-dataset_query (current-card)))

Gets the MLv2 query for the currently loaded question.

Hack: This relies on a dev-mode-only global property that's set whenever a Question object is converted to MLv2.

(defn current-query
  []
  (.-__MLv2_query js/window))
 
(ns dev.h2-shell
  (:require [environ.core :as env]
            [metabase.db.data-source :as mdb.data-source]
            [metabase.db.env :as mdb.env]))
(comment mdb.data-source/keep-me)

Open an H2 shell with clojure -X:h2.

(defn shell
  [& _args]
  ;; Force the DB to use h2 regardless of what's actually in the env vars for Java properties
  (alter-var-root #'env/env assoc :mb-db-type "h2")
  (require 'metabase.db.env :reload)
  (org.h2.tools.Shell/main
   (into-array
    String
    ["-url" (let [^metabase.db.data_source.DataSource data-source mdb.env/data-source
                  url                                             (.url data-source)]
              (println "Connecting to database at URL" url)
              url)])))
 
(ns dev.liquibase
  (:require [clojure.string :as str]
            [colorize.core :as colorize]
            [metabase.db.data-source :as mdb.data-source]
            [metabase.db.env :as mdb.env]))
(comment mdb.data-source/keep-me)

Use the Liquibase CLI with clojure -M:liquibase <command>.

(defn -main
  [& args]
  (let [args (if (empty? args)
               ["help"]
               args)
        args (into ["--changeLogFile=resources/migrations/000_migrations.yaml"]
                   (comp cat
                         (filter seq))
                   (let [^metabase.db.data_source.DataSource data-source mdb.env/data-source
                         ^java.util.Properties properties                (.properties data-source)]
                     [(when-let [user (some-> properties (.get "user"))]
                        ["--username" user])
                      (when-let [password (some-> properties (.get "password"))]
                        ["--password" password])
                      ["--url" (.url data-source)]
                      (map str args)]))]
    (println (colorize/green (str/join " " (cons "liquibase" (map pr-str args)))))
    ;; use reflection here instead of static method calls because `liquibase.integration.commandline.Main` fails to load
    ;; without having the `logback` dependency available. We add this as `:extra-deps` for the `:liquibase` profile. We
    ;; don't want other stuff like the linters to choke here tho.
    (let [klass  (Class/forName "liquibase.integration.commandline.Main")
          method (.getMethod klass "main" (into-array Class [(Class/forName "[Ljava.lang.String;")]))]
      (.invoke method klass ^"[Ljava.lang.Object" (into-array Object [(into-array String args)])))))
 

A set of utility function to track model changes. Use this when you want to observe changes of database models when doing stuffs on UI.

How to use this?

(track! models/Dashboard models/Card models/DashboardCard) -- Go on UI and do stuffs like (i.e: update viz-settings of a dashcard).

(changes) ;; => {:report_card {:insert ...}}

You can use [[reset-changes!]] to clear our all the current trackings. And [[untrack-all!]] or [[untrack!]] to stop tracking.

(ns dev.model-tracking
  (:require
   [clojure.pprint :as pprint]
   [metabase.util :as u]
   [methodical.core :as m]
   [toucan2.core :as t2]
   [toucan2.model :as t2.model]
   [toucan2.tools.before-delete :as t2.before-delete]
   [toucan2.tools.before-insert :as t2.before-insert]
   [toucan2.tools.before-update :as t2.before-update]
   [toucan2.util :as t2.util]))

An atom to store all the changes of models that we currently track.

(def changes*
  (atom {}))
(def ^:private tracked-models (atom #{}))

When a change occurred, execute this function.

Currently it just prints the console out to the console. But if you prefer other method of debugging (i.e: tap), you can redef this function

(alter-var-root #'model-tracking/on-change (fn [path change] (tap> [path change])))

  • path: is a element vector [model, action]
  • change-info: is a map of the change for a model
(defn on-change
  [path change-info]
  (println (u/colorize :magenta :new-change) (u/colorize :magenta path))
  (pprint/pprint change-info))
(defn- clean-change
  [change]
  (dissoc change :updated_at :created_at))

Add a change to the [[changes]] atom.

(new-change :model/Card :insert {:name "new card"}) instance

@changes* {:report_card {:insert [{:name "new card"}]}]}.

For insert, track the instance as a map. For update, only track the changes.

(defn- new-change
  [model action row-or-instance]
  (let [model       (t2/resolve-model model)
        change-info (->> (case action
                           :update
                           (into {} (t2/changes row-or-instance))
                           (into {} row-or-instance))
                        clean-change)
        path       [(t2/table-name model) action]]
    ;; ideally this should be debug, but for some reasons this doesn't get logged
    (on-change path change-info)
    (swap! changes* update-in path concat [change-info])))
(defn- new-change-thunk
  [model action]
  (fn [_model row]
    (new-change model action row)
    row))

A list of toucan hooks that we will subscribed to when tracking a model.

(def ^:private hook+aux-method+action+deriveable
  [;; will be better if we could use after-insert to get the inserted id, but toucan2 doesn't define a multimethod for after-insert
   [#'t2.before-insert/before-insert :after :insert ::t2.before-insert/before-insert]
   [#'t2.before-update/before-update :after :update ::t2.before-update/before-update]
   ;; we do :before aux-method instead of :after for delete bacause the after method has input is number of affected rows
   [#'t2.before-delete/before-delete :before :delete ::t2.before-delete/before-delete]])
(defn- track-one!
  [model]
  (doseq [[hook aux-method action deriveable] hook+aux-method+action+deriveable]
    (when-not (m/primary-method @hook model)
      ;; aux-method will not be triggered if there isn't a primary method
      (t2.util/maybe-derive model deriveable)
      (m/add-primary-method! hook model (fn [_ _model row] row)))
    (m/add-aux-method-with-unique-key! hook aux-method model (new-change-thunk model action) ::tracking)))

Start tracking a list of models.

(track! 'Card 'Dashboard)

(defn track!
  [& models]
  (doseq [model (map t2.model/resolve-model models)]
    (track-one! model)
    (swap! tracked-models conj model)))
(defn- untrack-one!
  [model]
  (doseq [[hook aux-method _action] hook+aux-method+action+deriveable]
    (m/remove-aux-method-with-unique-key! hook aux-method model ::tracking)
    (swap! tracked-models disj model)))

Remove tracking for a list of models.

(untrack! 'Card 'Dashboard)

(defn untrack!
  [& models]
  (doseq [model (map t2.model/resolve-model models)]
    (untrack-one! model)))

Empty all the recorded changes.

(defn reset-changes!
  []
  (reset! changes* {}))

Quickly untrack all the tracked models.

(defn untrack-all!
  []
  (reset-changes!)
  (apply untrack! @tracked-models)
  (reset! tracked-models #{}))

Return all changes that were recorded.

(defn changes
  []
  @changes*)
 
(ns dev.model-tracking-test
  (:require
   [clojure.test :refer :all]
   [dev.model-tracking :as model-tracking]
   [metabase.models :refer [Collection]]
   [metabase.test :as mt]
   [toucan2.core :as t2]))
(use-fixtures :each (fn [thunk]
                      (model-tracking/untrack-all!)
                      (thunk)))
(deftest e2e-test
  (mt/with-model-cleanup [Collection]
    ;; setup
    (model-tracking/track! 'Collection)
    (testing "insert"
      (t2/insert! Collection {:name "Test tracking" :description "My awesome collection"})
      (testing "should be tracked"
        (is (=? [{:name  "Test tracking"
                  :description "My awesome collection"}]
                (get-in (model-tracking/changes) [:collection :insert]))))
      (testing "should take affects"
        (is (= 1 (t2/count Collection :name "Test tracking")))))
    (testing "update"
      (t2/update! Collection {:name "Test tracking"} {:description "Amazing collection"})
      (testing "changes should be tracked"
        (is (= [{:description "Amazing collection"}]
               (get-in (model-tracking/changes) [:collection :update]))))
      (testing "should take affects"
        (is (= "Amazing collection" (t2/select-one-fn :description Collection :name "Test tracking")))))
    (testing "delete"
      (let [coll-id (t2/select-one-pk Collection :name "Test tracking")]
        (t2/delete! Collection coll-id)
        (testing "should be tracked"
          (is (=? [{:description "Amazing collection"
                    :name  "Test tracking",
                    :id    coll-id}]
                  (get-in (model-tracking/changes) [:collection :delete]))))
        (testing "should take affects"
          (is (nil? (t2/select-one Collection :id coll-id))))))
    (testing "untrack should stop all tracking for"
      (model-tracking/untrack-all!)
      (testing "insert"
        (t2/insert! Collection {:name "Test tracking" :description "My awesome collection"})
        (testing "changes not should be tracked"
          (is (empty? (model-tracking/changes))))
        (testing "should take affects"
          (is (= 1 (t2/count Collection :name "Test tracking")))))
      (testing "update"
        (t2/update! Collection {:name "Test tracking"} {:description "Amazing collection"})
        (testing "changes not should be tracked"
          (is (empty? (model-tracking/changes))))
        (testing "should take affects"
          (is (= "Amazing collection" (t2/select-one-fn :description Collection :name "Test tracking")))))
      (testing "delete"
        (let [coll-id (t2/select-one-pk Collection :name "Test tracking")]
          (t2/delete! Collection coll-id)
          (testing "changes not should be tracked"
            (is (empty? (model-tracking/changes))))
          (testing "should take affects"
            (is (nil? (t2/select-one Collection :id coll-id)))))))))
 
(ns dev.portal
  (:require [portal.api :as p]))

The handle to portal. Can be used as @p to get the selected item.

(defonce
  p
  (p/open {:port 5678}))

Listen by default.

(add-tap #'p/submit)

Register some useful functions for use in the portal window.

(doseq [f [#'reverse #'vec]]
  (p/register! f))

Sometimes the portal window stops responding. Closing the window and running this function brings up a new, responsive window preserving the contents.

(defn unfreeze
  []
  (p/open p))

Tap value as a portal log message.

The options :level, :ns, :line, :column and :time can be used to override the defaults (:info level, the current namespace, line -1, column -1 and the current time.)

(defn send-log
  ([value] (send-log value nil))
  ([value {:keys [level ns line column time]
           :or {level  :info
                ns     (ns-name *ns*)
                line   -1
                column -1
                time   (java.util.Date.)}}]
   (tap> {:result value
          :level  level
          :ns     ns
          :line   line
          :column column
          :time   time})))

Send value as a log message to portal using the place of the call as source (namespace, line, column) of the message.

(defmacro log
  [value & [opts]]
  `(send-log ~value ~(merge (meta &form)
                            {:ns (list 'quote (ns-name *ns*))}
                            opts)))

Sends debug events from dev.debug-qp/process-query-debug to portal.

This is a simplistic function that send known transformation events to portal as a log message. The diff of the second and third parameters form the message and the location of the definition of the var in the first parameter is used as origin. Any other events are sent to portal as is.

A typical use looks like this:

(debug-qp/process-query-debug a-query :printer portal/debug-qp-log)

(defn debug-qp-log
  [[tag middleware-var before after :as event]]
  (if (#{:dev.debug-qp/transformed-query, :dev.debug-qp/transformed-metadata
         :dev.debug-qp/transformed-result, :dev.debug-qp/transformed-row}
       tag)
    (send-log (with-meta [before after]
                {:portal.viewer/default :portal.viewer/diff})
              (update (meta middleware-var) :ns #(.name %)))
    (send-log event)))
 

Improve feedback loop for dealing with png rendering code. Will create images using the rendering that underpins pulses and subscriptions and open those images without needing to send them to slack or email.

(ns dev.render-png
  (:require
    [clojure.data.csv :as csv]
    [clojure.java.io :as io]
    [clojure.java.shell :as sh]
    [hiccup.core :as hiccup]
    [metabase.email.messages :as messages]
    [metabase.models :refer [Card]]
    [metabase.models.card :as card]
    [metabase.pulse :as pulse]
    [metabase.pulse.markdown :as markdown]
    [metabase.pulse.render :as render]
    [metabase.pulse.render.image-bundle :as img]
    [metabase.pulse.render.png :as png]
    [metabase.pulse.render.style :as style]
    [metabase.query-processor :as qp]
    [metabase.test :as mt]
    [toucan2.core :as t2])
  (:import (java.io File)))
(set! *warn-on-reflection* true)

Returns :win, :mac, :unix, or nil

taken from https://github.com/aysylu/loom/blob/master/src/loom/io.clj

(defn- os
  []
  (condp
   #(<= 0 (.indexOf ^String %2 ^String %1))
   (.toLowerCase (System/getProperty "os.name"))
    "win" :win
    "mac" :mac
    "nix" :unix
    "nux" :unix
    nil))

Opens the given file (a string, File, or file URI) in the default application for the current desktop environment. Returns nil

taken from https://github.com/aysylu/loom/blob/master/src/loom/io.clj

(defn- open
  [f]
  (let [f (io/file f)]
    ;; There's an 'open' method in java.awt.Desktop but it hangs on Windows
    ;; using Clojure Box and turns the process into a GUI process on Max OS X.
    ;; Maybe it's ok for Linux?
    (condp = (os)
      :mac  (sh/sh "open" (str f))
      :win  (sh/sh "cmd" (str "/c start " (-> f .toURI .toURL str)))
      :unix (sh/sh "xdg-open" (str f)))
    nil))

Given a card ID, renders the card to a png and opens it. Be aware that the png rendered on a dev machine may not match what's rendered on another system, like a docker container.

(defn render-card-to-png
  [card-id]
  (let [{:keys [dataset_query result_metadata dataset] :as card} (t2/select-one card/Card :id card-id)
        query-results (qp/process-query
                        (cond-> dataset_query
                          dataset
                          (assoc-in [:info :metadata/dataset-metadata] result_metadata)))
        png-bytes     (render/render-pulse-card-to-png (pulse/defaulted-timezone card)
                                                       card
                                                       query-results
                                                       1000)
        tmp-file      (File/createTempFile "card-png" ".png")]
    (with-open [w (java.io.FileOutputStream. tmp-file)]
      (.write w ^bytes png-bytes))
    (.deleteOnExit tmp-file)
    (open tmp-file)))

Render a pulse card as a data structure

(defn render-pulse-card
  [card-id]
  (let [{:keys [dataset_query] :as card} (t2/select-one card/Card :id card-id)
        query-results (qp/process-query dataset_query)]
    (render/render-pulse-card
     :inline (pulse/defaulted-timezone card)
     card
     nil
     query-results)))

Take a hiccup data structure, render it as html, then open it in the browser.

(defn open-hiccup-as-html
  [hiccup]
  (let [html-str (hiccup/html hiccup)
        tmp-file (File/createTempFile "card-html" ".html")]
    (with-open [w (io/writer tmp-file)]
      (.write w ^String html-str))
    (.deleteOnExit tmp-file)
    (open tmp-file)))
(def ^:private execute-dashboard #'pulse/execute-dashboard)

Given a dashboard ID, renders each dashcard, including Markdown, to its own temporary png image, and opens each one.

(defn render-dashboard-to-pngs
  [dashboard-id]
  (let [user              (t2/select-one :model/User)
        dashboard         (t2/select-one :model/Dashboard :id dashboard-id)
        dashboard-results (execute-dashboard {:creator_id (:id user)} dashboard)]
    (doseq [{:keys [card dashcard result] :as dashboard-result} dashboard-results]
      (let [render    (if card
                        (render/render-pulse-card :inline (pulse/defaulted-timezone card) card dashcard result)
                        {:content     [:div {:style (style/style {:font-family             "Lato"
                                                                  :font-size               "0.875em"
                                                                  :font-weight             "400"
                                                                  :font-style              "normal"
                                                                  :color                   "#4c5773"
                                                                  :-moz-osx-font-smoothing "grayscale"})}
                                       (markdown/process-markdown (:text dashboard-result) :html)]
                         :attachments nil})
            png-bytes (-> render (png/render-html-to-png 1000))
            tmp-file  (java.io.File/createTempFile "card-png" ".png")]
        (with-open [w (java.io.FileOutputStream. tmp-file)]
          (.write w ^bytes png-bytes))
        (.deleteOnExit tmp-file)
        (open tmp-file)))))
(def ^:private table-style-map
  {:border          "1px solid black"
   :border-collapse "collapse"
   :padding         "5px"})
(def ^:private table-style
  (style/style table-style-map))
(def ^:private csv-row-limit 10)
(defn- csv-to-html-table [csv-string]
  (let [rows (csv/read-csv csv-string)]
    [:table {:style table-style}
     (for [row (take (inc csv-row-limit) rows)] ;; inc row-limit to include the header and the expected # of rows
       [:tr {:style table-style}
        (for [cell row]
          [:td {:style table-style} cell])])]))
(def ^:private result-attachment #'messages/result-attachment)
(defn- render-csv-for-dashcard
  [part]
  (-> part
      (assoc-in [:card :include_csv] true)
      result-attachment
      first
      :content
      slurp
      csv-to-html-table))
(defn- render-one-dashcard
  [{:keys [card dashcard result] :as dashboard-result}]
  (letfn [(cellfn [content]
            [:td {:style (style/style (merge table-style-map {:max-width "400px"}))}
             content])]
    (if card
      (let [base-render (render/render-pulse-card :inline (pulse/defaulted-timezone card) card dashcard result)
            html-src    (-> base-render :content)
            img-src     (-> base-render
                            (png/render-html-to-png 1200)
                            img/render-img-data-uri)
            csv-src (render-csv-for-dashcard dashboard-result)]
        [:tr
         (cellfn (:name card))
         (cellfn [:img {:style (style/style {:max-width "400px"}) :src img-src}])
         (cellfn html-src)
         (cellfn csv-src)])
      [:tr
       (cellfn nil)
       (cellfn
        [:div {:style (style/style {:font-family             "Lato"
                                    :font-size               "13px" #_ "0.875em"
                                    :font-weight             "400"
                                    :font-style              "normal"
                                    :color                   "#4c5773"
                                    :-moz-osx-font-smoothing "grayscale"})}
         (markdown/process-markdown (:text dashboard-result) :html)])
       (cellfn nil)])))

Given a dashboard ID, renders all of the dashcards to hiccup datastructure.

(defn render-dashboard-to-hiccup
  [dashboard-id]
  (let [user              (t2/select-one :model/User)
        dashboard         (t2/select-one :model/Dashboard :id dashboard-id)
        dashboard-results (execute-dashboard {:creator_id (:id user)} dashboard)
        render            (->> (map render-one-dashcard (map #(assoc % :dashboard-id dashboard-id) dashboard-results))
                               (into [[:tr
                                       [:th {:style (style/style table-style-map)} "Card Name"]
                                       [:th {:style (style/style table-style-map)} "PNG"]
                                       [:th {:style (style/style table-style-map)} "HTML"]
                                       [:th {:style (style/style table-style-map)} "CSV"]]])
                               (into [:table {:style (style/style table-style-map)}]))]
    render))

Given a dashboard ID, renders all of the dashcards into an html document.

(defn render-dashboard-to-html
  [dashboard-id]
  (hiccup/html (render-dashboard-to-hiccup dashboard-id)))

Given a dashboard ID, renders all of the dashcards to an html file and opens it.

(defn render-dashboard-to-html-and-open
  [dashboard-id]
  (let [html-str (render-dashboard-to-html dashboard-id)
        tmp-file (File/createTempFile "card-html" ".html")]
    (with-open [w (io/writer tmp-file)]
      (.write w ^String html-str))
    (.deleteOnExit tmp-file)
    (open tmp-file)))
(comment
  ;; This form has 3 cards:
  ;; - A plain old question
  ;; - A model with user defined metadata
  ;; - A question based on that model
  ;;
  ;; The expected rendered results should be:
  ;; - The plain question will not have custom formatting applied
  ;; - The model and derived query will have custom formatting applied
  (mt/dataset sample-dataset
    (mt/with-temp [Card {base-card-id :id}
                   {:dataset_query {:database (mt/id)
                                    :type     :query
                                    :query    {:source-table (mt/id :orders)
                                               :expressions  {"Tax Rate" [:/
                                                                          [:field (mt/id :orders :tax) {:base-type :type/Float}]
                                                                          [:field (mt/id :orders :total) {:base-type :type/Float}]]},
                                               :fields       [[:field (mt/id :orders :tax) {:base-type :type/Float}]
                                                              [:field (mt/id :orders :total) {:base-type :type/Float}]
                                                              [:expression "Tax Rate"]]
                                               :limit        10}}}
                   Card {model-card-id :id} {:dataset         true
                                             :dataset_query   {:type     :query
                                                               :database (mt/id)
                                                               :query    {:source-table (format "card__%s" base-card-id)}}
                                             :result_metadata [{:name         "TAX"
                                                                :display_name "Tax"
                                                                :base_type    :type/Float}
                                                               {:name         "TOTAL"
                                                                :display_name "Total"
                                                                :base_type    :type/Float}
                                                               {:name          "Tax Rate"
                                                                :display_name  "Tax Rate"
                                                                :base_type     :type/Float
                                                                :semantic_type :type/Percentage
                                                                :field_ref     [:field "Tax Rate" {:base-type :type/Float}]}]}
                   Card {question-card-id :id} {:dataset_query {:type     :query
                                                                :database (mt/id)
                                                                :query    {:source-table (format "card__%s" model-card-id)}}}]
      (render-card-to-png base-card-id)
      (render-card-to-png model-card-id)
      (render-card-to-png question-card-id))))
 
(ns user
  (:require
   [environ.core :as env]
   [humane-are.core :as humane-are]
   [mb.hawk.assert-exprs]
   [metabase.bootstrap]
   [metabase.test-runner.assert-exprs]
   [pjstadig.humane-test-output :as humane-test-output]))

Initialize Humane Test Output if it's not already initialized. Don't enable humane-test-output when running tests from the CLI, it breaks diffs. This uses [[env/env]] rather than [[metabase.config]] so we don't load that namespace before we load [[metabase.bootstrap]]

(when-not (= (env/env :mb-run-mode) "test")
  (humane-test-output/activate!))

Same for https://github.com/camsaul/humane-are

(humane-are/install!)
(comment metabase.bootstrap/keep-me
         ;; make sure stuff like `=?` and what not are loaded
         mb.hawk.assert-exprs/keep-me
         metabase.test-runner.assert-exprs/keep-me)

Load and switch to the 'dev' namespace.

(defn dev
  []
  (require 'dev)
  (in-ns 'dev)
  :loaded)
 
(ns metabase.lib.metadata.cached-provider
  (:require
   [clojure.set :as set]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   #?@(:clj ([pretty.core :as pretty]))))
(defn- get-in-cache [cache ks]
  (when-some [cached-value (get-in @cache ks)]
    (when-not (= cached-value ::nil)
      cached-value)))
(defn- store-in-cache! [cache ks value]
  (let [value (if (some? value) value ::nil)]
    (swap! cache assoc-in ks value)
    (when-not (= value ::nil)
      value)))
(mu/defn ^:private store-database!
  [cache
   database-metadata :- lib.metadata/DatabaseMetadata]
  (let [database-metadata (-> database-metadata
                              (update-keys u/->kebab-case-en)
                              (assoc :lib/type :metadata/database))]
    (store-in-cache! cache [:metadata/database] database-metadata)))
(mu/defn ^:private store-metadata!
  [cache
   metadata-type :- [:enum :metadata/database :metadata/table :metadata/column :metadata/card :metadata/metric :metadata/segment]
   id            :- ::lib.schema.common/positive-int
   metadata      :- [:multi
                     {:dispatch :lib/type}
                     [:metadata/database lib.metadata/DatabaseMetadata]
                     [:metadata/table    lib.metadata/TableMetadata]
                     [:metadata/column   lib.metadata/ColumnMetadata]
                     [:metadata/card     lib.metadata/CardMetadata]
                     [:metadata/metric   lib.metadata/MetricMetadata]
                     [:metadata/segment  lib.metadata/SegmentMetadata]]]
  (let [metadata (-> metadata
                     (update-keys u/->kebab-case-en)
                     (assoc :lib/type metadata-type))]
    (store-in-cache! cache [metadata-type id] metadata)))
(defn- get-in-cache-or-fetch [cache ks fetch-thunk]
  (if-some [cached-value (get-in @cache ks)]
    (when-not (= cached-value ::nil)
      cached-value)
    (store-in-cache! cache ks (fetch-thunk))))
(defn- bulk-metadata [cache uncached-provider metadata-type ids]
  (when (seq ids)
    (log/debugf "Getting %s metadata with IDs %s" metadata-type (pr-str (sort ids)))
    (let [existing-ids (set (keys (get @cache metadata-type)))
          missing-ids  (set/difference (set ids) existing-ids)]
      (log/debugf "Already fetched %s: %s" metadata-type (pr-str (sort (set/intersection (set ids) existing-ids))))
      (when (seq missing-ids)
        (log/debugf "Need to fetch %s: %s" metadata-type (pr-str (sort missing-ids)))
        ;; TODO -- we should probably store `::nil` markers for things we tried to fetch that didn't exist
        (doseq [instance (lib.metadata.protocols/bulk-metadata uncached-provider metadata-type missing-ids)]
          (store-in-cache! cache [metadata-type (:id instance)] instance))))
    (for [id ids]
      (get-in-cache cache [metadata-type id]))))
(defn- tables [metadata-provider cache]
  (let [fetched-tables #(lib.metadata.protocols/tables metadata-provider)]
    (doseq [table fetched-tables]
      (store-in-cache! cache [:metadata/table (:id table)] table))
    fetched-tables))
(defn- fields [metadata-provider cache table-id]
  (let [fetched-fields (lib.metadata.protocols/fields metadata-provider table-id)]
    (doseq [field fetched-fields]
      (store-in-cache! cache [:metadata/column (:id field)] field))
    fetched-fields))
(defn- metrics [metadata-provider cache table-id]
  (let [fetched-metrics (lib.metadata.protocols/metrics metadata-provider table-id)]
    (doseq [metric fetched-metrics]
      (store-in-cache! cache [:metadata/metric (:id metric)] metric))
    fetched-metrics))

wraps another metadata provider and caches results. Implements the [[lib.metadata.protocols/CachedMetadataProvider]] protocol which allows warming the cache before use.

(deftype CachedProxyMetadataProvider [cache metadata-provider]
  lib.metadata.protocols/MetadataProvider
  (database [_this]            (get-in-cache-or-fetch cache [:metadata/database]            #(lib.metadata.protocols/database metadata-provider)))
  (table    [_this table-id]   (get-in-cache-or-fetch cache [:metadata/table table-id]      #(lib.metadata.protocols/table    metadata-provider table-id)))
  (field    [_this field-id]   (get-in-cache-or-fetch cache [:metadata/column field-id]     #(lib.metadata.protocols/field    metadata-provider field-id)))
  (card     [_this card-id]    (get-in-cache-or-fetch cache [:metadata/card card-id]        #(lib.metadata.protocols/card     metadata-provider card-id)))
  (metric   [_this metric-id]  (get-in-cache-or-fetch cache [:metadata/metric metric-id]    #(lib.metadata.protocols/metric   metadata-provider metric-id)))
  (segment  [_this segment-id] (get-in-cache-or-fetch cache [:metadata/segment segment-id]  #(lib.metadata.protocols/segment  metadata-provider segment-id)))
  (tables   [_this]            (get-in-cache-or-fetch cache [::database-tables]             #(tables metadata-provider cache)))
  (fields   [_this table-id]   (get-in-cache-or-fetch cache [::table-fields table-id]       #(fields metadata-provider cache table-id)))
  (metrics  [_this table-id]   (get-in-cache-or-fetch cache [::table-metrics table-id]      #(metrics metadata-provider cache table-id)))
  (setting  [_this setting]    (lib.metadata.protocols/setting metadata-provider setting))
  lib.metadata.protocols/CachedMetadataProvider
  (cached-database [_this]                           (get-in-cache    cache [:metadata/database]))
  (cached-metadata [_this metadata-type id]          (get-in-cache    cache [metadata-type id]))
  (store-database! [_this database-metadata]         (store-database! cache database-metadata))
  (store-metadata! [_this metadata-type id metadata] (store-metadata! cache metadata-type id metadata))
  ;; these only work if the underlying metadata provider is also a [[BulkMetadataProvider]].
  lib.metadata.protocols/BulkMetadataProvider
  (bulk-metadata [_this metadata-type ids]
    (bulk-metadata cache metadata-provider metadata-type ids))
  #?@(:clj
      [pretty/PrettyPrintable
       (pretty [_this]
               (list `cached-metadata-provider metadata-provider))]))

Wrap metadata-provider with an implementation that automatically caches results.

If the metadata provider implements [[lib.metadata.protocols/BulkMetadataProvider]], then [[lib.metadata.protocols/bulk-metadata]] will work as expected; it can be done for side-effects as well.

(defn cached-metadata-provider
  ^CachedProxyMetadataProvider [metadata-provider]
  (->CachedProxyMetadataProvider (atom {}) metadata-provider))
 
(ns metabase.lib.common
  (:require
   [metabase.lib.dispatch :as lib.dispatch]
   [metabase.lib.hierarchy :as lib.hierarchy]
   [metabase.lib.options :as lib.options]
   [metabase.lib.ref :as lib.ref]
   [metabase.lib.schema.common :as schema.common]
   [metabase.util.malli :as mu])
  #?(:cljs (:require-macros [metabase.lib.common])))
(comment lib.options/keep-me
         mu/keep-me)
(mu/defn external-op :- [:maybe ::schema.common/external-op]
  "Convert the internal operator `clause` to the external format."
  [[operator options :as clause]]
  (when clause
    {:lib/type :lib/external-op
     :operator (cond-> operator
                 (keyword? operator) name)
     :options  options
     :args     (subvec clause 2)}))

Ensures that clause arguments are properly unwrapped

(defmulti ->op-arg
  {:arglists '([x])}
  lib.dispatch/dispatch-value
  :hierarchy lib.hierarchy/hierarchy)
(defmethod ->op-arg :default
  [x]
  (if (and (vector? x)
           (keyword? (first x)))
    ;; MBQL clause
    (mapv ->op-arg x)
    ;; Something else - just return it
    x))
(defmethod ->op-arg :dispatch-type/sequential
  [xs]
  (mapv ->op-arg xs))
(defmethod ->op-arg :metadata/column
  [field-metadata]
  (lib.ref/ref field-metadata))
(defmethod ->op-arg :metadata/metric
  [metric-def]
  (lib.ref/ref metric-def))
(defmethod ->op-arg :metadata/segment
  [segment-def]
  (lib.ref/ref segment-def))
(defmethod ->op-arg :lib/external-op
  [{:keys [operator options args] :or {options {}}}]
  (->op-arg (lib.options/ensure-uuid (into [(keyword operator) options]
                                           (map ->op-arg)
                                           args))))

Impl for [[defop]].

(defn defop-create
  [op-name args]
  (into [op-name {:lib/uuid (str (random-uuid))}]
        (map ->op-arg)
        args))

Defines a clause creating function with given args. Calling the clause without query and stage produces a fn that can be resolved later.

#?(:clj
   (defmacro defop
     [op-name & argvecs]
     {:pre [(symbol? op-name)
            (every? vector? argvecs) (every? #(every? symbol? %) argvecs)
            (every? #(not-any? #{'query 'stage-number} %) argvecs)]}
     `(mu/defn ~op-name :- ~(keyword "mbql.clause" (name op-name))
        ~(format "Create a standalone clause of type `%s`." (name op-name))
        ~@(for [argvec argvecs
                :let [arglist-expr (if (contains? (set argvec) '&)
                                     (cons `list* (remove #{'&} argvec))
                                     argvec)]]
            `([~@argvec]
              (defop-create ~(keyword op-name) ~arglist-expr))))))
 
(ns metabase.shared.formatting.constants
  #?(:cljs (:require
            [metabase.shared.formatting.internal.date-builder :as builder])))

Months and weekdays should be abbreviated for compact output.

(defn abbreviated?
  [{:keys [output-density]}]
  (= output-density "compact"))

For compact and condensed output, ranges should be shortened if they're in the same month or year. Eg. January 8 - 15, 2022, or January 28 - February 4, 2022.

(defn condense-ranges?
  [{:keys [output-density]}]
  (#{"compact" "condensed"} output-density))

The default date style, used in a few places in the JS code as well as by this formatting library.

(def ^:export default-date-style
  "MMMM D, YYYY")

The default time style, used in a few places in the JS code as well as by this formatting library.

(def ^:export default-time-style
  "h:mm A")

A map of string patterns for dates, to functions from options to the data structures consumed by [[metabase.shared.formatting.internal.date-builder]].

Prefer passing the data structure directly, or use :date_style.

(def ^:export known-date-styles
  {"M/D/YYYY"           [:month-d "/" :day-of-month-d "/" :year]
   "D/M/YYYY"           [:day-of-month-d "/" :month-d "/" :year]
   "YYYY/M/D"           [:year "/" :month-d "/" :day-of-month-d]
   "MMMM D, YYYY"       [:month-full " " :day-of-month-d ", " :year]
   "D MMMM, YYYY"       [:day-of-month-d " " :month-full ", " :year]
   "dddd, MMMM D, YYYY" [:day-of-week-full ", " :month-full " " :day-of-month-d ", " :year]})

A table of string patterns for dates to the data structures consumed by [[metabase.shared.formatting.internal.date-builder]].

Don't rely on these - prefer passing the data structure directly, or use :date_style.

(def ^:export known-time-styles
  {"h:mm A" [:hour-12-d  ":" :minute-dd " " :am-pm]
   "HH:mm"  [:hour-24-dd ":" :minute-dd]
   "HH"     [:hour-24-dd]})

A table of string patterns for datetimes to the data structures consumed by [[metabase.shared.formatting.internal.date-builder]].

Don't rely on these - prefer passing the data structure directly, or use :date_style.

(def ^:export known-datetime-styles
  {"M/D/YYYY, h:mm A" {:date-format (get known-date-styles "M/D/YYYY")
                       :time-format (get known-time-styles "h:mm A")}})
 

Ported from frontend/src/metabase-lib/types/constants.js

(ns metabase.lib.types.constants
  #?(:cljs (:require [goog.object :as gobj])))

A front-end specific type hierarchy used by [[metabase.lib.types.isa/field-type?]]. It is not meant to be used directly.

#?(:cljs
   (do
     (def ^:export name->type
       "A map of Type name (as string, without `:type/` namespace) -> type keyword
         {\"Temporal\" :type/Temporal, ...}"
       (reduce (fn [m typ] (doto m (gobj/set (name typ) typ)))
               #js {}
               (distinct (mapcat descendants [:type/* :Semantic/* :Relation/*]))))
     ;; primary field types used for picking operators, etc
     (def ^:export key-number "JS-friendly access for the number type" ::number)
     (def ^:export key-string "JS-friendly access for the string type" ::string)
     (def ^:export key-string-like "JS-friendly access for the string-like type" ::string-like)
     (def ^:export key-boolean "JS-friendly access for the boolean type" ::boolean)
     (def ^:export key-temporal "JS-friendly access for the temporal type" ::temporal)
     (def ^:export key-location "JS-friendly access for the location type" ::location)
     (def ^:export key-coordinate "JS-friendly access for the coordinate type" ::coordinate)
     (def ^:export key-foreign-KEY "JS-friendly access for the foreign-key type" ::foreign-key)
     (def ^:export key-primary-KEY "JS-friendly access for the primary-key type" ::primary-key)
     (def ^:export key-json "JS-friendly access for the JSON type" ::json)
     (def ^:export key-xml "JS-friendly access for the JSON type" ::xml)
     (def ^:export key-structured "JS-friendly access for the structured type" ::structured)
     ;; other types used for various purposes
     (def ^:export key-summable "JS-friendly access for the summable type" ::summable)
     (def ^:export key-scope "JS-friendly access for the scope type" ::scope)
     (def ^:export key-category "JS-friendly access for the category type" ::category)
     (def ^:export key-unknown "JS-friendly access for the unknown type" ::unknown)))
;; NOTE: be sure not to create cycles using the "other" types
(def type-hierarchies
  {::temporal    {:effective-type [:type/Temporal]
                  :semantic-type  [:type/Temporal]}
   ::number      {:effective-type [:type/Number]
                  :semantic-type  [:type/Number]}
   ::integer     {:effective-type [:type/Integer]}
   ::string      {:effective-type [:type/Text]
                  :semantic-type  [:type/Text :type/Category]}
   ::string_like {:effective-type [:type/TextLike]}
   ::boolean     {:effective-type [:type/Boolean]}
   ::coordinate  {:semantic-type [:type/Coordinate]}
   ::location    {:semantic-type [:type/Address]}
   ::entity      {:semantic-type [:type/FK :type/PK :type/Name]}
   ::foreign_key {:semantic-type [:type/FK]}
   ::primary_key {:semantic-type [:type/PK]}
   ::json        {:effective-type [:type/SerializedJSON]}
   ::xml         {:effective-type [:type/XML]}
   ::structured  {:effective-type [:type/Structured]}
   ::summable    {:include [::number]
                  :exclude [::entity ::location ::temporal]}
   ::scope       {:include [::number ::temporal ::category ::entity ::string]
                  :exclude [::location]}
   ::category    {:effective-type [:type/Boolean]
                  :semantic-type  [:type/Category]
                  :include        [::location]}
   ;; NOTE: this is defunct right now.  see definition of metabase.lib.types.isa/dimension?.
   ::dimension   {:include [::temporal ::category ::entity]}})
 
(ns metabase.lib.convert
  (:require
   [clojure.data :as data]
   [clojure.set :as set]
   [clojure.string :as str]
   [malli.core :as mc]
   [malli.error :as me]
   [medley.core :as m]
   [metabase.lib.dispatch :as lib.dispatch]
   [metabase.lib.hierarchy :as lib.hierarchy]
   [metabase.lib.options :as lib.options]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.expression :as lib.schema.expression]
   [metabase.lib.schema.ref :as lib.schema.ref]
   [metabase.lib.util :as lib.util]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu])
  #?@(:cljs [(:require-macros [metabase.lib.convert :refer [with-aggregation-list]])]))
(def ^:private ^:dynamic *pMBQL-uuid->legacy-index*
  {})
(def ^:private ^:dynamic *legacy-index->pMBQL-uuid*
  {})
(defn- clean-location [almost-stage error-type error-location]
  (let [operate-on-parent? #{:malli.core/missing-key :malli.core/end-of-input}
        location (if (operate-on-parent? error-type)
                   (drop-last 2 error-location)
                   (drop-last 1 error-location))
        [location-key] (if (operate-on-parent? error-type)
                         (take-last 2 error-location)
                         (take-last 1 error-location))]
    (if (seq location)
      (update-in almost-stage
                 location
                 (fn [error-loc]
                   (let [result (assoc error-loc location-key nil)]
                     (cond
                       (vector? error-loc) (into [] (remove nil?) result)
                       (map? error-loc) (u/remove-nils result)
                       :else result))))
      (dissoc almost-stage location-key))))
(def ^:private stage-keys
  #{:aggregation :breakout :expressions :fields :filters :order-by :joins})
(defn- clean-stage-schema-errors [almost-stage]
  (loop [almost-stage almost-stage
         removals []]
    (if-let [[error-type error-location] (->> (mc/explain ::lib.schema/stage.mbql almost-stage)
                                              :errors
                                              (filter (comp stage-keys first :in))
                                              (map (juxt :type :in))
                                              first)]
      (let [new-stage (clean-location almost-stage error-type error-location)]
        (log/warnf "Clean: Removing bad clause in %s due to error %s:\n%s"
                   (u/colorize :yellow (pr-str error-location))
                   (u/colorize :yellow (pr-str (or error-type
                                                   ;; if `error-type` is missing, which seems to happen sometimes,
                                                   ;; fall back to humanizing the entire error.
                                                   (me/humanize (mc/explain ::lib.schema/stage.mbql almost-stage)))))
                   (u/colorize :red (u/pprint-to-str (first (data/diff almost-stage new-stage)))))
        (if (= new-stage almost-stage)
          almost-stage
          (recur new-stage (conj removals [error-type error-location]))))
      almost-stage)))
(defn- clean-stage-ref-errors [almost-stage]
  (reduce (fn [almost-stage [loc _]]
              (clean-location almost-stage ::lib.schema/invalid-ref loc))
          almost-stage
          (lib.schema/ref-errors-for-stage almost-stage)))
(defn- clean-stage [almost-stage]
  (-> almost-stage
      clean-stage-schema-errors
      clean-stage-ref-errors))
(defn- clean [almost-query]
  (loop [almost-query almost-query
         stage-index 0]
    (let [current-stage (nth (:stages almost-query) stage-index)
          new-stage (clean-stage current-stage)]
      (if (= current-stage new-stage)
        (if (= stage-index (dec (count (:stages almost-query))))
          almost-query
          (recur almost-query (inc stage-index)))
        (recur (update almost-query :stages assoc stage-index new-stage) stage-index)))))

Coerce something to pMBQL (the version of MBQL manipulated by Metabase Lib v2) if it's not already pMBQL.

(defmulti ->pMBQL
  {:arglists '([x])}
  lib.dispatch/dispatch-value
  :hierarchy lib.hierarchy/hierarchy)
(defn- default-MBQL-clause->pMBQL [mbql-clause]
  (let [last-elem (peek mbql-clause)
        last-elem-option? (map? last-elem)
        [clause-type & args] (cond-> mbql-clause
                               last-elem-option? pop)
        options (if last-elem-option?
                  last-elem
                  {})]
    (lib.options/ensure-uuid (into [clause-type options] (map ->pMBQL) args))))
(defmethod ->pMBQL :default
  [x]
  (if (and (vector? x)
           (keyword? (first x)))
    (default-MBQL-clause->pMBQL x)
    x))
(defmethod ->pMBQL :mbql/query
  [query]
  query)

In legacy MBQL, join :alias was optional, and if unspecified, this was the default alias used. In reality all joins normally had an explicit :alias since the QB would generate one and you generally need one to do useful things with the join anyway.

Since the new pMBQL schema makes :alias required, we'll explicitly add the implicit default when we encounter a join without an alias, and remove it so we can round-trip without changes.

(def legacy-default-join-alias
  "__join")

Join :aliases had to be unique in legacy MBQL, but they were optional. Since we add [[legacy-default-join-alias]] to each join that doesn't have an explicit :alias for pMBQL compatibility now, we need to deduplicate the aliases if it is used more than once.

Only deduplicate the default __join aliases; we don't want the [[lib.util/unique-name-generator]] to touch other aliases and truncate them or anything like that.

(defn- deduplicate-join-aliases
  [joins]
  (let [unique-name-fn (lib.util/unique-name-generator)]
    (mapv (fn [join]
            (cond-> join
              (= (:alias join) legacy-default-join-alias) (update :alias unique-name-fn)))
          joins)))

If a query stage has a legacy card__<id> :source-table, convert it to a pMBQL-style :source-card.

(defn- stage-source-card-id->pMBQL
  [stage]
  (if (string? (:source-table stage))
    (-> stage
        (assoc :source-card (lib.util/legacy-string-table-id->card-id (:source-table stage)))
        (dissoc :source-table))
    stage))

Macro for capturing the context of a query stage's :aggregation list, so any legacy [:aggregation 0] indexed refs can be converted correctly to UUID-based pMBQL refs.

#?(:clj
   (defmacro with-aggregation-list
     [aggregations & body]
     `(let [aggregations#  ~aggregations
            legacy->pMBQL# (into {}
                                 (map-indexed (fn [~'idx [~'_tag {~'ag-uuid :lib/uuid}]]
                                                [~'idx ~'ag-uuid]))
                                 aggregations#)
            pMBQL->legacy# (into {}
                                 (map-indexed (fn [~'idx [~'_tag {~'ag-uuid :lib/uuid}]]
                                                [~'ag-uuid ~'idx]))
                                 aggregations#)]
        (binding [*legacy-index->pMBQL-uuid* legacy->pMBQL#
                  *pMBQL-uuid->legacy-index* pMBQL->legacy#]
          ~@body))))
(defmethod ->pMBQL :mbql.stage/mbql
  [stage]
  (let [aggregations (->pMBQL (:aggregation stage))
        expressions  (->> stage
                          :expressions
                          (mapv (fn [[k v]]
                                  (-> v
                                      ->pMBQL
                                      (lib.util/top-level-expression-clause k))))
                          not-empty)]
    (metabase.lib.convert/with-aggregation-list aggregations
      (let [stage (-> stage
                      stage-source-card-id->pMBQL
                      (m/assoc-some :aggregation aggregations :expressions expressions))
            stage (reduce
                   (fn [stage k]
                     (if-not (get stage k)
                       stage
                       (update stage k ->pMBQL)))
                   stage
                   (disj stage-keys :aggregation :expressions))]
        (cond-> stage
          (:joins stage) (update :joins deduplicate-join-aliases))))))
(defmethod ->pMBQL :mbql.stage/native
  [stage]
  (m/update-existing stage :template-tags update-vals (fn [tag] (m/update-existing tag :dimension ->pMBQL))))
(defmethod ->pMBQL :mbql/join
  [join]
  (let [join (-> join
                 (update :conditions ->pMBQL)
                 (update :stages ->pMBQL))]
    (cond-> join
      (:fields join) (update :fields (fn [fields]
                                       (if (seqable? fields)
                                         (mapv ->pMBQL fields)
                                         (keyword fields))))
      (not (:alias join)) (assoc :alias legacy-default-join-alias))))
(defmethod ->pMBQL :dispatch-type/sequential
  [xs]
  (mapv ->pMBQL xs))
(defmethod ->pMBQL :dispatch-type/map
  [m]
  (if (:type m)
    (-> (lib.util/pipeline m)
        (update :stages (fn [stages]
                          (mapv ->pMBQL stages)))
        (assoc :lib.convert/converted? true)
        clean)
    (update-vals m ->pMBQL)))
(defmethod ->pMBQL :field
  [[_tag x y]]
  (let [[id-or-name options] (if (map? x)
                               [y x]
                               [x y])]
    (lib.options/ensure-uuid [:field options id-or-name])))
(defmethod ->pMBQL :value
  [[_tag value opts]]
  ;; `:value` uses `:snake_case` keys in legacy MBQL for some insane reason (actually this was to match the shape of
  ;; the keys in Field metadata), at least for the three type keys enumerated below.
  ;; See [[metabase.mbql.schema/ValueTypeInfo]].
  (let [opts (set/rename-keys opts {:base_type     :base-type
                                    :semantic_type :semantic-type
                                    :database_type :database-type})
        ;; in pMBQL, `:effective-type` is a required key for `:value`. `:value` SHOULD have always had `:base-type`,
        ;; but on the off chance it did not, get the type from value so the schema doesn't fail entirely.
        opts (assoc opts :effective-type (or (:effective-type opts)
                                             (:base-type opts)
                                             (lib.schema.expression/type-of value)))]
    (lib.options/ensure-uuid [:value opts value])))
(defmethod ->pMBQL :case
  [[_tag pred-expr-pairs options]]
  (let [default (:default options)]
    (cond-> [:case (dissoc options :default) (mapv ->pMBQL pred-expr-pairs)]
      :always lib.options/ensure-uuid
      (some? default) (conj (->pMBQL default)))))
(defmethod ->pMBQL :expression
  [[tag value opts]]
  (lib.options/ensure-uuid [tag opts value]))
(defn- get-or-throw!
  [m k]
  (let [result (get m k ::not-found)]
    (if-not (= result ::not-found)
      result
      (throw (ex-info (str "Unable to find key " (pr-str k) " in map.")
                      {:m m
                       :k k})))))
(defmethod ->pMBQL :aggregation
  [[tag aggregation-index opts, :as clause]]
  (lib.options/ensure-uuid
   [tag opts (or (get *legacy-index->pMBQL-uuid* aggregation-index)
                 (throw (ex-info (str "Error converting :aggregation reference: no aggregation at index "
                                      aggregation-index)
                                 {:clause clause})))]))
(defmethod ->pMBQL :aggregation-options
  [[_tag aggregation options]]
  (let [[tag opts & args] (->pMBQL aggregation)]
    (into [tag (merge opts options)] args)))

Convert a legacy 'inner query' to a full legacy 'outer query' so you can pass it to stuff like [[metabase.mbql.normalize/normalize]], and then probably to [[->pMBQL]].

(defn legacy-query-from-inner-query
  [database-id inner-query]
  (merge {:database database-id, :type :query}
         (if (:native inner-query)
           {:native (set/rename-keys inner-query {:native :query})}
           {:query inner-query})))

Coerce something to legacy MBQL (the version of MBQL understood by the query processor and Metabase Lib v1) if it's not already legacy MBQL.

(defmulti ->legacy-MBQL
  {:arglists '([x])}
  lib.dispatch/dispatch-value
  :hierarchy lib.hierarchy/hierarchy)

Does keyword k have a:lib/ or a :metabase.lib.*/ namespace?

(defn- metabase-lib-keyword?
  [k]
  (and (qualified-keyword? k)
       (when-let [symb-namespace (namespace k)]
         (or (= symb-namespace "lib")
             (str/starts-with? symb-namespace "metabase.lib.")))))

Remove any keys starting with the :lib/ :metabase.lib.*/ namespaces from map m.

No args = return transducer to remove keys from a map. One arg = update a map m.

(defn- disqualify
  ([]
   (remove (fn [[k _v]]
             (metabase-lib-keyword? k))))
  ([m]
   (into {} (disqualify) m)))

Convert an options map in an MBQL clause to the equivalent shape for legacy MBQL. Remove :lib/* keys and :effective-type, which is not used in options maps in legacy MBQL.

(defn- options->legacy-MBQL
  [m]
  (not-empty
   (into {}
         (comp (disqualify)
               (remove (fn [[k _v]]
                         (= k :effective-type))))
         m)))
(defn- aggregation->legacy-MBQL [[tag options & args]]
  (let [inner (into [tag] (map ->legacy-MBQL) args)
        ;; the default value of the :case expression is in the options
        ;; in legacy MBQL
        inner (if (and (= tag :case) (next args))
                (conj (pop inner) {:default (peek inner)})
                inner)]
    (if-let [aggregation-opts (not-empty (options->legacy-MBQL options))]
      [:aggregation-options inner aggregation-opts]
      inner)))
(defn- clause-with-options->legacy-MBQL [[k options & args]]
  (if (map? options)
    (into [k] (concat (map ->legacy-MBQL args)
                      (when-let [options (options->legacy-MBQL options)]
                        [options])))
    (into [k] (map ->legacy-MBQL (cons options args)))))
(defmethod ->legacy-MBQL :default
  [x]
  (cond
    (and (vector? x)
         (keyword? (first x))) (clause-with-options->legacy-MBQL x)
    (map? x)                   (-> x
                                   disqualify
                                   (update-vals ->legacy-MBQL))
    :else x))
(doseq [tag [::aggregation ::expression]]
  (lib.hierarchy/derive tag ::aggregation-or-expression))
(doseq [tag [:count :avg :count-where :distinct
             :max :median :min :percentile
             :share :stddev :sum :sum-where]]
  (lib.hierarchy/derive tag ::aggregation))
(doseq [tag [:+ :- :* :/
             :case :coalesce
             :abs :log :exp :sqrt :ceil :floor :round :power :interval
             :relative-datetime :time :absolute-datetime :now :convert-timezone
             :get-week :get-year :get-month :get-day :get-hour
             :get-minute :get-second :get-quarter
             :datetime-add :datetime-subtract
             :concat :substring :replace :regexextract :regex-match-first
             :length :trim :ltrim :rtrim :upper :lower]]
  (lib.hierarchy/derive tag ::expression))
(defmethod ->legacy-MBQL ::aggregation-or-expression
  [input]
  (aggregation->legacy-MBQL input))
(defn- stage-metadata->legacy-metadata [stage-metadata]
  (into []
        (comp (map #(update-keys % u/->snake_case_en))
              (map ->legacy-MBQL))
        (:columns stage-metadata)))
(defn- chain-stages [{:keys [stages]}]
  ;; :source-metadata aka :lib/stage-metadata is handled differently in the two formats.
  ;; In legacy, an inner query might have both :source-query, and :source-metadata giving the metadata for that nested
  ;; :source-query.
  ;; In pMBQL, the :lib/stage-metadata is attached to the same stage it applies to.
  ;; So when chaining pMBQL stages back into legacy form, if stage n has :lib/stage-metadata, stage n+1 needs
  ;; :source-metadata attached.
  (let [inner-query (first (reduce (fn [[inner stage-metadata] stage]
                                     [(cond-> (->legacy-MBQL stage)
                                        inner          (assoc :source-query inner)
                                        stage-metadata (assoc :source-metadata (stage-metadata->legacy-metadata stage-metadata)))
                                      ;; Get the :lib/stage-metadata off the original pMBQL stage, not the converted one.
                                      (:lib/stage-metadata stage)])
                                   nil
                                   stages))]
    (cond-> inner-query
      ;; If this is a native query, inner query will be used like: `{:type :native :native #_inner-query {:query ...}}`
      (:native inner-query) (set/rename-keys {:native :query}))))
(defmethod ->legacy-MBQL :dispatch-type/map [m]
  (into {}
        (comp (disqualify)
              (map (fn [[k v]]
                     [k (->legacy-MBQL v)])))
        m))
(defmethod ->legacy-MBQL :aggregation [[_ opts agg-uuid :as ag]]
  (if (map? opts)
    (try
      (let [opts (options->legacy-MBQL opts)]
        (cond-> [:aggregation (get-or-throw! *pMBQL-uuid->legacy-index* agg-uuid)]
          opts (conj opts)))
      (catch #?(:clj Throwable :cljs :default) e
        (throw (ex-info (lib.util/format "Error converting aggregation reference to pMBQL: %s" (ex-message e))
                        {:ref ag}
                        e))))
    ;; Our conversion is a bit too aggressive and we're hitting legacy refs like [:aggregation 0] inside source_metadata that are only used for legacy and thus can be ignored
    ag))
(defmethod ->legacy-MBQL :dispatch-type/sequential [xs]
  (mapv ->legacy-MBQL xs))
(defmethod ->legacy-MBQL :field [[_ opts id]]
  ;; Fields are not like the normal clauses - they need that options field even if it's null.
  ;; TODO: Sometimes the given field is in the legacy order - that seems wrong.
  (let [[opts id] (if (or (nil? opts) (map? opts))
                    [opts id]
                    [id opts])]
    [:field
     (->legacy-MBQL id)
     (options->legacy-MBQL opts)]))
(defmethod ->legacy-MBQL :value
  [[_tag opts value]]
  (let [opts (-> opts
                 ;; as mentioned above, `:value` in legacy MBQL expects `snake_case` keys for type info keys.
                 (set/rename-keys  {:base-type     :base_type
                                    :semantic-type :semantic_type
                                    :database-type :database_type})
                 options->legacy-MBQL)]
    ;; in legacy MBQL, `:value` has to be three args; `opts` has to be present, but it should can be `nil` if it is
    ;; empty.
    [:value value opts]))
(defn- update-list->legacy-boolean-expression
  [m pMBQL-key legacy-key]
  (cond-> m
    (= (count (get m pMBQL-key)) 1) (m/update-existing pMBQL-key (comp ->legacy-MBQL first))
    (> (count (get m pMBQL-key)) 1) (m/update-existing pMBQL-key #(into [:and] (map ->legacy-MBQL) %))
    :always (set/rename-keys {pMBQL-key legacy-key})))
(defmethod ->legacy-MBQL :mbql/join [join]
  (let [base (cond-> (disqualify join)
               (str/starts-with? (:alias join) legacy-default-join-alias) (dissoc :alias))]
    (merge (-> base
               (dissoc :stages :conditions)
               (update-vals ->legacy-MBQL))
           (-> base
               (select-keys [:conditions])
               (update-list->legacy-boolean-expression :conditions :condition))
           (chain-stages base))))

If a pMBQL query stage has :source-card convert it to legacy-style :source-table "card__<id>".

(defn- source-card->legacy-source-table
  [stage]
  (if-let [source-card-id (:source-card stage)]
    (-> stage
        (dissoc :source-card)
        (assoc :source-table (str "card__" source-card-id)))
    stage))
(defmethod ->legacy-MBQL :mbql.stage/mbql
  [stage]
  (metabase.lib.convert/with-aggregation-list (:aggregation stage)
    (reduce #(m/update-existing %1 %2 ->legacy-MBQL)
            (-> stage
                disqualify
                source-card->legacy-source-table
                (m/update-existing :aggregation #(mapv aggregation->legacy-MBQL %))
                (m/update-existing :expressions (fn [expressions]
                                                  (into {}
                                                        (for [expression expressions
                                                              :let [legacy-clause (->legacy-MBQL expression)]]
                                                          [(lib.util/expression-name expression)
                                                           ;; We wrap literals in :value ->pMBQL
                                                           ;; so unwrap this direction
                                                           (if (= :value (first legacy-clause))
                                                             (second legacy-clause)
                                                             legacy-clause)]))))
                (update-list->legacy-boolean-expression :filters :filter))
            (disj stage-keys :aggregation :filters :expressions))))
(defmethod ->legacy-MBQL :mbql.stage/native [stage]
  (-> stage
      disqualify
      (update-vals ->legacy-MBQL)))
(defmethod ->legacy-MBQL :mbql/query [query]
  (try
    (let [base        (disqualify query)
          parameters  (:parameters base)
          inner-query (chain-stages base)
          query-type  (if (-> query :stages last :lib/type (= :mbql.stage/native))
                        :native
                        :query)]
      (merge (-> base
                 (dissoc :stages :parameters :lib.convert/converted?)
                 (update-vals ->legacy-MBQL))
             (cond-> {:type query-type query-type inner-query}
               (seq parameters) (assoc :parameters parameters))))
    (catch #?(:clj Throwable :cljs :default) e
      (throw (ex-info (lib.util/format "Error converting MLv2 query to legacy query: %s" (ex-message e))
                      {:query query}
                      e)))))

TODO: Look into whether this function can be refactored away - it's called from several places but I (Braden) think legacy refs shouldn't make it out of lib.js.

(mu/defn legacy-ref->pMBQL :- ::lib.schema.ref/ref
  "Convert a legacy MBQL `:field`/`:aggregation`/`:expression` reference to pMBQL. Normalizes the reference if needed,
  and handles JS -> Clj conversion as needed."
  ([query legacy-ref]
   (legacy-ref->pMBQL query -1 legacy-ref))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    legacy-ref   :- some?]
   (let [legacy-ref                  (->> #?(:clj legacy-ref :cljs (js->clj legacy-ref :keywordize-keys true))
                                          (mbql.normalize/normalize-fragment nil))
         {aggregations :aggregation} (lib.util/query-stage query stage-number)]
     (with-aggregation-list aggregations
       (try
         (->pMBQL legacy-ref)
         (catch #?(:clj Throwable :cljs :default) e
           (throw (ex-info (lib.util/format "Error converting legacy ref to pMBQL: %s" (ex-message e))
                           {:query                    query
                            :stage-number             stage-number
                            :legacy-ref               legacy-ref
                            :legacy-index->pMBQL-uuid *legacy-index->pMBQL-uuid*}
                           e))))))))
(defn- from-json [query-fragment]
  #?(:cljs (if (object? query-fragment)
             (js->clj query-fragment :keywordize-keys true)
             query-fragment)
     :clj  query-fragment))

Given a JSON-formatted legacy MBQL query, transform it to pMBQL.

If you have only the inner query map ({:source-table 2 ...} or similar), call [[js-legacy-inner-query->pMBQL]] instead.

(defn js-legacy-query->pMBQL
  [query-map]
  (-> query-map
      from-json
      (u/assoc-default :type :query)
      mbql.normalize/normalize
      ->pMBQL))

Given a JSON-formatted inner query, transform it to pMBQL.

If you have a complete legacy query ({:type :query, :query {...}} or similar), call [[js-legacy-query->pMBQL]] instead.

(defn js-legacy-inner-query->pMBQL
  [inner-query]
  (js-legacy-query->pMBQL {:type  :query
                           :query (from-json inner-query)}))
 

The formatting strings are not standardized. Rather than wrangling with strings, this library defines a data structure for describing the format of date/time strings.

A format is represented as a (JS or CLJS) list of keyword or string date fragments (:year or ":day-of-month"). Literal strings, eg. /, -, and the "Q" of "Q4 - 2022" are simply strings that don't start with : - except for the literal string ":" as a special case.

Examples: - [:year "-" :month-dd] gives "2022-12" - ["Q" ":quarter" " - " ":year"] gives "Q4 - 2022" - [:month-full-name] gives "April" - [:month-name] gives "Apr" - [:month-dd] gives "04"

(ns metabase.shared.formatting.internal.date-builder
  (:require
   [clojure.string :as str])
  #?(:clj (:import
           java.time.format.DateTimeFormatter)))

This is the complete set of keys the formats can contain, mapped to the platform-specific magic string expected by Moment.js or java.time.format.DateTimeFormatter. Many are the same, but not all.

(def format-strings
  {:year              #?(:cljs "YYYY" :clj "yyyy")  ; 2022
   :quarter           "Q"                           ; 2 ("Q2" etc. is added by higher level formatting)
   :month-full        "MMMM"                        ; April
   :month-short       "MMM"                         ; Apr
   :month-dd          "MM"                          ; 04
   :month-d           "M"                           ; 4
   :day-of-month-d    #?(:cljs "D"    :clj "d")     ; 6
   :day-of-month-dd   #?(:cljs "DD"   :clj "dd")    ; 06
   :day-of-week-full  #?(:cljs "dddd" :clj "EEEE")  ; Friday
   :day-of-week-short #?(:cljs "ddd"  :clj "EEE")   ; Fri
   :hour-24-dd        "HH"                          ; 17, 05
   :hour-24-d         "H"                           ; 17, 5
   :hour-12-dd        "hh"                          ; 05
   :hour-12-d         "h"                           ; 5
   :am-pm             #?(:cljs "A"    :clj "a")     ; AM
   :minute-d          "m"                           ; 7, 39
   :minute-dd         "mm"                          ; 07, 39
   :second-dd         "ss"                          ; 08, 45
   :millisecond-ddd   "SSS"                         ; 001, 423
   :day-of-year       #?(:cljs "DDD"  :clj "D")     ; 235
   :week-of-year      #?(:cljs "wo"   :clj "w")})   ; 34th in CLJS, 34 in CLJ. No ordinal numbers in Java.
(defn- format-string-literal [lit]
  #?(:cljs (str "[" lit "]")
     :clj  (str "'" (str/replace lit "'" "''") "'")))

Given a data structure describing the date format, as given in [[format-strings]], return a function that takes a date object and formats it.

(defn ->formatter
  [format-list]
  (let [js->clj   #?(:cljs js->clj :clj identity)
        parts     (for [fmt (js->clj format-list)]
                    (cond
                      (keyword? fmt)             (get format-strings fmt)
                      (= fmt ":")                (format-string-literal ":")
                      (str/starts-with? fmt ":") (-> fmt (subs 1) keyword format-strings)
                      (string? fmt)              (format-string-literal fmt)
                      :else                      (throw (ex-info "Unknown element of date format"
                                                                 {:bad-element fmt
                                                                  :format      format-list}))))
        fmt-str   (apply str parts)]
    #?(:cljs #(.format % fmt-str)
       :clj  (let [formatter (DateTimeFormatter/ofPattern fmt-str)]
               #(.format formatter %)))))
 

Preload magic to load cljs-devtools. Only imported by dev.js in dev mode; no-op in production.

(ns metabase.util.devtools
  ;; This special context is defined only for dev-mode shadow-cljs builds; see shadow-cljs.edn
  ;; In release builds, and JVM Clojure, this file is an empty namespace.
  #?(:cljs-dev (:require
                 [devtools.core :as devtools]
                 [shadow.cljs.devtools.client.browser])))
 

Logic for determining whether two pMBQL queries are equal.

(ns metabase.lib.equality
  (:refer-clojure :exclude [=])
  (:require
   [medley.core :as m]
   [metabase.lib.card :as lib.card]
   [metabase.lib.convert :as lib.convert]
   [metabase.lib.dispatch :as lib.dispatch]
   [metabase.lib.hierarchy :as lib.hierarchy]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.options :as lib.options]
   [metabase.lib.ref :as lib.ref]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.lib.schema.ref :as lib.schema.ref]
   [metabase.lib.util :as lib.util]
   [metabase.util.malli :as mu]
   #?@(:clj ([metabase.util.log :as log]))))

Determine whether two already-normalized pMBQL maps, clauses, or other sorts of expressions are equal. The basic rule is that two things are considered equal if they are [[clojure.core/=]], or, if they are both maps, if they are [[clojure.core/=]] if you ignore all qualified keyword keys besides :lib/type.

(defmulti =
  {:arglists '([x y])}
  ;; two things with different dispatch values (for maps, the `:lib/type` key; for MBQL clauses, the tag, and for
  ;; everything else, the `:dispatch-type/*` key) can't be equal.
  (fn [x y]
    (let [x-dispatch-value (lib.dispatch/dispatch-value x)
          y-dispatch-value (lib.dispatch/dispatch-value y)]
      (if (not= x-dispatch-value y-dispatch-value)
        ::different-dispatch-values
        x-dispatch-value)))
  :hierarchy lib.hierarchy/hierarchy)
(defmethod = ::different-dispatch-values
  [_x _y]
  false)

Set of keys in a map that we consider relevant for [[=]] purposes.

(defn- relevant-keys-set
  [m]
  (into #{}
        (remove (fn [k]
                  (and (qualified-keyword? k)
                       (not= k :lib/type))))
        (keys m)))
(defmethod = :dispatch-type/map
  [m1 m2]
  (let [m1-keys (relevant-keys-set m1)
        m2-keys (relevant-keys-set m2)]
    (and (clojure.core/= m1-keys m2-keys)
         (every? (fn [k]
                   (= (get m1 k)
                      (get m2 k)))
                 m1-keys))))
(defmethod = :dispatch-type/sequential
  [xs ys]
  (and (clojure.core/= (count xs) (count ys))
       (loop [[x & more-x] xs, [y & more-y] ys]
         (and (= x y)
              (or (empty? more-x)
                  (recur more-x more-y))))))
(def ^:private ^:dynamic *side->uuid->index* nil)
(defn- aggregation-uuid->index
  [stage]
  (into {}
        (map-indexed (fn [idx [_tag {ag-uuid :lib/uuid}]]
                       [ag-uuid idx]))
        (:aggregation stage)))
(defmethod = :mbql.stage/mbql
  [x y]
  (binding [*side->uuid->index* {:left (aggregation-uuid->index x)
                                 :right (aggregation-uuid->index y)}]
    ((get-method = :dispatch-type/map) x y)))
(defmethod = :aggregation
  [[x-tag x-opts x-uuid :as x] [y-tag y-opts y-uuid :as y]]
  (and (clojure.core/= 3 (count x) (count y))
       (clojure.core/= x-tag y-tag)
       (= x-opts y-opts)
       ;; If nil, it means we aren't comparing a stage, so just compare the uuid directly
       (if *side->uuid->index*
         (clojure.core/= (get-in *side->uuid->index* [:left x-uuid] ::no-left)
                         (get-in *side->uuid->index* [:right y-uuid] ::no-right))
         (clojure.core/= x-uuid y-uuid))))

if we've gotten here we at least know the dispatch values for x and y are the same, which means the types will be the same.

(defmethod = :default
  [x y]
  (cond
    (map? x)        ((get-method = :dispatch-type/map) x y)
    (sequential? x) ((get-method = :dispatch-type/sequential) x y)
    :else           (clojure.core/= x y)))
(mu/defn resolve-field-id :- ::lib.schema.metadata/column
  "Integer Field ID: get metadata from the metadata provider. If this is the first stage of the query, merge in
  Saved Question metadata if available.
  This doesn't really have a good home. It's used here and by [[metabase.lib.field]], but because it depends on eg.
  [[metabase.lib.card]] and [[metabase.lib.convert]] it can't go in [[metabase.lib.metadata.calculation]]."
  [query        :- ::lib.schema/query
   stage-number :- :int
   field-id     :- ::lib.schema.id/field]
  (merge
   (when (lib.util/first-stage? query stage-number)
     (when-let [card-id (lib.util/source-card-id query)]
       (when-let [card-metadata (lib.card/saved-question-metadata query card-id)]
         (m/find-first #(clojure.core/= (:id %) field-id)
                       card-metadata))))
   (try
     (lib.metadata/field query field-id)
     (catch #?(:clj Throwable :cljs :default) _
       nil))))
(mu/defn ^:private column-join-alias :- [:maybe :string]
  [column :- ::lib.schema.metadata/column]
  ((some-fn :metabase.lib.join/join-alias :source-alias) column))
(mu/defn ^:private matching-join? :- :boolean
  [[_ref-kind {:keys [join-alias source-field]} _ref-id] :- ::lib.schema.ref/ref
   column                                                :- ::lib.schema.metadata/column]
  ;; If the ref has a source-field, and it matches the column's :fk-field-id then this is an implicitly joined field.
  ;; Implicitly joined columns have :source-alias ("PRODUCTS__via__PRODUCT_ID") but the refs don't have any join alias.
  (or (and source-field
           (clojure.core/= source-field (:fk-field-id column)))
      ;; If it's not an implicit join, then either the join aliases must match for an explicit join, or both be nil for
      ;; an own column.
      (clojure.core/= (column-join-alias column) join-alias)))
(mu/defn ^:private plausible-matches-for-name :- [:sequential ::lib.schema.metadata/column]
  [[_ref-kind _opts ref-name :as a-ref] :- ::lib.schema.ref/ref
   columns                              :- [:sequential ::lib.schema.metadata/column]]
  (or (not-empty (filter #(and (clojure.core/= (:lib/desired-column-alias %) ref-name)
                               (matching-join? a-ref %))
                         columns))
      (filter #(and (clojure.core/= (:name %) ref-name)
                    (matching-join? a-ref %))
              columns)))
(mu/defn ^:private plausible-matches-for-id :- [:sequential ::lib.schema.metadata/column]
  [[_ref-kind opts ref-id :as a-ref] :- ::lib.schema.ref/ref
   columns                           :- [:sequential ::lib.schema.metadata/column]
   generous?                         :- [:maybe :boolean]]
  (or (not-empty (filter #(and (clojure.core/= (:id %) ref-id)
                               ;; TODO: If the target ref has no join-alias, AND the source is fields or card, the join
                               ;; alias on the column can be ignored. QP can set it when it shouldn't. See #33972.
                               (or (and (not (:join-alias opts))
                                        (#{:source/fields :source/card} (:lib/source %)))
                                   (matching-join? a-ref %)))
                         columns))
      (when generous?
        (not-empty (filter #(clojure.core/= (:id %) ref-id) columns)))
      []))
(defn- ambiguous-match-error [a-ref columns]
  (ex-info "Ambiguous match! Implement more logic in disambiguate-matches."
           {:ref a-ref
            :columns columns}))
(mu/defn ^:private expression-column? [column]
  (or (= (:lib/source column) :source/expressions)
      (:lib/expression-name column)))
(mu/defn ^:private disambiguate-matches-dislike-field-refs-to-expressions :- [:maybe ::lib.schema.metadata/column]
  "If a custom column is a simple wrapper for a field, that column gets `:id`, `:table_id`, etc.
  A custom column should get a ref like `[:expression {} \"expr name\"]`, not `[:field {} 17]`.
  If we got a `:field` ref, prefer matches which are not `:lib/source :source/expressions`."
  [a-ref   :- ::lib.schema.ref/ref
   columns :- [:sequential ::lib.schema.metadata/column]]
  (or (when (= (first a-ref) :field)
        (when-let [non-exprs (not-empty (remove expression-column? columns))]
          (when-not (next non-exprs)
            (first non-exprs))))
      ;; In all other cases, this is an ambiguous match.
      #_(throw (ambiguous-match-error a-ref columns))
      #?(:cljs (js/console.warn (ambiguous-match-error a-ref columns))
         :clj  (log/warn (ambiguous-match-error a-ref columns)))))
(mu/defn ^:private disambiguate-matches-prefer-explicit :- [:maybe ::lib.schema.metadata/column]
  "Prefers table-default or explicitly joined columns over implicitly joinable ones."
  [a-ref   :- ::lib.schema.ref/ref
   columns :- [:sequential ::lib.schema.metadata/column]]
  (if-let [no-implicit (not-empty (remove :fk-field-id columns))]
    (if-not (next no-implicit)
      (first no-implicit)
      (disambiguate-matches-dislike-field-refs-to-expressions a-ref no-implicit))
    nil))
(mu/defn ^:private disambiguate-matches-no-alias :- [:maybe ::lib.schema.metadata/column]
  [a-ref   :- ::lib.schema.ref/ref
   columns :- [:sequential ::lib.schema.metadata/column]]
  ;; a-ref without :join-alias - if exactly one column has no :source-alias, that's the match.
  ;; ignore the source alias on columns with :source/card or :source/fields
  (if-let [no-alias (not-empty (remove #(and (column-join-alias %)
                                             (not (#{:source/card} (:lib/source %))))
                                       columns))]
    ;; At least 1 matching column with no :source-alias.
    (if-not (next no-alias)
      (first no-alias)
      ;; More than 1, keep digging.
      (disambiguate-matches-prefer-explicit a-ref no-alias))
    ;; No columns are missing :source-alias - pass them all to the next stage.
    ;; TODO: I'm not certain this one is sound, but it's necessary to make `lib.join/select-home-column` work as
    ;; written. If this case causes issues, that logic may need rewriting.
    nil))
(mu/defn ^:private disambiguate-matches :- [:maybe ::lib.schema.metadata/column]
  [a-ref   :- ::lib.schema.ref/ref
   columns :- [:sequential ::lib.schema.metadata/column]]
  (let [{:keys [join-alias]} (lib.options/options a-ref)]
    (if join-alias
      ;; a-ref has a :join-alias, match on that. Return nil if nothing matches.
      (when-let [matches (not-empty (filter #(clojure.core/= (column-join-alias %) join-alias) columns))]
        (if-not (next matches)
          (first matches)
          (#?(:cljs js/console.warn :clj log/warn)
           "Multiple plausible matches with the same :join-alias - more disambiguation needed"
           {:ref     a-ref
            :matches matches})
          #_(throw (ex-info "Multiple plausible matches with the same :join-alias - more disambiguation needed"
                          {:ref     a-ref
                           :matches matches}))))
      (disambiguate-matches-no-alias a-ref columns))))
(def ^:private FindMatchingColumnOptions
  [:map [:generous? {:optional true} :boolean]])
(mu/defn find-matching-column :- [:maybe ::lib.schema.metadata/column]
  "Given `a-ref-or-column` and a list of `columns`, finds the column that best matches this ref or column.
  Matching is based on finding the basically plausible matches first. There is often zero or one plausible matches, and
  this can return quickly.
  If there are multiple plausible matches, they are disambiguated by the most important extra included in the `ref`.
  (`:join-alias` first, then `:temporal-unit`, etc.)
  - Integer IDs in the `ref` are matched by ID; this usually is unambiguous.
    - If there are multiple joins on one table (including possible implicit joins), check `:join-alias` next.
      - If `a-ref` has a `:join-alias`, only a column which matches it can be the match, and it should be unique.
      - If `a-ref` doesn't have a `:join-alias`, prefer the column with no `:join-alias`, and prefer already selected
        columns over implicitly joinable ones.
    - There may be broken cases where the ref has an ID but the column does not. Therefore the ID must be resolved to a
      name or `:lib/desired-column-alias` and matched that way.
      - `query` and `stage-number` are required for this case, since they're needed to resolve the correct name.
      - Columns with `:id` set are dropped to prevent them matching. (If they didn't match by `:id` above they shouldn't
        match by name due to a coincidence of column names in different tables.)
  - String IDs are checked against `:lib/desired-column-alias` first.
    - If that doesn't match any columns, `:name` is compared next.
    - The same disambiguation (by `:join-alias` etc.) is applied if there are multiple plausible matches.
  Returns the matching column, or nil if no match is found."
  ([a-ref columns]
   (find-matching-column a-ref columns {}))
  ([[ref-kind _opts ref-id :as a-ref] :- ::lib.schema.ref/ref
    columns                           :- [:sequential ::lib.schema.metadata/column]
    {:keys [generous?]}               :- FindMatchingColumnOptions]
   (case ref-kind
     ;; Aggregations are referenced by the UUID of the column being aggregated.
     :aggregation  (m/find-first #(and (clojure.core/= (:lib/source %) :source/aggregations)
                                       (clojure.core/= (:lib/source-uuid %) ref-id))
                                 columns)
     ;; Expressions are referenced by name; fields by ID or name.
     (:expression
       :field)     (let [plausible (if (string? ref-id)
                                     (plausible-matches-for-name a-ref columns)
                                     (plausible-matches-for-id   a-ref columns generous?))]
                     (case (count plausible)
                       0 nil
                       1 (first plausible)
                       (disambiguate-matches a-ref plausible)))
     (throw (ex-info "Unknown type of ref" {:ref a-ref}))))
  ([query stage-number a-ref-or-column columns]
   (find-matching-column query stage-number a-ref-or-column columns {}))
  ([query           :- [:maybe ::lib.schema/query]
    stage-number    :- :int
    a-ref-or-column :- [:or ::lib.schema.metadata/column ::lib.schema.ref/ref]
    columns         :- [:sequential ::lib.schema.metadata/column]
    opts            :- FindMatchingColumnOptions]
   (let [[_ref-kind _opts ref-id :as a-ref] (if (lib.util/clause? a-ref-or-column)
                                              a-ref-or-column
                                              (lib.ref/ref a-ref-or-column))]
     (or (find-matching-column a-ref columns opts)
         ;; We failed to match by ID, so try again with the column's name. Any columns with `:id` set are dropped.
         ;; Why? Suppose there are two CREATED_AT columns in play - if one has an :id and it failed to match above, then
         ;; it certainly shouldn't match by name just because of the coincidence of column names!
       (when (and query (number? ref-id))
         (when-let [no-id-columns (not-empty (remove :id columns))]
           (when-let [resolved (if (lib.util/clause? a-ref-or-column)
                                 (resolve-field-id query stage-number ref-id)
                                 a-ref-or-column)]
             (find-matching-column (-> (assoc a-ref 2 (or (:lib/desired-column-alias resolved)
                                                          (:name resolved)))
                                       ;; make sure the :field ref has a `:base-type`, it's against the rules for a
                                       ;; nominal :field ref not to have a base-type -- this can fail schema
                                       ;; validation if it's missing in the Field ID ref we generate the nominal ref
                                       ;; from.
                                       (lib.options/update-options (partial merge {:base-type :type/*})))
                                   no-id-columns
                                   opts))))))))
(defn- ref-id-or-name [[_ref-kind _opts id-or-name]]
  id-or-name)
(mu/defn find-matching-ref :- [:maybe ::lib.schema.ref/ref]
  "Given `column` and a list of `refs`, finds the ref that best matches this column.
  Throws if there are multiple, ambiguous matches.
  Returns the matching ref, or nil if no plausible matches are found."
  [column :- ::lib.schema.metadata/column
   refs   :- [:sequential ::lib.schema.ref/ref]]
  (let [ref-tails (group-by ref-id-or-name refs)
        matches   (or (some->> column :lib/source-uuid (get ref-tails) not-empty)
                      (not-empty (get ref-tails (:id column)))
                      (not-empty (get ref-tails (:lib/desired-column-alias column)))
                      (get ref-tails (:name column))
                      [])]
    (case (count matches)
      0 nil
      1 (first matches)
      (throw (ex-info "Ambiguous match: given column matches multiple refs"
                      {:column        column
                       :matching-refs matches})))))
(mu/defn find-column-indexes-for-refs :- [:sequential :int]
  "Given a list `haystack` of columns or refs, and a list `needles` of refs to searc for, this returns a list parallel
  to `needles` with the corresponding index into the `haystack`, or -1 if not found.
  DISCOURAGED: This is intended for use only by [[metabase.lib.js/find-column-indexes-from-legacy-refs]].
  Other MLv2 code should use [[find-matching-column]] if the `haystack` is columns, or
  [[find-matching-ref]] if it's refs."
  [query        :- ::lib.schema/query
   stage-number :- :int
   needles      :- [:sequential ::lib.schema.ref/ref]
   haystack     :- [:sequential ::lib.schema.metadata/column]]
  (let [by-column (into {}
                        (map-indexed (fn [index column]
                                       [column index]))
                        haystack)]
    (for [needle needles
          :let [matched (find-matching-column query stage-number needle haystack)]]
      (get by-column matched -1))))

TODO: Refactor this away. Handle legacy refs in lib.js, then call [[find-matching-column]] directly.

(mu/defn find-column-for-legacy-ref :- [:maybe ::lib.schema.metadata/column]
  "Like [[find-matching-column]], but takes a legacy MBQL reference. The name here is for consistency with other
  FE names for similar functions."
  ([query legacy-ref metadatas]
   (find-column-for-legacy-ref query -1 legacy-ref metadatas))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    legacy-ref   :- :some
    metadatas    :- [:maybe [:sequential ::lib.schema.metadata/column]]]
   (find-matching-column query stage-number (lib.convert/legacy-ref->pMBQL query stage-number legacy-ref) metadatas)))

Mark columns as :selected? if they appear in selected-columns-or-refs. Uses fuzzy matching with [[find-matching-column]].

Example usage:

;; example (simplified) implementation of [[metabase.lib.field/fieldable-columns]] ;; ;; return (visibile-columns query), but if any of those appear in :fields, mark then :selected? (mark-selected-columns (visible-columns query) (:fields stage))

(defn mark-selected-columns
  ([cols selected-columns-or-refs]
   (mark-selected-columns nil -1 cols selected-columns-or-refs))
  ([query stage-number cols selected-columns-or-refs]
   (when (seq cols)
     (let [selected-refs          (mapv lib.ref/ref selected-columns-or-refs)
           matching-selected-cols (into #{}
                                        (map #(find-matching-column query stage-number % cols))
                                        selected-refs)]
       (mapv #(assoc % :selected? (contains? matching-selected-cols %)) cols)))))
(mu/defn matching-column-sets? :- :boolean
  "Returns true if the provided `refs` is the same set as the provided `columns`.
  Order is ignored. Only returns true if each of the `refs` matches a column, and each of the `columns` is matched by
  exactly 1 of the `refs`. (A bijection, in math terms.)"
  [query        :- ::lib.schema/query
   stage-number :- :int
   refs         :- [:sequential ::lib.schema.ref/ref]
   columns      :- [:sequential ::lib.schema.metadata/column]]
  ;; The lists match iff:
  ;; - Each ref matches a column; AND
  ;; - Each column was matched by exactly one ref
  ;; So we return true if nil is not a key in the matching, AND all vals in the matching have length 1,
  ;; AND the matching has as many elements as `columns` (usually the list of columns returned by default).
  (and (= (count refs) (count columns))
       (let [matching (group-by #(find-matching-column query stage-number % columns) refs)]
         (and (not (contains? matching nil))
              (= (count matching) (count columns))
              (every? #(= (count %) 1) (vals matching))))))
 
(ns metabase.util.format
  #?(:clj  (:require
            [colorize.core :as colorize]
            [metabase.config :as config])
     :cljs (:require
            [goog.string :as gstring])))
(defn- format-with-unit [n suffix]
  #?(:clj  (format "%.1f %s" n suffix)
     :cljs (str (.toFixed n 1) " " suffix)))

Format a time interval in nanoseconds to something more readable. (µs/ms/etc.)

(defn format-nanoseconds
  ^String [nanoseconds]
  ;; The basic idea is to take `n` and see if it's greater than the divisior. If it is, we'll print it out as that
  ;; unit. If more, we'll divide by the divisor and recur, trying each successively larger unit in turn. e.g.
  ;;
  ;; (format-nanoseconds 500)    ; -> "500 ns"
  ;; (format-nanoseconds 500000) ; -> "500 µs"
  (loop [n nanoseconds, [[unit divisor] & more] [[:ns 1000] [:µs 1000] [:ms 1000] [:s 60] [:mins 60] [:hours 24]
                                                 [:days 7] [:weeks (/ 365.25 7)]
                                                 [:years #?(:clj  Double/POSITIVE_INFINITY
                                                            :cljs js/Number.POSITIVE_INFINITY)]]]
    (if (and (> n divisor)
             (seq more))
      (recur (/ n divisor) more)
      (format-with-unit (double n) (name unit)))))

Format a time interval in microseconds into something more readable.

(defn format-microseconds
  ^String [microseconds]
  (format-nanoseconds (* 1000.0 microseconds)))

Format a time interval in milliseconds into something more readable.

(defn format-milliseconds
  ^String [milliseconds]
  (format-microseconds (* 1000.0 milliseconds)))

Format a time interval in seconds into something more readable.

(defn format-seconds
  ^String [seconds]
  (format-milliseconds (* 1000.0 seconds)))

Nicely format num-bytes as kilobytes/megabytes/etc.

(format-bytes 1024) ; -> 2.0 KB

(defn format-bytes
  [num-bytes]
  (loop [n num-bytes [suffix & more] ["B" "KB" "MB" "GB"]]
    (if (and (seq more)
             (>= n 1024))
      (recur (/ n 1024.0) more)
      (format-with-unit n suffix))))
#?(:clj
   (def ^:private colorize?
     ;; As of 0.35.0 we support the NO_COLOR env var. See https://no-color.org/ (But who hates color logs?)
     (if (config/config-str :no-color)
       false
       (config/config-bool :mb-colorize-logs))))

Colorize string x using color, a symbol or keyword, but only if MB_COLORIZE_LOGS is enabled (the default). color can be green, red, yellow, blue, cyan, magenta, etc. See the entire list of avaliable colors here

(def ^{:arglists '(^String [color-symb x])} colorize
  #?(:clj  (if colorize?
             (fn [color x]
               (colorize/color (keyword color) (str x)))
             (fn [_ x]
               (str x)))
     :cljs (fn [_ x]
             (str x))))

With one arg, converts something to a string and colorizes it. With two args, behaves like format, but colorizes the output.

(format-color :red "%d cans" 2)

(defn format-color
  {:arglists '(^String [color x] ^String [color format-string & args])}
  (^String [color x]
   (colorize color x))
  (^String [color format-str & args]
   (colorize color (apply #?(:clj format :cljs gstring/format) format-str args))))
 

Malli schemas for string, temporal, number, and boolean literals.

(ns metabase.lib.schema.literal
  (:require
   #?@(:clj ([metabase.lib.schema.literal.jvm]))
   [malli.core :as mc]
   [metabase.lib.schema.common :as common]
   [metabase.lib.schema.expression :as expression]
   [metabase.lib.schema.mbql-clause :as mbql-clause]
   [metabase.shared.util.internal.time-common :as shared.ut.common]
   [metabase.util.malli.registry :as mr]))
(defmethod expression/type-of-method :dispatch-type/nil
  [_nil]
  :type/*)
(mr/def ::boolean
  :boolean)
(defmethod expression/type-of-method :dispatch-type/boolean
  [_bool]
  :type/Boolean)
(mr/def ::boolean
  :boolean)
(mr/def ::integer
  #?(:clj [:or
           :int
           :metabase.lib.schema.literal.jvm/big-integer]
     :cljs :int))
(defmethod expression/type-of-method :dispatch-type/integer
  [_int]
  :type/Integer)

we should probably also restrict this to disallow NaN and positive/negative infinity, I don't know in what universe we'd want to allow those if they're not disallowed already.

(mr/def ::non-integer-real
  #?(:clj [:or
           :double
           :metabase.lib.schema.literal.jvm/float
           :metabase.lib.schema.literal.jvm/big-decimal]
     :cljs :double))
(defmethod expression/type-of-method :dispatch-type/number
  [_non-integer-real]
  ;; `:type/Float` is the 'base type' of all non-integer real number types in [[metabase.types]] =(
  :type/Float)
(mr/def ::string
  :string)

TODO -- these temporal literals could be a little stricter, right now they are pretty permissive, you shouldn't be allowed to have month 13 or 02-29 for example

(mr/def ::string.date
  [:re
   {:error/message "date string literal"}
   shared.ut.common/local-date-regex])
(mr/def ::string.zone-offset
  [:re
   {:error/message "timezone offset string literal"}
   shared.ut.common/zone-offset-part-regex])
(mr/def ::string.time
  [:or
   [:re
    {:error/message "local time string literal"}
    shared.ut.common/local-time-regex]
   [:re
    {:error/message "offset time string literal"}
    shared.ut.common/offset-time-regex]])
(mr/def ::string.datetime
  [:or
   [:re
    {:error/message "local date time string literal"}
    shared.ut.common/local-datetime-regex]
   [:re
    {:error/message "offset date time string literal"}
    shared.ut.common/offset-datetime-regex]])
(defmethod expression/type-of-method :dispatch-type/string
  [s]
  (condp mc/validate s
    ::string.datetime #{:type/Text :type/DateTime}
    ::string.date     #{:type/Text :type/Date}
    ::string.time     #{:type/Text :type/Time}
    :type/Text))
(mr/def ::date
  #?(:clj  [:or
            [:time/local-date {:error/message "instance of java.time.LocalDate"}]
            ::string.date]
     :cljs ::string.date))
(mr/def ::time
  #?(:clj [:or
           ::string.time
           [:time/local-time {:error/message "instance of java.time.LocalTime"}]
           [:time/offset-time {:error/message "instance of java.time.OffsetTime"}]]
     :cljs ::string.time))
(mr/def ::datetime
  #?(:clj [:or
           ::string.datetime
           [:time/local-date-time {:error/message "instance of java.time.LocalDateTime"}]
           [:time/offset-date-time {:error/message "instance of java.time.OffsetDateTime"}]
           [:time/zoned-date-time {:error/message "instance of java.time.ZonedDateTime"}]]
     :cljs ::string.datetime))
(mr/def ::temporal
  [:or
   ::date
   ::time
   ::datetime])

these are currently only allowed inside :absolute-datetime

(mr/def ::string.year-month
  [:re
   {:error/message "year-month string literal"}
   shared.ut.common/year-month-regex])
(mr/def ::string.year
  [:re
   {:error/message "year string literal"}
   shared.ut.common/year-regex])

:effective-type is required for :value clauses. This was not a rule in the legacy MBQL schema, but in actual usage they basically always have :base-type; in MLv2 we're trying to use :effective-type everywhere instead; These clauses are useless/pointless without type information anyway, so let's enforce this rule going forward. Conversion can take care of :base-type <=> :effective-type as needed.

(mr/def ::value.options
  [:merge
   [:ref ::common/options]
   [:map
    [:effective-type ::common/base-type]]])

[:value ] clauses are mostly used internally by the query processor to add type information to literals, to make it easier for drivers to process queries; see the [[metabase.query-processor.middleware.wrap-value-literals]] middleware. It is also used to differentiate nil (as in no clause or value) from something intended to be NULL in a compiled query, and to associate type information with that nil. Even if this is mostly used internally, the schema still needs to know about it.

The schema itself does not currently enforce that the actual matches up with the :effective-type in the options map; this is only enforced in the QP. For now, it assumes you know what you are doing and takes your word for it when you say something has a given :effective-type.

(mbql-clause/define-mbql-clause :value
  [:tuple
   {:error/message "Value :value clause"}
   #_tag   [:= :value]
   #_opts  [:ref ::value.options]
   #_value any?])
 
(ns metabase.util.malli
  (:refer-clojure :exclude [fn defn defmethod])
  (:require
   #?@(:clj
       ([metabase.util.i18n]
        [metabase.util.malli.defn :as mu.defn]
        [metabase.util.malli.fn :as mu.fn]
        [net.cgrand.macrovich :as macros]
        [potemkin :as p]))
   [clojure.core :as core]
   [malli.core :as mc]
   [malli.destructure]
   [malli.error :as me]
   [malli.util :as mut]
   [metabase.shared.util.i18n :as i18n])
  #?(:cljs (:require-macros [metabase.util.malli])))
#?(:clj
   (p/import-vars
    [mu.fn fn]
    [mu.defn defn]))

Pass into mu/humanize to include the value received in the error message.

(core/defn humanize-include-value
  [{:keys [value message]}]
  ;; TODO Should this be translated with more complete context? (tru "{0}, received: {1}" message (pr-str value))
  (str message ", " (i18n/tru "received") ": " (pr-str value)))

Explains a schema failure, and returns the offending value.

(core/defn explain
  [schema value]
  (-> (mc/explain schema value)
      (me/humanize {:wrap humanize-include-value})))
(def ^:private Schema
  [:and any?
   [:fn {:description "a malli schema"} mc/schema]])

Schema for localized string.

(def localized-string-schema
  #?(:clj  [:fn {:error/message "must be a localized string"}
            metabase.util.i18n/localized-string?]
     ;; TODO Is there a way to check if a string is being localized in CLJS, by the `ttag`?
     ;; The compiler seems to just inline the translated strings with no annotation or wrapping.
     :cljs :string))

Update a malli schema to have a :description (used by umd/describe, which is used by api docs), and a :error/fn (used by me/humanize, which is used by defendpoint). They don't have to be the same, but usually are.

(with-api-error-message [:string {:min 1}] (deferred-tru "Must be a string with at least 1 character representing a User ID."))

Kondo gets confused by :refer [defn] on this, so it's referenced fully qualified.

(metabase.util.malli/defn with-api-error-message
  {:style/indent [:form]}
  ([mschema :- Schema error-message :- localized-string-schema]
   (with-api-error-message mschema error-message error-message))
  ([mschema                :- :any
    description-message    :- localized-string-schema
    specific-error-message :- localized-string-schema]
   (mut/update-properties (mc/schema mschema) assoc
                          ;; override generic description in api docs and :errors key in API's response
                          :description description-message
                          ;; override generic description in :specific-errors key in API's response
                          :error/fn    (constantly specific-error-message))))

Convenience for disabling [[defn]] and [[metabase.util.malli.fn/fn]] input/output schema validation. Since input/output validation is currently disabled for ClojureScript, this is a no-op.

#?(:clj
   (defmacro disable-enforcement
     {:style/indent 0}
     [& body]
     (macros/case
       :clj
       `(binding [mu.fn/*enforce* false]
          ~@body)
       :cljs
       `(do ~@body))))

Impl for [[defmethod]] for regular Clojure.

Impl for [[defmethod]] for ClojureScript.

#?(:clj
   (defmacro -defmethod-clj
     [multifn dispatch-value & fn-tail]
     (let [dispatch-value-symb (gensym "dispatch-value-")
           error-context-symb  (gensym "error-context-")]
       `(let [~dispatch-value-symb ~dispatch-value
              ~error-context-symb  {:fn-name        '~(or (some-> (resolve multifn) symbol)
                                                          (symbol multifn))
                                    :dispatch-value ~dispatch-value-symb}
              f#                   ~(mu.fn/instrumented-fn-form error-context-symb (mu.fn/parse-fn-tail fn-tail))]
          (.addMethod ~(vary-meta multifn assoc :tag 'clojure.lang.MultiFn)
                      ~dispatch-value-symb
                      f#)))))
#?(:clj
   (defmacro -defmethod-cljs
     [multifn dispatch-value & fn-tail]
     `(core/defmethod ~multifn ~dispatch-value
        ~@(mu.fn/deparameterized-fn-tail (mu.fn/parse-fn-tail fn-tail)))))

Like [[schema.core/defmethod]], but for Malli.

#?(:clj
   (defmacro defmethod
     [multifn dispatch-value & fn-tail]
     (macros/case
       :clj  `(-defmethod-clj ~multifn ~dispatch-value ~@fn-tail)
       :cljs `(-defmethod-cljs ~multifn ~dispatch-value ~@fn-tail))))

Returns the value if it matches the schema, else throw an exception.

#?(:clj
   (defn validate-throw
     [schema-or-validator value]
     (if-not ((if (fn? schema-or-validator)
                schema-or-validator
                (mc/validator schema-or-validator))
              value)
       (throw (ex-info "Value does not match schema" {:value value :schema schema-or-validator}))
       value)))
 

Code related to the new writeback Actions.

(ns metabase.actions
  (:require
   [clojure.spec.alpha :as s]
   [malli.core :as mc]
   [malli.error :as me]
   [metabase.api.common :as api]
   [metabase.driver :as driver]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.models :refer [Database]]
   [metabase.models.setting :as setting]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.middleware.permissions :as qp.perms]
   [metabase.query-processor.store :as qp.store]
   [metabase.util :as u]
   [metabase.util.i18n :as i18n]
   [toucan2.core :as t2]))
(setting/defsetting database-enable-actions
  (i18n/deferred-tru "Whether to enable Actions for a specific Database.")
  :default false
  :type :boolean
  :visibility :public
  :database-local :only)

Normalize the arg-map passed to [[perform-action!]] for a specific action.

(defmulti normalize-action-arg-map
  {:arglists '([action arg-map]), :added "0.44.0"}
  (fn [action _arg-map]
    (keyword action)))
(defmethod normalize-action-arg-map :default
  [_action arg-map]
  arg-map)

Return the appropriate spec to use to validate the arg map passed to [[perform-action!*]].

(action-arg-map-spec :row/create) => :actions.args.crud/row.create

(defmulti action-arg-map-spec
  {:arglists '([action]), :added "0.44.0"}
  keyword)
(defmethod action-arg-map-spec :default
  [_action]
  any?)

Multimethod for doing an Action. The specific action is a keyword like :row/create or :bulk/create; the shape of arg-map depends on the action being performed. [[action-arg-map-spec]] returns the appropriate spec to use to validate the args for a given action. When implementing a new action type, be sure to implement both this method and [[action-arg-map-spec]].

At the time of this writing Actions are performed with either POST /api/action/:action-namespace/:action-name, which passes in the request body as args-map directly, or `POST /api/action/:action-namespace/:action-name/:table-id, which passes in anargs-map` like

{:table-id , :arg }

The former endpoint is currently used for the various :row/* Actions while the version with :table-id as part of the route is currently used for :bulk/* Actions.

DON'T CALL THIS METHOD DIRECTLY TO PERFORM ACTIONS -- use [[perform-action!]] instead which does normalization, validation, and binds Database-local values.

(defmulti perform-action!*
  {:arglists '([driver action database arg-map]), :added "0.44.0"}
  (fn [driver action _database _arg-map]
    [(driver/dispatch-on-initialized-driver driver)
     (keyword action)])
  :hierarchy #'driver/hierarchy)

Set of all known actions.

(defn- known-actions
  []
  (into #{}
        (comp (filter sequential?)
              (map second))
        (keys (methods perform-action!*))))
(defmethod perform-action!* :default
  [driver action _database _arg-map]
  (let [action        (keyword action)
        known-actions (known-actions)]
    ;; return 404 if the action doesn't exist.
    (when-not (contains? known-actions action)
      (throw (ex-info (i18n/tru "Unknown Action {0}. Valid Actions are: {1}"
                                action
                                (pr-str known-actions))
                      {:status-code 404})))
    ;; return 400 if the action does exist but is not supported by this DB
    (throw (ex-info (i18n/tru "Action {0} is not supported for {1} Databases."
                              action
                              (pr-str driver))
                    {:status-code 400}))))

A cache that lives for the duration of the top-level Action invoked by [[perform-action!]]. You can use this to store miscellaneous values such as things that need to be fetched from the application database to avoid duplicate calls in bulk actions that repeatedly call code that would only be called once by single-row Actions. Bound to an atom containing a map by [[perform-action!]].

(def ^:dynamic *misc-value-cache*
  nil)

Get a cached value from the [[misc-value-cache]] using a unique-key if it already exists. If it does not exist, calculate the value using value-thunk, cache it, then return it.

unique-key must be unique app-wide. Something like

[::cast-values table-id]

is a good key.

(defn cached-value
  [unique-key value-thunk]
  (or (when *misc-value-cache*
        (get @*misc-value-cache* unique-key))
      (let [value (value-thunk)]
        (when *misc-value-cache*
          (swap! *misc-value-cache* assoc unique-key value))
        value)))

Throws an appropriate error if actions are unsupported or disabled for a database, otherwise returns nil.

(defn check-actions-enabled-for-database!
  [{db-settings :settings db-id :id driver :engine db-name :name :as db}]
  (when-not (driver/database-supports? driver :actions db)
    (throw (ex-info (i18n/tru "{0} Database {1} does not support actions."
                              (u/qualified-name driver)
                              (format "%d %s" db-id (pr-str db-name)))
                    {:status-code 400, :database-id db-id})))
  (binding [setting/*database-local-values* db-settings]
    (when-not (database-enable-actions)
      (throw (ex-info (i18n/tru "Actions are not enabled.")
                      {:status-code 400, :database-id db-id}))))
  nil)
(defn- database-for-action [action-or-id]
  (t2/select-one Database {:select [:db.*]
                           :from   :action
                           :join   [[:report_card :card] [:= :card.id :action.model_id]
                                    [:metabase_database :db] [:= :db.id :card.database_id]]
                           :where  [:= :action.id (u/the-id action-or-id)]}))

Throws an appropriate error if actions are unsupported or disabled for the database of the action's model, otherwise returns nil.

(defn check-actions-enabled!
  [action-or-id]
  (check-actions-enabled-for-database! (api/check-404 (database-for-action action-or-id))))

Perform an action. Invoke this function for performing actions, e.g. in API endpoints; implement [[perform-action!*]] to add support for a new driver/action combo. The shape of arg-map depends on the action being performed. [[action-arg-map-spec]] returns the specific spec used to validate arg-map for a given action.

(defn perform-action!
  [action arg-map]
  (let [action  (keyword action)
        spec    (action-arg-map-spec action)
        arg-map (normalize-action-arg-map action arg-map)]
    (when (s/invalid? (s/conform spec arg-map))
      (throw (ex-info (format "Invalid Action arg map for %s: %s" action (s/explain-str spec arg-map))
                      (s/explain-data spec arg-map))))
    (let [{driver :engine :as db} (api/check-404 (qp.store/with-metadata-provider (:database arg-map)
                                                   (lib.metadata/database (qp.store/metadata-provider))))]
      (check-actions-enabled-for-database! db)
      (binding [*misc-value-cache* (atom {})]
        (qp.perms/check-query-action-permissions* arg-map)
        (driver/with-driver driver
          (perform-action!* driver action db arg-map))))))

Action definitions.

Common base spec for all Actions. All Actions at least require

{:database }

Anything else required depends on the action type.

(s/def :actions.args/id
  (s/and integer? pos?))
(s/def :actions.args.common/database
  :actions.args/id)
(s/def :actions.args/common
  (s/keys :req-un [:actions.args.common/database]))

Common base spec for all CRUD row Actions. All CRUD row Actions at least require

{:database , :query {:source-table }}

(s/def :actions.args.crud.row.common.query/source-table
  :actions.args/id)
(s/def :actions.args.crud.row.common/query
  (s/keys :req-un [:actions.args.crud.row.common.query/source-table]))
(s/def :actions.args.crud.row/common
  (s/merge
   :actions.args/common
   (s/keys :req-un [:actions.args.crud.row.common/query])))

the various :row/* Actions all treat their args map as an MBQL query.

Normalize query as an MBQL query. Optional arg :exclude is a set of normalized keys to exclude from recursive normalization, e.g. :create-row for the :row/create Action (we don't want to normalize the row input since preserving case and snake_keys in the request body is important).

(defn- normalize-as-mbql-query
  ([query]
   (let [query (mbql.normalize/normalize (assoc query :type :query))]
     (when-let [error (me/humanize (mc/explain mbql.s/Query query))]
       (throw (ex-info
               (i18n/tru "Invalid query: {0}" (pr-str error))
               {:status-code 400, :type qp.error-type/invalid-query})))
     query))
  ([query & {:keys [exclude]}]
   (let [query (update-keys query mbql.u/normalize-token)]
     (merge (select-keys query exclude)
            (normalize-as-mbql-query (apply dissoc query exclude))))))

:row/create

row/create requires at least

{:database :query {:source-table , :filter } :create-row }

(defmethod normalize-action-arg-map :row/create
  [_action query]
  (normalize-as-mbql-query query :exclude #{:create-row}))
(s/def :actions.args.crud.row.create/create-row
  (s/map-of keyword? any?))
(s/def :actions.args.crud/row.create
  (s/merge
   :actions.args.crud.row/common
   (s/keys :req-un [:actions.args.crud.row.create/create-row])))
(defmethod action-arg-map-spec :row/create
  [_action]
  :actions.args.crud/row.create)

:row/update

row/update requires at least

{:database :query {:source-table , :filter } :update-row }

(defmethod normalize-action-arg-map :row/update
  [_action query]
  (normalize-as-mbql-query query :exclude #{:update-row}))
(s/def :actions.args.crud.row.update.query/filter
  vector?) ; MBQL filter clause
(s/def :actions.args.crud.row.update/query
  (s/merge
   :actions.args.crud.row.common/query
   (s/keys :req-un [:actions.args.crud.row.update.query/filter])))
(s/def :actions.args.crud.row.update/update-row
  (s/map-of keyword? any?))
(s/def :actions.args.crud/row.update
  (s/merge
   :actions.args.crud.row/common
   (s/keys :req-un [:actions.args.crud.row.update/update-row
                    :actions.args.crud.row.update/query])))
(defmethod action-arg-map-spec :row/update
  [_action]
  :actions.args.crud/row.update)

:row/delete

row/delete requires at least

{:database :query {:source-table , :filter }}

(defmethod normalize-action-arg-map :row/delete
  [_action query]
  (normalize-as-mbql-query query))
(s/def :actions.args.crud.row.delete.query/filter
  vector?) ; MBQL filter clause
(s/def :actions.args.crud.row.delete/query
  (s/merge
   :actions.args.crud.row.common/query
   (s/keys :req-un [:actions.args.crud.row.delete.query/filter])))
(s/def :actions.args.crud/row.delete
  (s/merge
   :actions.args.crud.row/common
   (s/keys :req-un [:actions.args.crud.row.delete/query])))
(defmethod action-arg-map-spec :row/delete
  [_action]
  :actions.args.crud/row.delete)

Bulk actions

All bulk Actions require at least

{:database , :table-id , :rows [{ } ...]}

(s/def :actions.args.crud.bulk.common/table-id
  :actions.args/id)
(s/def :actions.args.crud.bulk/rows
  (s/cat :rows (s/+ (s/map-of string? any?))))
(s/def :actions.args.crud.bulk/common
  (s/merge
   :actions.args/common
   (s/keys :req-un [:actions.args.crud.bulk.common/table-id
                    :actions.args.crud.bulk/rows])))

The request bodies for the bulk CRUD actions are all the same. The body of a request to `POST /api/action/:action-namespace/:action-name/:table-id` is just a vector of rows but the API endpoint itself calls [[perform-action!]] with

{:database , :table-id , :arg }

and we transform this to

{:database <database-id>, :table-id <table-id>, :rows <request-body>}

:bulk/create, :bulk/delete, :bulk/update -- these all have the exact same shapes

(defn- normalize-bulk-crud-action-arg-map
  [{:keys [database table-id], rows :arg, :as _arg-map}]
  {:type :query, :query {:source-table table-id}
   :database database, :table-id table-id, :rows (map #(update-keys % u/qualified-name) rows)})
(defmethod normalize-action-arg-map :bulk/create
  [_action arg-map]
  (normalize-bulk-crud-action-arg-map arg-map))
(defmethod action-arg-map-spec :bulk/create
  [_action]
  :actions.args.crud.bulk/common)
(defmethod normalize-action-arg-map :bulk/update
  [_action arg-map]
  (normalize-bulk-crud-action-arg-map arg-map))
(defmethod action-arg-map-spec :bulk/update
  [_action]
  :actions.args.crud.bulk/common)

:bulk/delete

Request-body should look like:

;; single pk, two rows [{"ID": 76}, {"ID": 77}]

;; multiple pks, one row [{"PK1": 1, "PK2": "john"}]

(defmethod normalize-action-arg-map :bulk/delete
  [_action arg-map]
  (normalize-bulk-crud-action-arg-map arg-map))
(defmethod action-arg-map-spec :bulk/delete
  [_action]
  :actions.args.crud.bulk/common)
 
(ns metabase.actions.error)

Error type for SQL unique constraint violation.

(def violate-unique-constraint
  ::violate-unique-constraint)

Error type for SQL not null constraint violation.

(def violate-not-null-constraint
  ::violate-not-null-constraint)

Error type for SQL foreign key constraint violation.

(def violate-foreign-key-constraint
  ::violate-foreign-key-constraint)

Error type for SQL incorrect value type.

(def incorrect-value-type
  ::incorrect-value-type)
 
(ns metabase.actions.execution
  (:require
   [clojure.set :as set]
   [medley.core :as m]
   [metabase.actions :as actions]
   [metabase.actions.http-action :as http-action]
   [metabase.analytics.snowplow :as snowplow]
   [metabase.api.common :as api]
   [metabase.models :refer [Card DashboardCard Database Table]]
   [metabase.models.action :as action]
   [metabase.models.persisted-info :as persisted-info]
   [metabase.models.query :as query]
   [metabase.query-processor :as qp]
   [metabase.query-processor.card :as qp.card]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.middleware.permissions :as qp.perms]
   [metabase.query-processor.writeback :as qp.writeback]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   [toucan2.core :as t2]))

Execute a QueryAction with parameters as passed in from an endpoint of shape {<parameter-id> <value>}.

action should already be hydrated with its :card.

(defn- execute-query-action!
  [{:keys [dataset_query model_id] :as action} request-parameters]
  (log/tracef "Executing action\n\n%s" (u/pprint-to-str action))
  (try
    (let [parameters (for [parameter (:parameters action)]
                       (assoc parameter :value (get request-parameters (:id parameter))))
          query (-> dataset_query
                    (update :type keyword)
                    (assoc :parameters parameters))]
      (log/debugf "Query (before preprocessing):\n\n%s" (u/pprint-to-str query))
      (binding [qp.perms/*card-id* model_id]
        (qp.writeback/execute-write-query! query)))
    (catch Throwable e
      (if (= (:type (u/all-ex-data e)) qp.error-type/missing-required-permissions)
        (api/throw-403 e)
        (throw (ex-info (format "Error executing Action: %s" (ex-message e))
                        {:action     action
                         :parameters request-parameters}
                        e))))))
(defn- implicit-action-table
  [card_id]
  (let [card (t2/select-one Card :id card_id)
        {:keys [table-id]} (query/query->database-and-table-ids (:dataset_query card))]
    (t2/hydrate (t2/select-one Table :id table-id) :fields)))
(defn- execute-custom-action [action request-parameters]
  (let [{action-type :type} action]
    (actions/check-actions-enabled! action)
    (let [model (t2/select-one Card :id (:model_id action))]
      (when (and (= action-type :query) (not= (:database_id model) (:database_id action)))
        ;; the above check checks the db of the model. We check the db of the query action here
        (actions/check-actions-enabled-for-database!
         (t2/select-one Database :id (:database_id action)))))
    (try
     (case action-type
       :query
       (execute-query-action! action request-parameters)
       :http
       (http-action/execute-http-action! action request-parameters))
     (catch Exception e
       (log/error e "Error executing action.")
       (if-let [ed (ex-data e)]
         (let [ed (cond-> ed
                    (and (nil? (:status-code ed))
                         (= (:type ed) :missing-required-permissions))
                    (assoc :status-code 403)
                    (nil? (:message ed))
                    (assoc :message (ex-message e)))]
           (if (= (ex-data e) ed)
             (throw e)
             (throw (ex-info (ex-message e) ed e))))
         {:body {:message (or (ex-message e) (tru "Error executing action."))}
          :status 500})))))

Check that the given request parameters do not contain any parameters that are not in the given set of destination parameter ids

(defn- check-no-extra-parameters
  [request-parameters destination-param-ids]
  (let [extra-parameters (set/difference (set (keys request-parameters))
                                         (set destination-param-ids))]
    (api/check (empty? extra-parameters)
               400
               {:status-code            400
                :message                (tru "No destination parameter found for {0}. Found: {1}"
                                             (pr-str extra-parameters)
                                             (pr-str destination-param-ids))
                :type                   qp.error-type/invalid-parameter
                :parameters             request-parameters
                :destination-parameters destination-param-ids})))
(defn- build-implicit-query
  [{:keys [model_id parameters] :as _action} implicit-action request-parameters]
  (let [{database-id :db_id
         table-id :id :as table} (implicit-action-table model_id)
        table-fields             (:fields table)
        pk-fields                (filterv #(isa? (:semantic_type %) :type/PK) table-fields)
        slug->field-name         (->> table-fields
                                      (map (juxt (comp u/slugify :name) :name))
                                      (into {})
                                      (m/filter-keys (set (map :id parameters))))
        _                        (api/check (action/unique-field-slugs? table-fields)
                                   400
                                   (tru "Cannot execute implicit action on a table with ambiguous column names."))
        _                        (api/check (= (count pk-fields) 1)
                                   400
                                   (tru "Must execute implicit action on a table with a single primary key."))
        _                        (check-no-extra-parameters request-parameters (keys slug->field-name))
        pk-field                 (first pk-fields)
        ;; Ignore params with nil values; the client doesn't reliably omit blank, optional parameters from the
        ;; request. See discussion at #29049
        simple-parameters        (->> (update-keys request-parameters (comp keyword slug->field-name))
                                      (filter (fn [[_k v]] (some? v)))
                                      (into {}))
        pk-field-name            (keyword (:name pk-field))
        row-parameters           (cond-> simple-parameters
                                   (not= implicit-action :row/create) (dissoc pk-field-name))
        requires_pk              (contains? #{:row/delete :row/update} implicit-action)]
    (api/check (or (not requires_pk)
                   (some? (get simple-parameters pk-field-name)))
               400
               (tru "Missing primary key parameter: {0}"
                    (pr-str (u/slugify (:name pk-field)))))
    (cond->
      {:query {:database database-id,
               :type :query,
               :query {:source-table table-id}}
       :row-parameters row-parameters}
      requires_pk
      (assoc-in [:query :query :filter]
                [:= [:field (:id pk-field) nil] (get simple-parameters pk-field-name)])
      requires_pk
      (assoc :prefetch-parameters [{:target [:dimension [:field (:id pk-field) nil]]
                                    :type "id"
                                    :value [(get simple-parameters pk-field-name)]}]))))
(defn- execute-implicit-action
  [action request-parameters]
  (let [implicit-action (keyword (:kind action))
        {:keys [query row-parameters]} (build-implicit-query action implicit-action request-parameters)
        _ (api/check (or (= implicit-action :row/delete) (seq row-parameters))
                     400
                     (tru "Implicit parameters must be provided."))
        arg-map (cond-> query
                  (= implicit-action :row/create)
                  (assoc :create-row row-parameters)
                  (= implicit-action :row/update)
                  (assoc :update-row row-parameters))]
    (binding [qp.perms/*card-id* (:model_id action)]
      (actions/perform-action! implicit-action arg-map))))

Execute the given action with the given parameters of shape `{ }.

(defn execute-action!
  [action request-parameters]
  (let [;; if a value is supplied for a hidden parameter, it should raise an error
        field-settings         (get-in action [:visualization_settings :fields])
        hidden-param-ids       (->> (vals field-settings)
                                    (filter :hidden)
                                    (map :id))
        destination-param-ids  (set/difference (set (map :id (:parameters action))) (set hidden-param-ids))
        _ (check-no-extra-parameters request-parameters destination-param-ids)
        ;; add default values for missing parameters (including hidden ones)
        all-param-ids          (set (map :id (:parameters action)))
        provided-param-ids     (set (keys request-parameters))
        missing-param-ids      (set/difference all-param-ids provided-param-ids)
        missing-param-defaults (into {}
                                     (keep (fn [param-id]
                                             (when-let [default-value (get-in field-settings [param-id :defaultValue])]
                                               [param-id default-value])))
                                     missing-param-ids)
        request-parameters     (merge missing-param-defaults request-parameters)]
    (case (:type action)
      :implicit
      (execute-implicit-action action request-parameters)
      (:query :http)
      (execute-custom-action action request-parameters)
      (throw (ex-info (tru "Unknown action type {0}." (name (:type action))) action)))))

Execute the given action in the dashboard/dashcard context with the given parameters of shape `{ }.

(defn execute-dashcard!
  [dashboard-id dashcard-id request-parameters]
  (let [dashcard (api/check-404 (t2/select-one DashboardCard
                                               :id dashcard-id
                                               :dashboard_id dashboard-id))
        action (api/check-404 (action/select-action :id (:action_id dashcard)))]
    (snowplow/track-event! ::snowplow/action-executed api/*current-user-id* {:source    :dashboard
                                                                             :type      (:type action)
                                                                             :action_id (:id action)})
    (execute-action! action request-parameters)))
(defn- fetch-implicit-action-values
  [action request-parameters]
  (api/check (contains? #{"row/update" "row/delete"} (:kind action))
             400
             (tru "Values can only be fetched for actions that require a Primary Key."))
  (let [implicit-action (keyword (:kind action))
        {:keys [prefetch-parameters]} (build-implicit-query action implicit-action request-parameters)
        info {:executed-by api/*current-user-id*
              :context     :action
              :action-id   (:id action)}
        card (t2/select-one Card :id (:model_id action))
        ;; prefilling a form with day old data would be bad
        result (binding [persisted-info/*allow-persisted-substitution* false]
                 (qp/process-query-and-save-execution!
                  (qp.card/query-for-card card prefetch-parameters nil nil)
                  info))
        ;; only expose values for fields that are not hidden
        hidden-param-ids (keep #(when (:hidden %) (:id %))
                               (vals (get-in action [:visualization_settings :fields])))
        exposed-param-ids (-> (set (map :id (:parameters action)))
                              (set/difference (set hidden-param-ids)))]
    (m/filter-keys
      #(contains? exposed-param-ids %)
      (zipmap
        (map (comp u/slugify :name) (get-in result [:data :cols]))
        (first (get-in result [:data :rows]))))))

Fetch values to pre-fill implicit action execution - custom actions will return no values. Must pass in parameters of shape {<parameter-id> <value>} for primary keys.

(defn fetch-values
  [action request-parameters]
  (if (= :implicit (:type action))
    (fetch-implicit-action-values action request-parameters)
    {}))
 
(ns metabase.actions.http-action
  (:require
   [cheshire.core :as json]
   [clj-http.client :as http]
   [clojure.string :as str]
   [metabase.driver.common.parameters :as params]
   [metabase.driver.common.parameters.parse :as params.parse]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log])
  (:import
   (com.fasterxml.jackson.databind ObjectMapper)
   (net.thisptr.jackson.jq BuiltinFunctionLoader JsonQuery Output Scope Versions)))
(set! *warn-on-reflection* true)
(defonce ^:private root-scope
  (delay
    (let [scope (Scope/newEmptyScope)]
      (.loadFunctions (BuiltinFunctionLoader/getInstance) Versions/JQ_1_6 scope))))
(defonce ^:private object-mapper
  (delay (ObjectMapper.)))

Largely copied from sql drivers param substitute. May go away if parameters substitution is taken out of query-processing/db dependency

(declare substitute*)
(defn- substitute-param [param->value [sql missing] _in-optional? {:keys [k]}]
  (if-not (contains? param->value k)
    [sql (conj missing k)]
    (let [v (get param->value k)]
      (cond
        (= params/no-value v)
        [sql (conj missing k)]
        :else
        [(str sql v) missing]))))
(defn- substitute-optional [param->value [sql missing] {subclauses :args}]
  (let [[opt-sql opt-missing] (substitute* param->value subclauses true)]
    (if (seq opt-missing)
      [sql missing]
      [(str sql opt-sql) missing])))

Returns a sequence of [replaced-sql-string jdbc-args missing-parameters].

(defn- substitute*
  [param->value parsed in-optional?]
  (reduce
   (fn [[sql missing] x]
     (cond
       (string? x)
       [(str sql x) missing]
       (params/Param? x)
       (substitute-param param->value [sql missing] in-optional? x)
       (params/Optional? x)
       (substitute-optional param->value [sql missing] x)))
   nil
   parsed))

Substitute Optional and Param objects in a parsed-template, a sequence of parsed string fragments and tokens, with the values from the map param->value (using logic from substitution to decide what replacement SQL should be generated).

(substitute ["https://example.com/?filter=" (param "bird_type")] {"bird_type" "Steller's Jay"}) ;; -> "https://example.com/?filter=Steller's Jay"

(defn substitute
  [parsed-template param->value]
  (log/tracef "Substituting params\n%s\nin template\n%s" (u/pprint-to-str param->value) (u/pprint-to-str parsed-template))
  (let [[sql missing] (try
                        (substitute* param->value parsed-template false)
                        (catch Throwable e
                          (throw (ex-info (tru "Unable to substitute parameters: {0}" (ex-message e))
                                          {:type         (or (:type (ex-data e)) qp.error-type/qp)
                                           :params       param->value
                                           :parsed-query parsed-template}
                                          e))))]
    (log/tracef "=>%s" sql)
    (when (seq missing)
      (throw (ex-info (tru "Cannot call the service: missing required parameters: {0}" (set missing))
                      {:type    qp.error-type/missing-required-parameter
                       :missing missing})))
    (str/trim sql)))
(defn- parse-and-substitute [s params->value]
  (when s
    (-> s
        params.parse/parse
        (substitute params->value))))
(deftype ActionOutput [results]
  Output
  (emit [_ x]
    (vswap! results conj (str x))))

Executes a jq query on [[object]].

(defn apply-json-query
  [object jq-query]
  ;; TODO this is pretty ineficient. We parse with `:as :json`, then reencode within a response
  ;; I couldn't find a way to get JSONNode out of cheshire, so we fall back to jackson.
  ;; Should jackson be added explicitly to deps.edn?
  (let [json-node (.readTree ^ObjectMapper @object-mapper (json/generate-string object))
        vresults (volatile! [])
        output (ActionOutput. vresults)
        expr (JsonQuery/compile jq-query Versions/JQ_1_6)
        ;; might need to Scope childScope = Scope.newChildScope(rootScope); if root-scope can be modified by expression
        _ (.apply expr @root-scope json-node output)
        results @vresults]
    (if (<= (count results) 1)
      (first results)
      (throw (ex-info (tru "Too many results returned: {0}" (pr-str results)) {:jq-query jq-query :results results})))))

Calls an http endpoint based on action and params

(defn execute-http-action!
  [action params->value]
  (try
    (let [{:keys [method url body headers]} (:template action)
          request {:method (keyword method)
                   :url (parse-and-substitute url params->value)
                   :accept :json
                   :content-type :json
                   :throw-exceptions false
                   :headers (merge
                              ;; TODO maybe we want to default Agent here? Maybe Origin/Referer?
                              {"X-Metabase-Action" (:name action)}
                              (-> headers
                                  (parse-and-substitute params->value)
                                  (json/decode)))
                   :body (parse-and-substitute body params->value)}
          response (-> (http/request request)
                       (select-keys [:body :headers :status])
                       (update :body json/decode))
          error (json/parse-string (apply-json-query response (or (:error_handle action) ".status >= 400")))]
      (log/trace "Response before handle:" response)
      (if error
        {:status 400
         :headers {"Content-Type" "application/json"}
         :body (if (boolean? error)
                 {:remote-status (:status response)}
                 error)}
        (if-some [response (some->> action :response_handle (apply-json-query response))]
          {:status 200
           :headers {"Content-Type" "application/json"}
           :body response}
          {:status 204
           :body nil})))
    (catch Exception e
      (throw (ex-info (str "Problem building request: " (ex-message e))
                      {:template (:template action)}
                      e)))))
 

Namespace for collection metrics with Prometheus. Will set up a registry and a webserver on startup if [[prometheus-server-port]] is set to a port number. This can only be set in the environment (by starting with MB_PROMETHEUS_SERVER_PORT set to a numeric value and not through the web UI due to its sensitivity.

Api is quite simple: [[setup!]] and [[shutdown!]]. After that you can retrieve metrics from http://localhost:/metrics.

(ns metabase.analytics.prometheus
  (:refer-clojure :exclude [inc])
  (:require
   [clojure.java.jmx :as jmx]
   [iapetos.collector :as collector]
   [iapetos.collector.ring :as collector.ring]
   [iapetos.core :as prometheus]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.server :as server]
   [metabase.util.i18n :refer [deferred-trs trs]]
   [metabase.util.log :as log]
   [potemkin :as p]
   [potemkin.types :as p.types]
   [ring.adapter.jetty9 :as ring-jetty])
  (:import
   (io.prometheus.client Collector GaugeMetricFamily)
   (io.prometheus.client.hotspot GarbageCollectorExports MemoryPoolsExports StandardExports ThreadExports)
   (io.prometheus.client.jetty JettyStatisticsCollector)
   (java.util ArrayList List)
   (javax.management ObjectName)
   (org.eclipse.jetty.server Server)))
(set! *warn-on-reflection* true)

Infra: defsetting enables and [[system]] holds the system (webserver and registry)

(defsetting prometheus-server-port
  (deferred-trs (str "Port to serve prometheus metrics from. If set, prometheus collectors are registered"
                     " and served from `localhost:<port>/metrics`."))
  :type       :integer
  :visibility :internal
  ;; settable only through environmental variable
  :setter     :none
  :getter     (fn reading-prometheus-port-setting []
                (let [parse (fn [raw-value]
                              (if-let [parsed (parse-long raw-value)]
                                parsed
                                (log/warn (trs "MB_PROMETHEUS_SERVER_PORT value of ''{0}'' is not parseable as an integer."
                                               raw-value))))]
                  (setting/get-raw-value :prometheus-server-port integer? parse))))
(p.types/defprotocol+ PrometheusActions
  (stop-web-server [this]))
(p/defrecord+ PrometheusSystem [registry web-server]
  ;; prometheus just runs in the background collecting metrics and serving them from
  ;; localhost:<prometheus-server-port>/metrics. Nothing we need to do but shutdown.
  PrometheusActions
  (stop-web-server [_this]
    (when-let [^Server web-server web-server]
      (.stop web-server))))

Prometheus System for prometheus metrics

(defonce ^:private  ^PrometheusSystem system nil)
(declare setup-metrics! start-web-server!)

Takes a port (zero for a random port in test) and a registry name and returns a [[PrometheusSystem]] with a registry serving metrics from that port.

(defn- make-prometheus-system
  [port registry-name]
  (try
    (let [registry   (setup-metrics! registry-name)
          web-server (start-web-server! port registry)]
      (->PrometheusSystem registry web-server))
    (catch Exception e
      (throw (ex-info (trs "Failed to initialize Prometheus on port {0}" port)
                      {:port port}
                      e)))))

Collectors

Takes raw-stats from [[connection-pool-info]] and groups by each property type rather than each database. {"metabase-postgres-app-db" {:numConnections 15, :numIdleConnections 15, :numBusyConnections 0, :minPoolSize 1, :maxPoolSize 15}, "db-2-postgres-clean" {:numConnections 2, :numIdleConnections 2, :numBusyConnections 0, :minPoolSize 1, :maxPoolSize 15}} Becomes {:numConnections [{:name :numConnections, :value 15.0, ;; values are all doubles :timestamp 1662563931039, :label "metabase-postgres-app-db"} {:name :numConnections, :value 2.0, :timestamp 1662563931039, :label "db-2-postgres-clean"}] ...}

(defn c3p0-stats
  [raw-stats]
  (let [now    (.toEpochMilli (java.time.Instant/now))
        sample (fn sample [[db-label k v]]
                 {:name      k
                  :value     (double v)
                  :timestamp now
                  :label     db-label})]
    (->> raw-stats
         (mapcat (fn [[db-label values]]
                   (map (fn [[k v]] [db-label k v]) values)))
         (map sample)
         (group-by :name))))
(def ^:private label-translation
  {:maxPoolSize        {:label       "c3p0_max_pool_size"
                        :description (deferred-trs "C3P0 Max pool size")}
   :minPoolSize        {:label       "c3p0_min_pool_size"
                        :description (deferred-trs "C3P0 Minimum pool size")}
   :numConnections     {:label       "c3p0_num_connections"
                        :description (deferred-trs "C3P0 Number of connections")}
   :numIdleConnections {:label       "c3p0_num_idle_connections"
                        :description (deferred-trs "C3P0 Number of idle connections")}
   :numBusyConnections {:label       "c3p0_num_busy_connections"
                        :description (deferred-trs "C3P0 Number of busy connections")}
   :numThreadsAwaitingCheckoutDefaultUser
                       {:label       "c3p0_num_threads_awaiting_checkout_default_user"
                        :description (deferred-trs "C3P0 Number of threads awaiting checkout")}})

Create an ArrayList of GaugeMetricFamily objects containing measurements from the c3p0 stats. Stats are grouped by the property and the database information is attached as a label to multiple measurements of :numConnections.

(defn- stats->prometheus
  [stats]
  (let [arr (ArrayList. (count stats))]
    (doseq [[raw-label measurements] stats]
      (if-let [{gauge-label :label desc :description} (label-translation raw-label)]
        (let [gauge (GaugeMetricFamily.
                     ^String gauge-label
                     ^String (str desc) ;; site-localized becomes string
                     (List/of "database"))]
          (doseq [m measurements]
            (.addMetric gauge (List/of (:label m)) (:value m)))
          (.add arr gauge))
        (log/warn (trs "Unrecognized measurement {0} in prometheus stats"
                       raw-label))))
    arr))
(defn- conn-pool-bean-diag-info [acc ^ObjectName jmx-bean]
  (let [bean-id   (.getCanonicalName jmx-bean)
        props     [:numConnections :numIdleConnections :numBusyConnections
                   :minPoolSize :maxPoolSize :numThreadsAwaitingCheckoutDefaultUser]]
    (assoc acc (jmx/read bean-id :dataSourceName) (jmx/read bean-id props))))

Builds a map of info about the current c3p0 connection pools managed by this Metabase instance.

(defn connection-pool-info
  []
  (reduce conn-pool-bean-diag-info {} (jmx/mbean-names "com.mchange.v2.c3p0:type=PooledDataSource,*")))

c3p0 collector delay

(def c3p0-collector
  (letfn [(collect-metrics []
            (-> (connection-pool-info)
                c3p0-stats
                stats->prometheus))]
    (delay
      (collector/named
       {:name "c3p0-stats"
        :namespace "metabase_database"}
       (proxy [Collector] []
         (collect
           ([] (collect-metrics))
           ([_sampleNameFilter] (collect-metrics))))))))

JVM collectors. Essentially duplicating [[iapetos.collector.jvm]] namespace so we can set our own namespaces rather than "iapetos_internal"

(defn- jvm-collectors
  []
  [(collector/named {:namespace "metabase_application"
                     :name      "jvm_gc"}
                    (GarbageCollectorExports.))
   (collector/named {:namespace "metabase_application"
                     :name      "jvm_standard"}
                    (StandardExports.))
   (collector/named {:namespace "metabase_application"
                     :name      "jvm_memory_pools"}
                    (MemoryPoolsExports.))
   (collector/named {:namespace "metabase_application"
                     :name      "jvm_threads"}
                    (ThreadExports.))])
(defn- jetty-collectors
  []
  ;; when in dev you might not have a server setup
  (when (server/instance)
    [(collector/named {:namespace "metabase_webserver"
                       :name      "jetty_stats"}
                      (JettyStatisticsCollector. (.getHandler (server/instance))))]))

Instrument the application. Conditionally done when some setting is set. If [[prometheus-server-port]] is not set it will throw.

(defn- setup-metrics!
  [registry-name]
  (log/info (trs "Starting prometheus metrics collector"))
  (let [registry (prometheus/collector-registry registry-name)]
    (apply prometheus/register registry
           (concat (jvm-collectors)
                   (jetty-collectors)
                   [@c3p0-collector]
                   ; Iapetos will use "default" if we do not provide a namespace, so explicitly set `metabase-email`:
                   [(prometheus/counter :metabase-email/messages
                                        {:description (trs "Number of emails sent.")})
                    (prometheus/counter :metabase-email/message-errors
                                        {:description (trs "Number of errors when sending emails.")})]))))

Start the prometheus web-server. If [[prometheus-server-port]] is not set it will throw.

(defn- start-web-server!
  [port registry]
  (log/info (trs "Starting prometheus metrics web-server on port {0}" (str port)))
  (when-not port
    (throw (ex-info (trs "Attempting to set up prometheus metrics web-server with no web-server port provided")
                    {})))
  (ring-jetty/run-jetty (-> (constantly {:status 200})
                            (collector.ring/wrap-metrics registry {:path "/metrics"}))
                        {:join?       false
                         :port        port
                         :max-threads 8}))

API: call [[setup!]] once, call [[shutdown!]] on shutdown

Start the prometheus metric collector and web-server.

(defn setup!
  []
  (let [port (prometheus-server-port)]
    (when-not port
      (throw (ex-info (trs "Attempting to set up prometheus metrics with no web-server port provided")
                      {})))
    (when-not system
      (locking #'system
        (when-not system
          (let [sys (make-prometheus-system port "metabase-registry")]
            (alter-var-root #'system (constantly sys))))))))

Stop the prometheus metrics web-server if it is running.

(defn shutdown!
  []
  (when system
    (locking #'system
      (when system
        (try (stop-web-server system)
             (prometheus/clear (.-registry system))
             (alter-var-root #'system (constantly nil))
             (log/info (trs "Prometheus web-server shut down"))
             (catch Exception e
               (log/warn e (trs "Error stopping prometheus web-server"))))))))

Call iapetos.core/inc on the metric in the global registry, if it has already been initialized and the metric is registered.

(defn inc
  [metric]
  (some-> system .-registry metric prometheus/inc))
(comment
  (require 'iapetos.export)
  (spit "metrics" (iapetos.export/text-format (.registry system))))
 

Functions for sending Snowplow analytics events

(ns metabase.analytics.snowplow
  (:require
   [clojure.string :as str]
   [java-time.api :as t]
   [medley.core :as m]
   [metabase.config :as config]
   [metabase.models.setting :as setting :refer [defsetting Setting]]
   [metabase.models.user :refer [User]]
   [metabase.public-settings :as public-settings]
   [metabase.util.date-2 :as u.date]
   [metabase.util.i18n :refer [deferred-tru trs]]
   [metabase.util.log :as log]
   [toucan2.core :as t2])
  (:import
   (com.snowplowanalytics.snowplow.tracker Snowplow Subject Tracker)
   (com.snowplowanalytics.snowplow.tracker.configuration EmitterConfiguration NetworkConfiguration SubjectConfiguration TrackerConfiguration)
   (com.snowplowanalytics.snowplow.tracker.events SelfDescribing SelfDescribing$Builder2)
   (com.snowplowanalytics.snowplow.tracker.http ApacheHttpClientAdapter)
   (com.snowplowanalytics.snowplow.tracker.payload SelfDescribingJson)
   (org.apache.http.client.config CookieSpecs RequestConfig)
   (org.apache.http.impl.client HttpClients)
   (org.apache.http.impl.conn PoolingHttpClientConnectionManager)))
(set! *warn-on-reflection* true)

Adding or updating a Snowplow schema? Make sure that the two maps below are updated accordingly.

The most recent version for each event schema. This should be updated whenever a new version of a schema is added to SnowcatCloud, at the same time that the data sent to the collector is updated.

(def ^:private schema->version
  {::account      "1-0-1"
   ::invite       "1-0-1"
   ::csvupload    "1-0-0"
   ::dashboard    "1-1-3"
   ::database     "1-0-1"
   ::instance     "1-1-2"
   ::metabot      "1-0-1"
   ::search       "1-0-1"
   ::model        "1-0-0"
   ::timeline     "1-0-0"
   ::task         "1-0-0"
   ::action       "1-0-0"
   ::embed_share  "1-0-0"})

The schema to use for each analytics event.

(def ^:private event->schema
  {::new-instance-created           ::account
   ::new-user-created               ::account
   ::invite-sent                    ::invite
   ::index-model-entities-enabled   ::model
   ::dashboard-created              ::dashboard
   ::question-added-to-dashboard    ::dashboard
   ::dashboard-tab-created          ::dashboard
   ::dashboard-tab-deleted          ::dashboard
   ::database-connection-successful ::database
   ::database-connection-failed     ::database
   ::new-event-created              ::timeline
   ::new-task-history               ::task
   ::new-search-query               ::search
   ::search-results-filtered        ::search
   ::action-created                 ::action
   ::action-updated                 ::action
   ::action-deleted                 ::action
   ::action-executed                ::action
   ::csv-upload-successful          ::csvupload
   ::csv-upload-failed              ::csvupload
   ::metabot-feedback-received      ::metabot
   ::embedding-enabled              ::embed_share
   ::embedding-disabled             ::embed_share})
(defsetting analytics-uuid
  (deferred-tru
    (str "Unique identifier to be used in Snowplow analytics, to identify this instance of Metabase. "
         "This is a public setting since some analytics events are sent prior to initial setup."))
  :visibility :public
  :setter     :none
  :type       ::public-settings/uuid-nonce
  :doc        false)
(defsetting snowplow-available
  (deferred-tru
   (str "Boolean indicating whether a Snowplow collector is available to receive analytics events. "
        "Should be set via environment variable in Cypress tests or during local development."))
  :type       :boolean
  :visibility :public
  :default    config/is-prod?
  :doc        false
  :audit      :never)
(defsetting snowplow-enabled
  (deferred-tru
   (str "Boolean indicating whether analytics events are being sent to Snowplow. "
        "True if anonymous tracking is enabled for this instance, and a Snowplow collector is available."))
  :type       :boolean
  :setter     :none
  :getter     (fn [] (and (snowplow-available)
                          (public-settings/anon-tracking-enabled)))
  :visibility :public
  :doc        false)
(defsetting snowplow-url
  (deferred-tru "The URL of the Snowplow collector to send analytics events to.")
  :default    (if config/is-prod?
                "https://sp.metabase.com"
                ;; See the iglu-schema-registry repo for instructions on how to run Snowplow Micro locally for development
                "http://localhost:9090")
  :visibility :public
  :audit      :never
  :doc        false)

Returns the earliest user creation timestamp in the database

(defn- first-user-creation
  []
  (:min (t2/select-one [User [:%min.date_joined :min]])))

We need to declare track-event! up front so that we can use it in the custom getter of instance-creation. We can't move instance-creation below track-event! because it has to be defined before context, which is called by track-event!.

(declare track-event!)
(defsetting instance-creation
  (deferred-tru "The approximate timestamp at which this instance of Metabase was created, for inclusion in analytics.")
  :visibility :public
  :setter     :none
  :getter     (fn []
                (when-not (t2/exists? Setting :key "instance-creation")
                  ;; For instances that were started before this setting was added (in 0.41.3), use the creation
                  ;; timestamp of the first user. For all new instances, use the timestamp at which this setting
                  ;; is first read.
                  (let [value (or (first-user-creation) (t/offset-date-time))]
                    (setting/set-value-of-type! :timestamp :instance-creation value)
                    (track-event! ::new-instance-created)))
                (u.date/format-rfc3339 (setting/get-value-of-type :timestamp :instance-creation)))
  :doc false)

Returns instance of a Snowplow tracker config

(def ^:private tracker-config
  (let [tracker-config* (delay (TrackerConfiguration. "sp" "metabase"))]
    (fn [] @tracker-config*)))

Returns instance of a Snowplow network config

(def ^:private network-config
  (let [network-config* (delay
                         (let [request-config (-> (RequestConfig/custom)
                                                  ;; Set cookie spec to `STANDARD` to avoid warnings about an invalid cookie
                                                  ;; header in request response (PR #24579)
                                                  (.setCookieSpec CookieSpecs/STANDARD)
                                                  (.build))
                               client (-> (HttpClients/custom)
                                          (.setConnectionManager (PoolingHttpClientConnectionManager.))
                                          (.setDefaultRequestConfig request-config)
                                          (.build))
                               http-client-adapter (ApacheHttpClientAdapter. (snowplow-url) client)]
                           (NetworkConfiguration. http-client-adapter)))]
    (fn [] @network-config*)))

Returns an instance of a Snowplow emitter config

(def ^:private emitter-config
  (let [emitter-config* (delay (-> (EmitterConfiguration.)
                                   (.batchSize 1)))]
     (fn [] @emitter-config*)))

Returns instance of a Snowplow tracker

(def ^:private tracker
  (let [tracker* (delay
                  (Snowplow/createTracker
                   ^TrackerConfiguration (tracker-config)
                   ^NetworkConfiguration (network-config)
                   ^EmitterConfiguration (emitter-config)))]
    (fn [] @tracker*)))

Create a Subject object for a given user ID, to be included in analytics events

(defn- subject
  [user-id]
  (Subject.
   (-> (SubjectConfiguration.)
       (.userId (str user-id))
       ;; Override with localhost IP to avoid logging actual user IP addresses
       (.ipAddress "127.0.0.1"))))

Returns the type of the Metabase application database as a string (e.g. PostgreSQL, MySQL)

(defn- app-db-type
  []
  (t2/with-connection [^java.sql.Connection conn]
    (.. conn getMetaData getDatabaseProductName)))

Returns the version of the Metabase application database as a string

(defn- app-db-version
  []
  (t2/with-connection [^java.sql.Connection conn]
    (let [metadata (.getMetaData conn)]
      (format "%d.%d" (.getDatabaseMajorVersion metadata) (.getDatabaseMinorVersion metadata)))))

Common context included in every analytics event

(defn- context
  []
  (new SelfDescribingJson
       (str "iglu:com.metabase/instance/jsonschema/" (schema->version ::instance))
       {"id"                           (analytics-uuid)
        "version"                      {"tag" (:tag (public-settings/version))}
        "token_features"               (m/map-keys name (public-settings/token-features))
        "created_at"                   (instance-creation)
        "application_database"         (app-db-type)
        "application_database_version" (app-db-version)}))
(defn- normalize-kw
  [kw]
  (-> kw name (str/replace #"-" "_")))

A SelfDescribingJson object containing the provided event data, which can be included as the payload for an analytics event

(defn- payload
  [schema version event-kw data]
  (new SelfDescribingJson
       (format "iglu:com.metabase/%s/jsonschema/%s" (normalize-kw schema) version)
       ;; Make sure keywords in payload are converted to strings in snake-case
       (m/map-kv
        (fn [k v] [(normalize-kw k) (if (keyword? v) (normalize-kw v) v)])
        (assoc data :event event-kw))))

Wrapper function around the .track method on a Snowplow tracker. Can be redefined in tests to instead append event data to an in-memory store.

(defn- track-event-impl!
  [tracker event]
  (.track ^Tracker tracker ^SelfDescribing event))

Send a single analytics event to the Snowplow collector, if tracking is enabled for this MB instance and a collector is available.

(defn track-event!
  [event-kw & [user-id data]]
  (when (snowplow-enabled)
    (try
      (let [schema (event->schema event-kw)
            ^SelfDescribing$Builder2 builder (-> (. SelfDescribing builder)
                                                 (.eventData (payload schema (schema->version schema) event-kw data))
                                                 (.customContext [(context)])
                                                 (cond-> user-id (.subject (subject user-id))))
            ^SelfDescribing event (.build builder)]
        (track-event-impl! (tracker) event))
      (catch Throwable e
        (log/error e (trs "Error sending Snowplow analytics event {0}" event-kw))))))
 

Functions which summarize the usage of an instance

(ns metabase.analytics.stats
  (:require
   [cheshire.core :as json]
   [clj-http.client :as http]
   [clojure.string :as str]
   [java-time.api :as t]
   [medley.core :as m]
   [metabase.analytics.snowplow :as snowplow]
   [metabase.config :as config]
   [metabase.db.query :as mdb.query]
   [metabase.db.util :as mdb.u]
   [metabase.driver :as driver]
   [metabase.email :as email]
   [metabase.embed.settings :as embed.settings]
   [metabase.integrations.google :as google]
   [metabase.integrations.slack :as slack]
   [metabase.models
    :refer [Card
            Collection
            Dashboard
            DashboardCard
            Database
            Field
            Metric
            PermissionsGroup
            Pulse
            PulseCard
            PulseChannel
            QueryCache
            Segment
            Table
            User]]
   [metabase.models.humanization :as humanization]
   [metabase.public-settings :as public-settings]
   [metabase.util :as u]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

Merge sequence of maps ms by summing counts inside them. Non-integer values are allowed; truthy values are considered to add a count of 1, while non-truthy values do not affect the result count.

(defn- merge-count-maps
  [ms]
  (reduce (partial merge-with +)
          {}
          (for [m ms]
            (m/map-vals #(cond
                           (number? %) %
                           %           1
                           :else       0)
                        m))))
(def ^:private ^String metabase-usage-url "https://xuq0fbkk0j.execute-api.us-east-1.amazonaws.com/prod")

Return small bin number. Assumes positive inputs.

(defn- bin-small-number
  [x]
  (cond
    (= 0 x)      "0"
    (<= 1 x 5)   "1-5"
    (<= 6 x 10)  "6-10"
    (<= 11 x 25) "11-25"
    (> x 25)     "25+"))

Return medium bin number. Assumes positive inputs.

(defn- bin-medium-number
  [x]
  (cond
    (= 0 x)        "0"
    (<= 1 x 5)     "1-5"
    (<= 6 x 10)    "6-10"
    (<= 11 x 25)   "11-25"
    (<= 26 x 50)   "26-50"
    (<= 51 x 100)  "51-100"
    (<= 101 x 250) "101-250"
    (> x 250)      "250+"))

Return large bin number. Assumes positive inputs.

(defn- bin-large-number
  [x]
  (cond
    (= 0 x)           "0"
    (< x 1)           "< 1"
    (<= 1 x 10)       "1-10"
    (<= 11 x 50)      "11-50"
    (<= 51 x 250)     "51-250"
    (<= 251 x 1000)   "251-1000"
    (<= 1001 x 10000) "1001-10000"
    (> x 10000)       "10000+"))

Go through a bunch of maps and count the frequency a given key's values.

(defn- value-frequencies
  [many-maps k]
  (frequencies (map k many-maps)))

Bin some frequencies using a passed in binning-fn.

;; Generate histogram for values of :a; 1 appears 3 times and 2 and 3 both appear once (histogram bin-micro-number [{:a 1} {:a 1} {:a 1} {:a 2} {:a 3}] :a) ;; -> {"3+" 1, "1" 2}

;; (or if you already have the counts) (histogram bin-micro-number [3 1 1]) ;; -> {"3+" 1, "1" 2}

(defn- histogram
  ([binning-fn counts]
   (frequencies (map binning-fn counts)))
  ([binning-fn many-maps k]
   (histogram binning-fn (vals (value-frequencies many-maps k)))))

Return a histogram for medium numbers.

(def ^:private medium-histogram
  (partial histogram bin-medium-number))

Figure out what we're running under

(defn environment-type
  []
  (cond
    (config/config-str :rds-hostname)        :elastic-beanstalk
    (config/config-str :database-url)        :heroku ;; Putting this last as 'database-url' seems least specific
    :else                                    :unknown))

Figure out global info about this instance

(defn- instance-settings
  []
  {:version                  (config/mb-version-info :tag)
   :running_on               (environment-type)
   :startup_time_millis      (public-settings/startup-time-millis)
   :application_database     (config/config-str :mb-db-type)
   :check_for_updates        (public-settings/check-for-updates)
   :site_name                (not= (public-settings/site-name) "Metabase")
   :report_timezone          (driver/report-timezone)
   ; We deprecated advanced humanization but have this here anyways
   :friendly_names           (= (humanization/humanization-strategy) "advanced")
   :email_configured         (email/email-configured?)
   :slack_configured         (slack/slack-configured?)
   :sso_configured           (google/google-auth-enabled)
   :instance_started         (snowplow/instance-creation)
   :has_sample_data          (t2/exists? Database, :is_sample true)
   :help_link                (public-settings/help-link)
   :enable_embedding         (embed.settings/enable-embedding)
   :embedding_app_origin_set (boolean (embed.settings/embedding-app-origin))})

Get metrics based on user records. TODO: get activity in terms of created questions, pulses and dashboards

(defn- user-metrics
  []
  {:users (merge-count-maps (for [user (t2/select [User :is_active :is_superuser :last_login :sso_source]
                                                  :type :personal)]
                              {:total     1
                               :active    (:is_active    user)
                               :admin     (:is_superuser user)
                               :logged_in (:last_login   user)
                               :sso       (= :google (:sso_source user))}))})

Get metrics based on groups: TODO characterize by # w/ sql access, # of users, no self-serve data access

(defn- group-metrics
  []
  {:groups (t2/count PermissionsGroup)})
(defn- card-has-params? [card]
  (boolean (get-in card [:dataset_query :native :template-tags])))

Get metrics based on questions TODO characterize by # executions and avg latency

(defn- question-metrics
  []
  (let [cards (t2/select [Card :query_type :public_uuid :enable_embedding :embedding_params :dataset_query])]
    {:questions (merge-count-maps (for [card cards]
                                    (let [native? (= (keyword (:query_type card)) :native)]
                                      {:total       1
                                       :native      native?
                                       :gui         (not native?)
                                       :with_params (card-has-params? card)})))
     :public    (merge-count-maps (for [card  cards
                                        :when (:public_uuid card)]
                                    {:total       1
                                     :with_params (card-has-params? card)}))
     :embedded  (merge-count-maps (for [card  cards
                                        :when (:enable_embedding card)]
                                    (let [embedding-params-vals (set (vals (:embedding_params card)))]
                                      {:total                1
                                       :with_params          (card-has-params? card)
                                       :with_enabled_params  (contains? embedding-params-vals "enabled")
                                       :with_locked_params   (contains? embedding-params-vals "locked")
                                       :with_disabled_params (contains? embedding-params-vals "disabled")})))}))

Get metrics based on dashboards TODO characterize by # of revisions, and created by an admin

(defn- dashboard-metrics
  []
  (let [dashboards (t2/select [Dashboard :creator_id :public_uuid :parameters :enable_embedding :embedding_params])
        dashcards  (t2/select [DashboardCard :card_id :dashboard_id])]
    {:dashboards         (count dashboards)
     :with_params        (count (filter (comp seq :parameters) dashboards))
     :num_dashs_per_user (medium-histogram dashboards :creator_id)
     :num_cards_per_dash (medium-histogram dashcards :dashboard_id)
     :num_dashs_per_card (medium-histogram dashcards :card_id)
     :public             (merge-count-maps (for [dash  dashboards
                                                 :when (:public_uuid dash)]
                                             {:total       1
                                              :with_params (seq (:parameters dash))}))
     :embedded           (merge-count-maps (for [dash  dashboards
                                                 :when (:enable_embedding dash)]
                                             (let [embedding-params-vals (set (vals (:embedding_params dash)))]
                                               {:total                1
                                                :with_params          (seq (:parameters dash))
                                                :with_enabled_params  (contains? embedding-params-vals "enabled")
                                                :with_locked_params   (contains? embedding-params-vals "locked")
                                                :with_disabled_params (contains? embedding-params-vals "disabled")})))}))

Fetch the frequencies of a given column with a normal SQL SELECT COUNT(*) ... GROUP BY query. This is way more efficient than fetching every single row and counting them in Clojure-land!

(db-frequencies Database :engine) ;; -> {"h2" 2, "postgres" 1, ...}

;; include WHERE conditions or other arbitrary HoneySQL (db-frequencies Database :engine {:where [:= :is_sample false]}) ;; -> {"h2" 1, "postgres" 1, ...}

;; Generate a histogram: (micro-histogram (vals (db-frequencies Database :engine))) ;; -> {"2" 1, "1" 1, ...}

;; Include WHERE clause that includes conditions for a Table related by an FK relationship: ;; (Number of Tables per DB engine) (db-frequencies Table (mdb.u/qualify Database :engine) {:left-join [Database [:= (mdb.u/qualify Database :id) (mdb.u/qualify Table :db_id)]]}) ;; -> {"googleanalytics" 4, "postgres" 48, "h2" 9}

(defn- db-frequencies
  {:style/indent 2}
  [model column & [additonal-honeysql]]
  (into {} (for [{:keys [k count]} (t2/select [model [column :k] [:%count.* :count]]
                                     (merge {:group-by [column]}
                                            additonal-honeysql))]
             [k count])))

Return the number of Notifications that satisfy where-conditions that have at least one PulseCard with include_xls or include_csv.

;; Pulses only (filter out Alerts) (num-notifications-with-xls-or-csv-cards [:= :alert_condition nil])

(defn- num-notifications-with-xls-or-csv-cards
  [& where-conditions]
  (-> (mdb.query/query {:select    [[[::h2x/distinct-count :pulse.id] :count]]
                        :from      [:pulse]
                        :left-join [:pulse_card [:= :pulse.id :pulse_card.pulse_id]]
                        :where     (into
                                    [:and
                                     [:or
                                      [:= :pulse_card.include_csv true]
                                      [:= :pulse_card.include_xls true]]]
                                    where-conditions)})
      first
      :count))

Get metrics based on pulses TODO: characterize by non-user account emails, # emails

(defn- pulse-metrics
  []
  (let [pulse-conditions {:left-join [:pulse [:= :pulse.id :pulse_id]], :where [:= :pulse.alert_condition nil]}]
    {:pulses               (t2/count Pulse :alert_condition nil)
     ;; "Table Cards" are Cards that include a Table you can download
     :with_table_cards     (num-notifications-with-xls-or-csv-cards [:= :alert_condition nil])
     :pulse_types          (db-frequencies PulseChannel :channel_type  pulse-conditions)
     :pulse_schedules      (db-frequencies PulseChannel :schedule_type pulse-conditions)
     :num_pulses_per_user  (medium-histogram (vals (db-frequencies Pulse     :creator_id (dissoc pulse-conditions :left-join))))
     :num_pulses_per_card  (medium-histogram (vals (db-frequencies PulseCard :card_id    pulse-conditions)))
     :num_cards_per_pulses (medium-histogram (vals (db-frequencies PulseCard :pulse_id   pulse-conditions)))}))
(defn- alert-metrics []
  (let [alert-conditions {:left-join [:pulse [:= :pulse.id :pulse_id]], :where [:not= (mdb.u/qualify Pulse :alert_condition) nil]}]
    {:alerts               (t2/count Pulse :alert_condition [:not= nil])
     :with_table_cards     (num-notifications-with-xls-or-csv-cards [:not= :alert_condition nil])
     :first_time_only      (t2/count Pulse :alert_condition [:not= nil], :alert_first_only true)
     :above_goal           (t2/count Pulse :alert_condition [:not= nil], :alert_above_goal true)
     :alert_types          (db-frequencies PulseChannel :channel_type alert-conditions)
     :num_alerts_per_user  (medium-histogram (vals (db-frequencies Pulse     :creator_id (dissoc alert-conditions :left-join))))
     :num_alerts_per_card  (medium-histogram (vals (db-frequencies PulseCard :card_id    alert-conditions)))
     :num_cards_per_alerts (medium-histogram (vals (db-frequencies PulseCard :pulse_id   alert-conditions)))}))

Get metrics on Collection usage.

(defn- collection-metrics
  []
  (let [collections (t2/select Collection)
        cards       (t2/select [Card :collection_id])]
    {:collections              (count collections)
     :cards_in_collections     (count (filter :collection_id cards))
     :cards_not_in_collections (count (remove :collection_id cards))
     :num_cards_per_collection (medium-histogram cards :collection_id)}))

Get metrics based on Databases.

Metadata Metrics

(defn- database-metrics
  []
  (let [databases (t2/select [Database :is_full_sync :engine :dbms_version])]
    {:databases (merge-count-maps (for [{is-full-sync? :is_full_sync} databases]
                                    {:total    1
                                     :analyzed is-full-sync?}))
     :dbms_versions (frequencies (map (fn [db]
                                        (-> db
                                            :dbms_version
                                            (assoc :engine (:engine db))
                                            json/generate-string))
                                      databases))}))

Get metrics based on Tables.

(defn- table-metrics
  []
  (let [tables (t2/select [Table :db_id :schema])]
    {:tables           (count tables)
     :num_per_database (medium-histogram tables :db_id)
     :num_per_schema   (medium-histogram tables :schema)}))

Get metrics based on Fields.

(defn- field-metrics
  []
  (let [fields (t2/select [Field :table_id])]
    {:fields        (count fields)
     :num_per_table (medium-histogram fields :table_id)}))

Get metrics based on Segments.

(defn- segment-metrics
  []
  {:segments (t2/count Segment)})

Get metrics based on Metrics.

(defn- metric-metrics
  []
  {:metrics (t2/count Metric)})

Execution Metrics

Summarize executions, by incrementing approriate counts in a summary map.

(defn summarize-executions
  ([]
   (summarize-executions (t2/reducible-select [:model/QueryExecution :executor_id :running_time :error])))
  ([executions]
   (reduce summarize-executions {:executions 0, :by_status {}, :num_per_user {}, :num_by_latency {}} executions))
  ([summary execution]
   (-> summary
       (update :executions u/safe-inc)
       (update-in [:by_status (if (:error execution)
                                "failed"
                                "completed")] u/safe-inc)
       (update-in [:num_per_user (:executor_id execution)] u/safe-inc)
       (update-in [:num_by_latency (bin-large-number (/ (:running_time execution) 1000))] u/safe-inc))))

Convert a map of user-id->num-executions to the histogram output format we expect.

(defn- summarize-executions-per-user
  [user-id->num-executions]
  (frequencies (map bin-large-number (vals user-id->num-executions))))

Get metrics based on QueryExecutions.

(defn- execution-metrics
  []
  (-> (summarize-executions)
      (update :num_per_user summarize-executions-per-user)))

Cache Metrics

Metrics based on use of the QueryCache.

(defn- cache-metrics
  []
  (let [{:keys [length count]} (t2/select-one [QueryCache [[:avg [:length :results]] :length] [:%count.* :count]])]
    {:average_entry_size (int (or length 0))
     :num_queries_cached (bin-small-number count)}))

System Metrics

(defn- bytes->megabytes [b]
  (Math/round (double (/ b 1024 1024))))
(def ^:private system-property-names
  ["java.version" "java.vm.specification.version"  "java.runtime.name"
   "user.timezone" "user.language" "user.country" "file.encoding"
   "os.name" "os.version"])

Metadata about the environment Metabase is running in

(defn- system-metrics
  []
  (let [runtime (Runtime/getRuntime)]
    (merge
     {:max_memory (bytes->megabytes (.maxMemory runtime))
      :processors (.availableProcessors runtime)}
     (zipmap (map #(keyword (str/replace % \. \_)) system-property-names)
             (map #(System/getProperty %) system-property-names)))))

Combined Stats & Logic for sending them in

generate a map of the usage stats for this instance

(defn anonymous-usage-stats
  []
  (merge (instance-settings)
         {:uuid      (public-settings/site-uuid)
          :timestamp (t/offset-date-time)
          :stats     {:cache      (cache-metrics)
                      :collection (collection-metrics)
                      :dashboard  (dashboard-metrics)
                      :database   (database-metrics)
                      :execution  (execution-metrics)
                      :field      (field-metrics)
                      :group      (group-metrics)
                      :metric     (metric-metrics)
                      :pulse      (pulse-metrics)
                      :alert      (alert-metrics)
                      :question   (question-metrics)
                      :segment    (segment-metrics)
                      :system     (system-metrics)
                      :table      (table-metrics)
                      :user       (user-metrics)}}))

send stats to Metabase tracking server

(defn- send-stats!
  [stats]
  (try
     (http/post metabase-usage-url {:form-params stats, :content-type :json, :throw-entire-message? true})
     (catch Throwable e
       (log/error e (trs "Sending usage stats FAILED")))))

Collect usage stats and phone them home

(defn phone-home-stats!
  []
  (when (public-settings/anon-tracking-enabled)
    (send-stats! (anonymous-usage-stats))))
 

/api/action/ endpoints.

(ns metabase.api.action
  (:require
   [cheshire.core :as json]
   [compojure.core :as compojure :refer [POST]]
   [metabase.actions :as actions]
   [metabase.actions.execution :as actions.execution]
   [metabase.actions.http-action :as http-action]
   [metabase.analytics.snowplow :as snowplow]
   [metabase.api.common :as api]
   [metabase.api.common.validation :as validation]
   [metabase.models :refer [Action Card Database]]
   [metabase.models.action :as action]
   [metabase.models.card :as card]
   [metabase.models.collection :as collection]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru tru]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)
(def ^:private json-query-schema
  [:and
   string?
   (mu/with-api-error-message
     [:fn #(http-action/apply-json-query {} %)]
     (deferred-tru "must be a valid json-query, something like ''.item.title''"))])
(def ^:private supported-action-type
  (mu/with-api-error-message
    [:enum "http" "query" "implicit"]
    (deferred-tru "Unsupported action type")))
(def ^:private implicit-action-kind
  (mu/with-api-error-message
    (into [:enum]
          (for [ns ["row" "bulk"]
                action ["create" "update" "delete"]]
            (str ns "/" action)))
    (deferred-tru "Unsupported implicit action kind")))
(def ^:private http-action-template
  [:map {:closed true}
   [:method                              [:enum "GET" "POST" "PUT" "DELETE" "PATCH"]]
   [:url                                 [string? {:min 1}]]
   [:body               {:optional true} [:maybe string?]]
   [:headers            {:optional true} [:maybe string?]]
   [:parameters         {:optional true} [:maybe [:sequential map?]]]
   [:parameter_mappings {:optional true} [:maybe map?]]])

/

(api/defendpoint GET 
  "Returns actions that can be used for QueryActions. By default lists all viewable actions. Pass optional
  `?model-id=<model-id>` to limit to actions on a particular model."
  [model-id]
  {model-id [:maybe ms/PositiveInt]}
  (letfn [(actions-for [models]
            (if (seq models)
              (t2/hydrate (action/select-actions models
                                              :model_id [:in (map :id models)]
                                              :archived false)
                       :creator)
              []))]
    ;; We don't check the permissions on the actions, we assume they are readable if the model is readable.
    (let [models (if model-id
                   [(api/read-check Card model-id)]
                   (t2/select Card {:where
                                    [:and
                                     [:= :dataset true]
                                     [:= :archived false]
                                     ;; action permission keyed off of model permission
                                     (collection/visible-collection-ids->honeysql-filter-clause
                                      :collection_id
                                      (collection/permissions-set->visible-collection-ids
                                       @api/*current-user-permissions-set*))]}))]
      (actions-for models))))

/public

(api/defendpoint GET 
  "Fetch a list of Actions with public UUIDs. These actions are publicly-accessible *if* public sharing is enabled."
  []
  (validation/check-has-application-permission :setting)
  (validation/check-public-sharing-enabled)
  (t2/select [Action :name :id :public_uuid :model_id], :public_uuid [:not= nil], :archived false))

/:action-id

(api/defendpoint GET 
  [action-id]
  {action-id ms/PositiveInt}
  (-> (action/select-action :id action-id :archived false)
      (t2/hydrate :creator)
      api/read-check))

/:action-id

(api/defendpoint DELETE 
  [action-id]
  {action-id ms/PositiveInt}
  (let [action (api/write-check Action action-id)]
    (snowplow/track-event! ::snowplow/action-deleted api/*current-user-id* {:type      (:type action)
                                                                            :action_id action-id}))
  (t2/delete! Action :id action-id)
  api/generic-204-no-content)

/

(api/defendpoint POST 
  "Create a new action."
  [:as {{:keys [type name description model_id parameters parameter_mappings visualization_settings
                kind
                database_id dataset_query
                template response_handle error_handle] :as action} :body}]
  {name                   :string
   model_id               ms/PositiveInt
   type                   [:maybe supported-action-type]
   description            [:maybe :string]
   parameters             [:maybe [:sequential map?]]
   parameter_mappings     [:maybe map?]
   visualization_settings [:maybe map?]
   kind                   [:maybe implicit-action-kind]
   database_id            [:maybe ms/PositiveInt]
   dataset_query          [:maybe map?]
   template               [:maybe http-action-template]
   response_handle        [:maybe json-query-schema]
   error_handle           [:maybe json-query-schema]}
  (when (and (nil? database_id)
             (= "query" type))
    (throw (ex-info (tru "Must provide a database_id for query actions")
                    {:type        type
                     :status-code 400})))
  (let [model (api/write-check Card model_id)]
    (when (and (= "implicit" type)
               (not (card/model-supports-implicit-actions? model)))
      (throw (ex-info (tru "Implicit actions are not supported for models with clauses.")
                      {:status-code 400})))
    (doseq [db-id (cond-> [(:database_id model)] database_id (conj database_id))]
      (actions/check-actions-enabled-for-database!
       (t2/select-one Database :id db-id))))
  (let [action-id (action/insert! (assoc action :creator_id api/*current-user-id*))]
    (snowplow/track-event! ::snowplow/action-created api/*current-user-id* {:type           type
                                                                            :action_id      action-id
                                                                            :num_parameters (count parameters)})
    (if action-id
      (action/select-action :id action-id)
      ;; t2/insert! does not return a value when used with h2
      ;; so we return the most recently updated http action.
      (last (action/select-actions nil :type type)))))

/:id

(api/defendpoint PUT 
  [id :as {action :body}]
  {id     ms/PositiveInt
   action [:map
           [:archived               {:optional true} [:maybe :boolean]]
           [:database_id            {:optional true} [:maybe ms/PositiveInt]]
           [:dataset_query          {:optional true} [:maybe :map]]
           [:description            {:optional true} [:maybe :string]]
           [:error_handle           {:optional true} [:maybe json-query-schema]]
           [:kind                   {:optional true} [:maybe implicit-action-kind]]
           [:model_id               {:optional true} [:maybe ms/PositiveInt]]
           [:name                   {:optional true} [:maybe :string]]
           [:parameter_mappings     {:optional true} [:maybe :map]]
           [:parameters             {:optional true} [:maybe [:sequential :map]]]
           [:response_handle        {:optional true} [:maybe json-query-schema]]
           [:template               {:optional true} [:maybe http-action-template]]
           [:type                   {:optional true} [:maybe supported-action-type]]
           [:visualization_settings {:optional true} [:maybe :map]]]}
  (actions/check-actions-enabled! id)
  (let [existing-action (api/write-check Action id)]
    (action/update! (assoc action :id id) existing-action))
  (let [{:keys [parameters type] :as action} (action/select-action :id id)]
    (snowplow/track-event! ::snowplow/action-updated api/*current-user-id* {:type           type
                                                                            :action_id      id
                                                                            :num_parameters (count parameters)})
    action))

/:id/public_link

(api/defendpoint POST 
  "Generate publicly-accessible links for this Action. Returns UUID to be used in public links. (If this
  Action has already been shared, it will return the existing public link rather than creating a new one.) Public
  sharing must be enabled."
  [id]
  {id ms/PositiveInt}
  (api/check-superuser)
  (validation/check-public-sharing-enabled)
  (let [action (api/read-check Action id :archived false)]
    (actions/check-actions-enabled! action)
    {:uuid (or (:public_uuid action)
               (u/prog1 (str (random-uuid))
                 (t2/update! Action id
                             {:public_uuid <>
                              :made_public_by_id api/*current-user-id*})))}))

/:id/public_link

(api/defendpoint DELETE 
  "Delete the publicly-accessible link to this Dashboard."
  [id]
  {id ms/PositiveInt}
  ;; check the /application/setting permission, not superuser because removing a public link is possible from /admin/settings
  (validation/check-has-application-permission :setting)
  (validation/check-public-sharing-enabled)
  (api/check-exists? Action :id id, :public_uuid [:not= nil], :archived false)
  (actions/check-actions-enabled! id)
  (t2/update! Action id {:public_uuid nil, :made_public_by_id nil})
  {:status 204, :body nil})

/:action-id/execute

(api/defendpoint GET 
  "Fetches the values for filling in execution parameters. Pass PK parameters and values to select."
  [action-id parameters]
  {action-id  ms/PositiveInt
   parameters ms/JSONString}
  (actions/check-actions-enabled! action-id)
  (-> (action/select-action :id action-id :archived false)
      api/read-check
      (actions.execution/fetch-values (json/parse-string parameters))))

/:id/execute

(api/defendpoint POST 
  "Execute the Action.
   `parameters` should be the mapped dashboard parameters with values."
  [id :as {{:keys [parameters], :as _body} :body}]
  {id         ms/PositiveInt
   parameters [:maybe [:map-of :keyword any?]]}
  (let [{:keys [type] :as action} (api/check-404 (action/select-action :id id :archived false))]
    (snowplow/track-event! ::snowplow/action-executed api/*current-user-id* {:source    :model_detail
                                                                             :type      type
                                                                             :action_id id})
    (actions.execution/execute-action! action (update-keys parameters name))))
(api/define-routes)
 
(ns metabase.api.activity
  (:require
   [clojure.string :as str]
   [compojure.core :refer [GET]]
   [medley.core :as m]
   [metabase.api.common :as api :refer [*current-user-id* define-routes]]
   [metabase.db.util :as mdb.u]
   [metabase.models.card :refer [Card]]
   [metabase.models.dashboard :refer [Dashboard]]
   [metabase.models.interface :as mi]
   [metabase.models.query-execution :refer [QueryExecution]]
   [metabase.models.recent-views :as recent-views]
   [metabase.models.table :refer [Table]]
   [metabase.models.view-log :refer [ViewLog]]
   [metabase.util.honey-sql-2 :as h2x]
   [toucan2.core :as t2]))
(defn- models-query
  [model ids]
  (t2/select
   (case model
     "card"      [Card
                  :id :name :collection_id :description :display
                  :dataset_query :dataset :archived
                  :collection.authority_level]
     "dashboard" [Dashboard
                  :id :name :collection_id :description
                  :archived
                  :collection.authority_level]
     "table"     [Table
                  :id :name :db_id
                  :display_name :initial_sync_status
                  :visibility_type])
   (let [model-symb (symbol (str/capitalize model))
         self-qualify #(mdb.u/qualify model-symb %)]
     (cond-> {:where [:in (self-qualify :id) ids]}
       (not= model "table")
       (merge {:left-join [:collection [:= :collection.id (self-qualify :collection_id)]]})))))
(defn- select-items! [model ids]
  (when (seq ids)
    (for [model (t2/hydrate (models-query model ids) :moderation_reviews)
          :let [reviews (:moderation_reviews model)
                status  (->> reviews
                             (filter :most_recent)
                             first
                             :status)]]
      (assoc model :moderated_status status))))

Returns a map of {model {id instance}} for activity views suitable for looking up by model and id to get a model.

(defn- models-for-views
  [views]
  (into {} (map (fn [[model models]]
                  [model (->> models
                              (map :model_id)
                              (select-items! model)
                              (m/index-by :id))]))
        (group-by :model views)))

Query implementation for popular_items. Tables and Dashboards have a query limit of views-limit. Cards have a query limit of card-runs-limit.

The expected output of the query is a single row per unique model viewed by the current user including a :max_ts which has the most recent view timestamp of the item and :cnt which has total views. We order the results by most recently viewed then hydrate the basic details of the model. Bookmarked cards and dashboards are not included in the result.

Viewing a Dashboard will add entries to the view log for all cards on that dashboard so all card views are instead derived from the query_execution table. The query context is always a :question. The results are normalized and concatenated to the query results for dashboard and table views.

(defn- views-and-runs
  [views-limit card-runs-limit all-users?]
  ;; TODO update to use RecentViews instead of ViewLog
  (let [dashboard-and-table-views (t2/select [ViewLog
                                              [[:min :view_log.user_id] :user_id]
                                              :model
                                              :model_id
                                              [:%count.* :cnt]
                                              [:%max.timestamp :max_ts]]
                                             {:group-by  [:model :model_id]
                                              :where     [:and
                                                          (when-not all-users? [:= (mdb.u/qualify ViewLog :user_id) *current-user-id*])
                                                          [:in :model #{"dashboard" "table"}]
                                                          [:= :bm.id nil]]
                                              :order-by  [[:max_ts :desc] [:model :desc]]
                                              :limit     views-limit
                                              :left-join [[:dashboard_bookmark :bm]
                                                          [:and
                                                           [:= :model "dashboard"]
                                                           [:= :bm.user_id *current-user-id*]
                                                           [:= :model_id :bm.dashboard_id]]]})
        card-runs                 (->> (t2/select [QueryExecution
                                                   [:%min.executor_id :user_id]
                                                   [(mdb.u/qualify QueryExecution :card_id) :model_id]
                                                   [:%count.* :cnt]
                                                   [:%max.started_at :max_ts]]
                                                  {:group-by [(mdb.u/qualify QueryExecution :card_id) :context]
                                                   :where    [:and
                                                              (when-not all-users? [:= :executor_id *current-user-id*])
                                                              [:= :context (h2x/literal :question)]
                                                              [:= :bm.id nil]]
                                                   :order-by [[:max_ts :desc]]
                                                   :limit    card-runs-limit
                                                   :left-join [[:card_bookmark :bm]
                                                               [:and
                                                                [:= :bm.user_id *current-user-id*]
                                                                [:= (mdb.u/qualify QueryExecution :card_id) :bm.card_id]]]})
                                       (map #(dissoc % :row_count))
                                       (map #(assoc % :model "card")))]
    (->> (concat card-runs dashboard-and-table-views)
         (sort-by :max_ts)
         reverse)))
(def ^:private views-limit 8)
(def ^:private card-runs-limit 8)

/recent_views

(api/defendpoint GET 
  "Get a list of 5 things the current user has been viewing most recently."
  []
  (let [views            (recent-views/user-recent-views api/*current-user-id* 10)
        model->id->items (models-for-views views)]
    (->> (for [{:keys [model model_id] :as view-log} views
               :let
               [model-object (-> (get-in model->id->items [model model_id])
                                 (dissoc :dataset_query))]
               :when
               (and model-object
                    (mi/can-read? model-object)
                    ;; hidden tables, archived cards/dashboards
                    (not (or (:archived model-object)
                             (= (:visibility_type model-object) :hidden))))]
           (cond-> (assoc view-log :model_object model-object)
             (:dataset model-object) (assoc :model "dataset")))
         (take 5))))

/mostrecentlyviewed_dashboard

(api/defendpoint GET 
  "Get the most recently viewed dashboard for the current user. Returns a 204 if the user has not viewed any dashboards
   in the last 24 hours."
  []
  (if-let [dashboard-id (recent-views/most-recently-viewed-dashboard-id api/*current-user-id*)]
    (let [dashboard (-> (t2/select-one Dashboard :id dashboard-id)
                        api/check-404
                        (t2/hydrate [:collection :is_personal]))]
      (if (mi/can-read? dashboard)
        dashboard
        api/generic-204-no-content))
    api/generic-204-no-content))

Returns true if the item belongs to an official collection. False otherwise. Assumes that :authority_level exists if the item can be placed in a collection.

(defn- official?
  [{:keys [authority_level]}]
  (boolean
   (when authority_level
     (#{"official"} authority_level))))

Return true if the item is verified, false otherwise. Assumes that :moderated_status is hydrated.

(defn- verified?
  [{:keys [moderated_status]}]
  (= moderated_status "verified"))
(defn- score-items
  [items]
  (when (seq items)
    (let [n-items (count items)
          max-count (apply max (map :cnt items))]
      (for [[recency-pos {:keys [cnt model_object] :as item}] (zipmap (range) items)]
        (let [verified-wt 1
              official-wt 1
              recency-wt 2
              views-wt 4
              scores [;; cards and dashboards? can be 'verified' in enterprise
                      (if (verified? model_object) verified-wt 0)
                      ;; items may exist in an 'official' collection in enterprise
                      (if (official? model_object) official-wt 0)
                      ;; most recent item = 1 * recency-wt, least recent item of 10 items = 1/10 * recency-wt
                      (* (/ (- n-items recency-pos) n-items) recency-wt)
                      ;; item with highest count = 1 * views-wt, lowest = item-view-count / max-view-count * views-wt
                      ;; NOTE: the query implementation `views-and-runs` has an order-by clause using most recent timestamp
                      ;; this has an effect on the outcomes. Consider an item with a massively high viewcount but a last view by the user
                      ;; a long time ago. This may not even make it into the firs 10 items from the query, even though it might be worth showing
                      (* (/ cnt max-count) views-wt)]]
          (assoc item :score (double (reduce + scores))))))))
(def ^:private model-precedence ["dashboard" "card" "dataset" "table"])
(defn- order-items
  [items]
  (when (seq items)
      (let [groups (group-by :model items)]
        (mapcat #(get groups %) model-precedence))))

/popular_items

(api/defendpoint GET 
  "Get the list of 5 popular things for the current user. Query takes 8 and limits to 5 so that if it
  finds anything archived, deleted, etc it can usually still get 5."
  []
  ;; we can do a weighted score which incorporates:
  ;; total count -> higher = higher score
  ;; recently viewed -> more recent = higher score
  ;; official/verified -> yes = higher score
  (let [views (views-and-runs views-limit card-runs-limit true)
        model->id->items (models-for-views views)
        filtered-views (for [{:keys [model model_id] :as view-log} views
                             :let [model-object (-> (get-in model->id->items [model model_id])
                                                    (dissoc :dataset_query))]
                             :when (and model-object
                                        (mi/can-read? model-object)
                                        ;; hidden tables, archived cards/dashboards
                                        (not (or (:archived model-object)
                                                 (= (:visibility_type model-object) :hidden))))]
                         (cond-> (assoc view-log :model_object model-object)
                           (:dataset model-object) (assoc :model "dataset")))
        scored-views (score-items filtered-views)]
    (->> scored-views
         (sort-by :score)
         reverse
         order-items
         (take 5)
         (map #(dissoc % :score)))))
(define-routes)
 

/api/alert endpoints

(ns metabase.api.alert
  (:require
   [clojure.data :as data]
   [clojure.set :refer [difference]]
   [compojure.core :refer [DELETE GET POST PUT]]
   [medley.core :as m]
   [metabase.api.common :as api]
   [metabase.api.common.validation :as validation]
   [metabase.config :as config]
   [metabase.email :as email]
   [metabase.email.messages :as messages]
   [metabase.events :as events]
   [metabase.models.card :refer [Card]]
   [metabase.models.interface :as mi]
   [metabase.models.pulse :as pulse]
   [metabase.models.pulse-channel :refer [PulseChannel]]
   [metabase.models.pulse-channel-recipient :refer [PulseChannelRecipient]]
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)
(when config/ee-available?
  (classloader/require 'metabase-enterprise.advanced-permissions.common))

/

(api/defendpoint GET 
  "Fetch alerts which the current user has created or will receive, or all alerts if the user is an admin.
  The optional `user_id` will return alerts created by the corresponding user, but is ignored for non-admin users."
  [archived user_id]
  {archived [:maybe ms/BooleanString]
   user_id  [:maybe ms/PositiveInt]}
  (let [user-id (if api/*is-superuser?*
                  user_id
                  api/*current-user-id*)]
    (as-> (pulse/retrieve-alerts {:archived? (Boolean/parseBoolean archived)
                                  :user-id   user-id}) <>
      (filter mi/can-read? <>)
      (t2/hydrate <> :can_write))))

/:id

(api/defendpoint GET 
  "Fetch an alert by ID"
  [id]
  {id ms/PositiveInt}
  (-> (api/read-check (pulse/retrieve-alert id))
      (t2/hydrate :can_write)))

/question/:id

(api/defendpoint GET 
  "Fetch all alerts for the given question (`Card`) id"
  [id archived]
  {id       [:maybe ms/PositiveInt]
   archived [:maybe ms/BooleanString]}
  (-> (if api/*is-superuser?*
        (pulse/retrieve-alerts-for-cards {:card-ids [id], :archived? (Boolean/parseBoolean archived)})
        (pulse/retrieve-user-alerts-for-card {:card-id id, :user-id api/*current-user-id*, :archived? (Boolean/parseBoolean archived)}))
      (t2/hydrate :can_write)))
(defn- only-alert-keys [request]
  (u/select-keys-when request
    :present [:alert_condition :alert_first_only :alert_above_goal :archived]))

Get email channel from an alert.

(defn email-channel
  [alert]
  (m/find-first #(= :email (keyword (:channel_type %))) (:channels alert)))

Get slack channel from an alert.

(defn- slack-channel
  [alert]
  (m/find-first #(= :slack (keyword (:channel_type %))) (:channels alert)))
(defn- key-by [key-fn coll]
  (zipmap (map key-fn coll) coll))
(defn- notify-email-disabled! [alert recipients]
  (doseq [user recipients]
    (messages/send-admin-unsubscribed-alert-email! alert user @api/*current-user*)))
(defn- notify-email-enabled! [alert recipients]
  (doseq [user recipients]
    (messages/send-you-were-added-alert-email! alert user @api/*current-user*)))
(defn- notify-email-recipient-diffs! [old-alert old-recipients new-alert new-recipients]
  (let [old-ids->users (key-by :id old-recipients)
        new-ids->users (key-by :id new-recipients)
        [removed-ids added-ids _] (data/diff (set (keys old-ids->users))
                                             (set (keys new-ids->users)))]
    (doseq [old-id removed-ids
            :let [removed-user (get old-ids->users old-id)]]
      (messages/send-admin-unsubscribed-alert-email! old-alert removed-user @api/*current-user*))
    (doseq [new-id added-ids
            :let [added-user (get new-ids->users new-id)]]
      (messages/send-you-were-added-alert-email! new-alert added-user @api/*current-user*))))

This function compares OLD-ALERT and UPDATED-ALERT to determine if there have been any channel or recipient related changes. Recipients that have been added or removed will be notified.

(defn- notify-recipient-changes!
  [old-alert updated-alert]
  (let [{old-recipients :recipients, old-enabled :enabled} (email-channel old-alert)
        {new-recipients :recipients, new-enabled :enabled} (email-channel updated-alert)]
    (cond
      ;; Did email notifications just get disabled?
      (and old-enabled (not new-enabled))
      (notify-email-disabled! old-alert old-recipients)
      ;; Did a disabled email notifications just get re-enabled?
      (and (not old-enabled) new-enabled)
      (notify-email-enabled! updated-alert new-recipients)
      ;; No need to notify recipients if emails are disabled
      new-enabled
      (notify-email-recipient-diffs! old-alert old-recipients updated-alert new-recipients))))
(defn- collect-alert-recipients [alert]
  (set (:recipients (email-channel alert))))
(defn- non-creator-recipients [{{creator-id :id} :creator :as alert}]
 (remove #(= creator-id (:id %)) (collect-alert-recipients alert)))
(defn- notify-new-alert-created! [alert]
  (when (email/email-configured?)
    (messages/send-new-alert-email! alert)
    (doseq [recipient (non-creator-recipients alert)]
      (messages/send-you-were-added-alert-email! alert recipient @api/*current-user*))))
(defn- maybe-include-csv [card alert-condition]
  (if (= "rows" alert-condition)
    (assoc card :include_csv true)
    card))

/

(api/defendpoint POST 
  "Create a new Alert."
  [:as {{:keys [alert_condition card channels alert_first_only alert_above_goal]
         :as new-alert-request-body} :body}]
  {alert_condition  pulse/AlertConditions
   alert_first_only :boolean
   alert_above_goal [:maybe :boolean]
   card             pulse/CardRef
   channels         [:+ :map]}
  (validation/check-has-application-permission :subscription false)
  ;; To create an Alert you need read perms for its Card
  (api/read-check Card (u/the-id card))
  ;; ok, now create the Alert
  (let [alert-card (-> card (maybe-include-csv alert_condition) pulse/card->ref)
        new-alert  (api/check-500
                    (-> new-alert-request-body
                        only-alert-keys
                        (pulse/create-alert! api/*current-user-id* alert-card channels)))]
   (events/publish-event! :event/alert-create {:object new-alert :user-id api/*current-user-id*})
   (notify-new-alert-created! new-alert)
    ;; return our new Alert
   new-alert))

When an alert is archived, we notify all recipients that they are no longer receiving that alert.

(defn- notify-on-archive-if-needed!
  [alert]
  (when (email/email-configured?)
    (doseq [recipient (collect-alert-recipients alert)]
      (messages/send-admin-unsubscribed-alert-email! alert recipient @api/*current-user*))))

/:id

(api/defendpoint PUT 
  "Update a `Alert` with ID."
  [id :as {{:keys [alert_condition alert_first_only alert_above_goal card channels archived]
            :as alert-updates} :body}]
  {id               ms/PositiveInt
   alert_condition  [:maybe pulse/AlertConditions]
   alert_first_only [:maybe :boolean]
   alert_above_goal [:maybe :boolean]
   card             [:maybe pulse/CardRef]
   channels         [:maybe [:+ [:map]]]
   archived         [:maybe :boolean]}
  (try
   (validation/check-has-application-permission :monitoring)
   (catch clojure.lang.ExceptionInfo _e
     (validation/check-has-application-permission :subscription false)))
  ;; fetch the existing Alert in the DB
  (let [alert-before-update                   (api/check-404 (pulse/retrieve-alert id))
        current-user-has-application-permissions? (and (premium-features/enable-advanced-permissions?)
                                                   (resolve 'metabase-enterprise.advanced-permissions.common/current-user-has-application-permissions?))
        has-subscription-perms?               (and current-user-has-application-permissions?
                                                   (current-user-has-application-permissions? :subscription))
        has-monitoring-permissions?           (and current-user-has-application-permissions?
                                                   (current-user-has-application-permissions? :monitoring))]
    (assert (:card alert-before-update)
            (tru "Invalid Alert: Alert does not have a Card associated with it"))
    ;; check permissions as needed.
    ;; Check permissions to update existing Card
    (api/read-check Card (u/the-id (:card alert-before-update)))
    ;; if trying to change the card, check perms for that as well
    (when card
      (api/write-check Card (u/the-id card)))
    (when-not (or api/*is-superuser?*
                  has-monitoring-permissions?
                  has-subscription-perms?)
      (api/check (= (-> alert-before-update :creator :id) api/*current-user-id*)
                 [403 (tru "Non-admin users without monitoring or subscription permissions are only allowed to update alerts that they created")])
      (api/check (or (not (contains? alert-updates :channels))
                     (and (= 1 (count channels))
                          ;; Non-admin alerts can only include the creator as a recipient
                          (= [api/*current-user-id*]
                             (map :id (:recipients (email-channel alert-updates))))))
                 [403 (tru "Non-admin users without monitoring or subscription permissions are not allowed to modify the channels for an alert")]))
    ;; only admin or users with subscription permissions can add recipients
    (let [to-add-recipients (difference (set (map :id (:recipients (email-channel alert-updates))))
                                        (set (map :id (:recipients (email-channel alert-before-update)))))]
      (api/check (or api/*is-superuser?*
                     has-subscription-perms?
                     (empty? to-add-recipients))
                 [403 (tru "Non-admin users without subscription permissions are not allowed to add recipients")]))
    ;; now update the Alert
    (let [updated-alert (pulse/update-alert!
                         (merge
                          (assoc (only-alert-keys alert-updates)
                                 :id id)
                          (when card
                            {:card (pulse/card->ref card)})
                          (when (contains? alert-updates :channels)
                            {:channels channels})
                          ;; automatically archive alert if it now has no recipients
                          (when (and (contains? alert-updates :channels)
                                     (not (seq (:recipients (email-channel alert-updates))))
                                     (not (slack-channel alert-updates)))
                            {:archived true})))]
      ;; Only admins or users has subscription or monitoring perms
      ;; can update recipients or explicitly archive an alert
      (when (and (or api/*is-superuser?*
                     has-subscription-perms?
                     has-monitoring-permissions?)
                 (email/email-configured?))
        (if archived
          (notify-on-archive-if-needed! updated-alert)
          (notify-recipient-changes! alert-before-update updated-alert)))
      ;; Finally, return the updated Alert
      updated-alert)))

/:id/subscription

(api/defendpoint DELETE 
  "For users to unsubscribe themselves from the given alert."
  [id]
  {id ms/PositiveInt}
  (validation/check-has-application-permission :subscription false)
  (let [alert (pulse/retrieve-alert id)]
    (api/read-check alert)
    (api/let-404 [alert-id (u/the-id alert)
                  pc-id    (t2/select-one-pk PulseChannel :pulse_id alert-id :channel_type "email")
                  pcr-id   (t2/select-one-pk PulseChannelRecipient :pulse_channel_id pc-id :user_id api/*current-user-id*)]
                 (t2/delete! PulseChannelRecipient :id pcr-id))
    ;; Send emails letting people know they have been unsubscribed
    (let [user @api/*current-user*]
      (when (email/email-configured?)
        (messages/send-you-unsubscribed-alert-email! alert user))
      (events/publish-event! :event/alert-unsubscribe {:object {:email (:email user)}
                                                       :user-id api/*current-user-id*}))
    ;; finally, return a 204 No Content
    api/generic-204-no-content))
(api/define-routes)
 

/api/api-key endpoints for CRUD management of API Keys

(ns metabase.api.api-key
  (:require
   [compojure.core :refer [POST GET PUT DELETE]]
   [metabase.api.common :as api]
   [metabase.events :as events]
   [metabase.models.api-key :as api-key]
   [metabase.models.permissions-group :as perms-group]
   [metabase.models.user :as user]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli.schema :as ms]
   [metabase.util.secret :as u.secret]
   [toucan2.core :as t2]))
(defn- maybe-expose-key [api-key]
  (if (contains? api-key :unmasked_key)
    (update api-key :unmasked_key u.secret/expose)
    api-key))

Takes an ApiKey and hydrates/selects keys as necessary to put it into a standard form for responses

(defn- present-api-key
  [api-key]
  (-> api-key
      (t2/hydrate :group :updated_by)
      (select-keys [:created_at
                    :updated_at
                    :updated_by
                    :id
                    :group
                    :unmasked_key
                    :name
                    :masked_key])
      (maybe-expose-key)
      (update :updated_by #(select-keys % [:common_name :id]))))
(defn- key-with-unique-prefix []
  (u/auto-retry 5
   (let [api-key (api-key/generate-key)
         prefix (api-key/prefix (u.secret/expose api-key))]
     ;; we could make this more efficient by generating 5 API keys up front and doing one select to remove any
     ;; duplicates. But a duplicate should be rare enough to just do multiple queries for now.
     (if-not (t2/exists? :model/ApiKey :key_prefix prefix)
       api-key
       (throw (ex-info (tru "could not generate key with unique prefix") {}))))))
(defn- with-updated-by [api-key]
  (assoc api-key :updated_by_id api/*current-user-id*))
(defn- with-creator [api-key]
  (assoc api-key :creator_id api/*current-user-id*))

/

(api/defendpoint POST 
  "Create a new API key (and an associated `User`) with the provided name and group ID."
  [:as {{:keys [group_id name] :as _body} :body}]
  {group_id ms/PositiveInt
   name     ms/NonBlankString}
  (api/check-superuser)
  (api/checkp (not (t2/exists? :model/ApiKey :name name))
    "name" "An API key with this name already exists.")
  (let [unhashed-key (key-with-unique-prefix)
        email        (format "api-key-user-%s@api-key.invalid" (u/slugify name))]
    (t2/with-transaction [_conn]
      (let [user (first
                  (t2/insert-returning-instances! :model/User
                                                  {:email      email
                                                   :first_name name
                                                   :last_name  ""
                                                   :type       :api-key
                                                   :password (str (random-uuid))}))]
        (user/set-permissions-groups! user [(perms-group/all-users) group_id])
        (let [api-key (-> (t2/insert-returning-instance! :model/ApiKey
                                                         (-> {:user_id       (u/the-id user)
                                                              :name          name
                                                              :unhashed_key  unhashed-key}
                                                             with-creator
                                                             with-updated-by))
                          (t2/hydrate :group :updated_by))]
          (events/publish-event! :event/api-key-create
                                 {:object  api-key
                                  :user-id api/*current-user-id*})
          (present-api-key (assoc api-key :unmasked_key unhashed-key)))))))

/count

(api/defendpoint GET 
  "Get the count of API keys in the DB"
  [:as _body]
  (api/check-superuser)
  (t2/count :model/ApiKey))

/:id

(api/defendpoint PUT 
  "Update an API key by changing its group and/or its name"
  [id :as {{:keys [group_id name] :as _body} :body}]
  {id       ms/PositiveInt
   group_id [:maybe ms/PositiveInt]
   name     [:maybe ms/NonBlankString]}
  (api/check-superuser)
  (let [api-key-before (-> (t2/select-one :model/ApiKey :id id)
                           ;; hydrate the group_name for audit logging
                           (t2/hydrate :group)
                           (api/check-404))]
    (t2/with-transaction [_conn]
      (when group_id
        (let [user (-> api-key-before (t2/hydrate :user) :user)]
          (user/set-permissions-groups! user [(perms-group/all-users) {:id group_id}])))
      (when name
        ;; A bit of a pain to keep these in sync, but oh well.
        (t2/update! :model/User (:user_id api-key-before) {:first_name name
                                                           :last_name ""})
        (t2/update! :model/ApiKey id (with-updated-by {:name name}))))
    (let [updated-api-key (-> (t2/select-one :model/ApiKey :id id)
                              (t2/hydrate :group :updated_by))]
      (events/publish-event! :event/api-key-update {:object          updated-api-key
                                                    :previous-object api-key-before
                                                    :user-id         api/*current-user-id*})
      (present-api-key updated-api-key))))

/:id/regenerate

(api/defendpoint PUT 
  "Regenerate an API Key"
  [id]
  {id ms/PositiveInt}
  (api/check-superuser)
  (let [api-key-before (-> (t2/select-one :model/ApiKey id)
                           (t2/hydrate :group)
                           (api/check-404))
        unhashed-key (key-with-unique-prefix)
        api-key-after (assoc api-key-before
                             :unhashed_key unhashed-key
                             :key_prefix (api-key/prefix (u.secret/expose unhashed-key)))]
    (t2/update! :model/ApiKey :id id (with-updated-by
                                       (select-keys api-key-after [:unhashed_key])))
    (events/publish-event! :event/api-key-regenerate
                           {:object api-key-after
                            :previous-object api-key-before
                            :user-id api/*current-user-id*})
    (present-api-key (assoc api-key-after
                            :unmasked_key unhashed-key
                            :masked_key (api-key/mask unhashed-key)))))

/

(api/defendpoint GET 
  "Get a list of API keys. Non-paginated."
  []
  (api/check-superuser)
  (let [api-keys (t2/hydrate (t2/select :model/ApiKey) :group :updated_by)]
    (map present-api-key api-keys)))

/:id

(api/defendpoint DELETE 
  "Delete an ApiKey"
  [id]
  {id ms/PositiveInt}
  (api/check-superuser)
  (let [api-key (-> (t2/select-one :model/ApiKey id)
                    (t2/hydrate :group)
                    (api/check-404))]
    (t2/with-transaction [_tx]
      (t2/delete! :model/ApiKey id)
      (t2/update! :model/User (:user_id api-key) {:is_active false}))
    (events/publish-event! :event/api-key-delete
                           {:object api-key
                            :user-id api/*current-user-id*})
    api/generic-204-no-content))
(api/define-routes)
 
(ns metabase.api.automagic-dashboards
  (:require
   [buddy.core.codecs :as codecs]
   [cheshire.core :as json]
   [compojure.core :refer [GET]]
   [metabase.api.common :as api]
   [metabase.automagic-dashboards.comparison :refer [comparison-dashboard]]
   [metabase.automagic-dashboards.core :as magic
    :refer [automagic-analysis candidate-tables]]
   [metabase.automagic-dashboards.dashboard-templates :as dashboard-templates]
   [metabase.models.card :refer [Card]]
   [metabase.models.collection :refer [Collection]]
   [metabase.models.database :refer [Database]]
   [metabase.models.field :refer [Field]]
   [metabase.models.metric :refer [Metric]]
   [metabase.models.model-index :refer [ModelIndex ModelIndexValue]]
   [metabase.models.permissions :as perms]
   [metabase.models.query :as query]
   [metabase.models.query.permissions :as query-perms]
   [metabase.models.segment :refer [Segment]]
   [metabase.models.table :refer [Table]]
   [metabase.transforms.dashboard :as transform.dashboard]
   [metabase.transforms.materialize :as tf.materialize]
   [metabase.util.i18n :refer [deferred-tru]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [ring.util.codec :as codec]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)
(def ^:private Show
  (mu/with-api-error-message
    [:maybe [:or [:enum "all"] nat-int?]]
    (deferred-tru "invalid show value")))
(def ^:private Prefix
  (mu/with-api-error-message
    [:fn (fn [prefix]
           (some #(not-empty (dashboard-templates/get-dashboard-templates [% prefix])) ["table" "metric" "field"]))]
    (deferred-tru "invalid value for prefix")))
(def ^:private DashboardTemplate
  (mu/with-api-error-message
    [:fn (fn [dashboard-template]
           (some (fn [toplevel]
                   (some (comp dashboard-templates/get-dashboard-template
                               (fn [prefix]
                                 [toplevel prefix dashboard-template])
                               :dashboard-template-name)
                         (dashboard-templates/get-dashboard-templates [toplevel])))
                 ["table" "metric" "field"]))]
    (deferred-tru "invalid value for dashboard template name")))
(def ^:private ^{:arglists '([s])} decode-base64-json
  (comp #(json/decode % keyword) codecs/bytes->str codec/base64-decode))
(def ^:private Base64EncodedJSON
  (mu/with-api-error-message
    [:fn decode-base64-json]
    (deferred-tru "value couldn''t be parsed as base64 encoded JSON")))

/database/:id/candidates

(api/defendpoint GET 
  "Return a list of candidates for automagic dashboards orderd by interestingness."
  [id]
  {id ms/PositiveInt}
  (-> (t2/select-one Database :id id)
      api/read-check
      candidate-tables))

----------------------------------------- API Endpoints for viewing a transient dashboard ----------------

(defn- adhoc-query-read-check
  [query]
  (api/check-403 (perms/set-has-partial-permissions-for-set?
                   @api/*current-user-permissions-set*
                   (query-perms/perms-set (:dataset_query query), :throw-exceptions? true)))
  query)
(defn- ensure-int
  [x]
  (if (string? x)
    (Integer/parseInt x)
    x))

Parse/decode/coerce string s an to an entity of entity-type. s is something like a unparsed integer row ID, encoded query, or transform name.

(defmulti ^:private ->entity
  {:arglists '([entity-type s])}
  (fn [entity-type _s]
    (keyword entity-type)))
(defmethod ->entity :table
  [_entity-type table-id-str]
  ;; table-id can also be a source query reference like `card__1` so in that case we should pull the ID out and use the
  ;; `:question` method instead
  (if-let [[_ card-id-str] (when (string? table-id-str)
                             (re-matches #"^card__(\d+$)" table-id-str))]
    (->entity :question card-id-str)
    (api/read-check (t2/select-one Table :id (ensure-int table-id-str)))))
(defmethod ->entity :segment
  [_entity-type segment-id-str]
  (api/read-check (t2/select-one Segment :id (ensure-int segment-id-str))))
(defmethod ->entity :model
  [_entity-type card-id-str]
  (api/read-check (t2/select-one Card
                                 :id (ensure-int card-id-str)
                                 :dataset true)))
(defmethod ->entity :question
  [_entity-type card-id-str]
  (api/read-check (t2/select-one Card :id (ensure-int card-id-str))))
(defmethod ->entity :adhoc
  [_entity-type encoded-query]
  (adhoc-query-read-check (query/adhoc-query (decode-base64-json encoded-query))))
(defmethod ->entity :metric
  [_entity-type metric-id-str]
  (api/read-check (t2/select-one Metric :id (ensure-int metric-id-str))))
(defmethod ->entity :field
  [_entity-type field-id-str]
  (api/read-check (t2/select-one Field :id (ensure-int field-id-str))))
(defmethod ->entity :transform
  [_entity-type transform-name]
  (api/read-check (t2/select-one Collection :id (tf.materialize/get-collection transform-name)))
  transform-name)
(def ^:private entities
  (map name (keys (methods ->entity))))
(def ^:private Entity
  (mu/with-api-error-message
    (into [:enum] entities)
    (deferred-tru "Invalid entity type")))
(def ^:private ComparisonEntity
  (mu/with-api-error-message
    [:enum "segment" "adhoc" "table"]
    (deferred-tru "Invalid comparison entity type. Can only be one of \"table\", \"segment\", or \"adhoc\)))

Show is either nil, "all", or a number. If it's a string it needs to be converted into a keyword.

(defn- coerce-show
  [show]
  (cond-> show (= "all" show) keyword))

/:entity/:entity-id-or-query

(api/defendpoint GET 
  "Return an automagic dashboard for entity `entity` with id `id`."
  [entity entity-id-or-query show]
  {show   [:maybe [:or [:= "all"] nat-int?]]
   entity (mu/with-api-error-message
            (into [:enum] entities)
            (deferred-tru "Invalid entity type"))}
  (if (= entity "transform")
    (transform.dashboard/dashboard (->entity entity entity-id-or-query))
    (-> (->entity entity entity-id-or-query)
        (automagic-analysis {:show (coerce-show show)}))))

Identify the pk field of the model with pk_ref, and then find any fks that have that pk as a target.

(defn linked-entities
  [{{field-ref :pk_ref} :model-index {rsmd :result_metadata} :model}]
  (when-let [field-id (:id (some #(when ((comp #{field-ref} :field_ref) %) %) rsmd))]
    (map
     (fn [{:keys [table_id id]}]
       {:linked-table-id table_id
        :linked-field-id id})
     (t2/select 'Field :fk_target_field_id field-id))))

Insert a source model link card into the sequence of passed in cards.

(defn- add-source-model-link
  [{model-name :name model-id :id} cards]
  (let [max-width (->> (map (fn [{:keys [col size_x]}] (+ col size_x)) cards)
                       (into [4])
                       (apply max))]
    (cons
     {:id                     (gensym)
      :size_x                 max-width
      :size_y                 1
      :row                    0
      :col                    0
      :visualization_settings {:virtual_card {:display  "link"
                                              :archived false},
                               :link         {:entity {:id          model-id
                                                       :name        model-name
                                                       :model       "dataset"
                                                       :display     "table"
                                                       :description nil}}}}
     cards)))

For each joinable table from model, create an x-ray dashboard as a tab.

(defn- create-linked-dashboard
  [{{indexed-entity-name :name :keys [model_pk]} :model-index-value
    {model-name :name :as model}                 :model
    :keys                                        [linked-tables]}]
  (if (seq linked-tables)
    (let [child-dashboards (map (fn [{:keys [linked-table-id linked-field-id]}]
                                  (let [table (t2/select-one Table :id linked-table-id)]
                                    (magic/automagic-analysis
                                     table
                                     {:show         :all
                                      :query-filter [:= [:field linked-field-id nil] model_pk]})))
                                linked-tables)
          seed-dashboard   (-> (first child-dashboards)
                               (merge
                                {:name         (format "Here's a look at \"%s\" from \"%s\"" indexed-entity-name model-name)
                                 :description  (format "A dashboard focusing on information linked to %s" indexed-entity-name)
                                 :parameters   []
                                 :param_fields {}})
                               (dissoc :transient_name
                                       :transient_filters))]
      (if (second child-dashboards)
        (->> child-dashboards
             (map-indexed (fn [idx {tab-name :name tab-cards :dashcards}]
                            ;; id starts at 0. want our temporary ids to start at -1, -2, ...
                            (let [tab-id (dec (- idx))]
                              {:tab {:id       tab-id
                                     :name     tab-name
                                     :position idx}
                               :dash-cards
                               (map (fn [dc]
                                      (assoc dc :dashboard_tab_id tab-id))
                                    (add-source-model-link model tab-cards))})))
             (reduce (fn [dashboard {:keys [tab dash-cards]}]
                       (-> dashboard
                           (update :dashcards into dash-cards)
                           (update :tabs conj tab)))
                     (merge
                      seed-dashboard
                      {:dashcards []
                       :tabs      []})))
        (update seed-dashboard
                :dashcards (fn [cards] (add-source-model-link model cards)))))
    {:name      (format "Here's a look at \"%s\" from \"%s\"" indexed-entity-name model-name)
     :dashcards (add-source-model-link
                     model
                     [{:row                    0
                       :col                    0
                       :size_x                 18
                       :size_y                 2
                       :visualization_settings {:text                "# Unfortunately, there's not much else to show right now..."
                                                :virtual_card        {:display :text}
                                                :dashcard.background false
                                                :text.align_vertical :bottom}}])}))

/modelindex/:model-index-id/primarykey/:pk-id

(api/defendpoint GET 
  "Return an automagic dashboard for an entity detail specified by `entity`
  with id `id` and a primary key of `indexed-value`."
  [model-index-id pk-id]
  {model-index-id :int
   pk-id          :int}
  (api/let-404 [model-index (t2/select-one ModelIndex model-index-id)
                model (t2/select-one Card (:model_id model-index))
                model-index-value (t2/select-one ModelIndexValue
                                                 :model_index_id model-index-id
                                                 :model_pk pk-id)]
               ;; `->entity` does a read check on the model but this is here as well to be extra sure.
    (api/read-check Card (:model_id model-index))
    (let [linked (linked-entities {:model             model
                                   :model-index       model-index
                                   :model-index-value model-index-value})]
      (create-linked-dashboard {:model             model
                                :linked-tables     linked
                                :model-index       model-index
                                :model-index-value model-index-value}))))

/:entity/:entity-id-or-query/rule/:prefix/:dashboard-template

(api/defendpoint GET 
  "Return an automagic dashboard for entity `entity` with id `id` using dashboard-template `dashboard-template`."
  [entity entity-id-or-query prefix dashboard-template show]
  {entity Entity
   show   Show
   prefix Prefix
   dashboard-template   DashboardTemplate}
  (-> (->entity entity entity-id-or-query)
      (automagic-analysis {:show (coerce-show show)
                           :dashboard-template ["table" prefix dashboard-template]})))

/:entity/:entity-id-or-query/cell/:cell-query

(api/defendpoint GET 
  "Return an automagic dashboard analyzing cell in  automagic dashboard for entity `entity`
   defined by
   query `cell-query`."
  [entity entity-id-or-query cell-query show]
  {entity     Entity
   show       Show
   cell-query Base64EncodedJSON}
  (-> (->entity entity entity-id-or-query)
      (automagic-analysis {:show       (coerce-show show)
                           :cell-query (decode-base64-json cell-query)})))

/:entity/:entity-id-or-query/cell/:cell-query/rule/:prefix/:dashboard-template

(api/defendpoint GET 
  "Return an automagic dashboard analyzing cell in question  with id `id` defined by
   query `cell-query` using dashboard-template `dashboard-template`."
  [entity entity-id-or-query cell-query prefix dashboard-template show]
  {entity     Entity
   show       Show
   prefix     Prefix
   dashboard-template       DashboardTemplate
   cell-query Base64EncodedJSON}
  (-> (->entity entity entity-id-or-query)
      (automagic-analysis {:show       (coerce-show show)
                           :dashboard-template       ["table" prefix dashboard-template]
                           :cell-query (decode-base64-json cell-query)})))

/:entity/:entity-id-or-query/compare/:comparison-entity/:comparison-entity-id-or-query

(api/defendpoint GET 
  "Return an automagic comparison dashboard for entity `entity` with id `id` compared with entity
   `comparison-entity` with id `comparison-entity-id-or-query.`"
  [entity entity-id-or-query show comparison-entity comparison-entity-id-or-query]
  {show              Show
   entity            Entity
   comparison-entity ComparisonEntity}
  (let [left      (->entity entity entity-id-or-query)
        right     (->entity comparison-entity comparison-entity-id-or-query)
        dashboard (automagic-analysis left {:show         (coerce-show show)
                                            :query-filter nil
                                            :comparison?  true})]
    (comparison-dashboard dashboard left right {})))

/:entity/:entity-id-or-query/rule/:prefix/:dashboard-template/compare/:comparison-entity/:comparison-entity-id-or-query

(api/defendpoint GET 
  "Return an automagic comparison dashboard for entity `entity` with id `id` using dashboard-template `dashboard-template`;
   compared with entity `comparison-entity` with id `comparison-entity-id-or-query.`."
  [entity entity-id-or-query prefix dashboard-template show comparison-entity comparison-entity-id-or-query]
  {entity            Entity
   show              Show
   prefix            Prefix
   dashboard-template              DashboardTemplate
   comparison-entity ComparisonEntity}
  (let [left      (->entity entity entity-id-or-query)
        right     (->entity comparison-entity comparison-entity-id-or-query)
        dashboard (automagic-analysis left {:show         (coerce-show show)
                                            :dashboard-template         ["table" prefix dashboard-template]
                                            :query-filter nil
                                            :comparison?  true})]
    (comparison-dashboard dashboard left right {})))

/:entity/:entity-id-or-query/cell/:cell-query/compare/:comparison-entity/:comparison-entity-id-or-query

(api/defendpoint GET 
  "Return an automagic comparison dashboard for cell in automagic dashboard for entity `entity`
   with id `id` defined by query `cell-query`; compared with entity `comparison-entity` with id
   `comparison-entity-id-or-query.`."
  [entity entity-id-or-query cell-query show comparison-entity comparison-entity-id-or-query]
  {entity            Entity
   show              Show
   cell-query        Base64EncodedJSON
   comparison-entity ComparisonEntity}
  (let [left      (->entity entity entity-id-or-query)
        right     (->entity comparison-entity comparison-entity-id-or-query)
        dashboard (automagic-analysis left {:show         (coerce-show show)
                                            :query-filter nil
                                            :comparison?  true})]
    (comparison-dashboard dashboard left right {:left {:cell-query (decode-base64-json cell-query)}})))

/:entity/:entity-id-or-query/cell/:cell-query/rule/:prefix/:dashboard-template/compare/:comparison-entity/:comparison-entity-id-or-query

(api/defendpoint GET 
  "Return an automagic comparison dashboard for cell in automagic dashboard for entity `entity`
   with id `id` defined by query `cell-query` using dashboard-template `dashboard-template`; compared with entity
   `comparison-entity` with id `comparison-entity-id-or-query.`."
  [entity entity-id-or-query cell-query prefix dashboard-template show comparison-entity comparison-entity-id-or-query]
  {entity            Entity
   show              Show
   prefix            Prefix
   dashboard-template              DashboardTemplate
   cell-query        Base64EncodedJSON
   comparison-entity ComparisonEntity}
  (let [left      (->entity entity entity-id-or-query)
        right     (->entity comparison-entity comparison-entity-id-or-query)
        dashboard (automagic-analysis left {:show         (coerce-show show)
                                            :dashboard-template         ["table" prefix dashboard-template]
                                            :query-filter nil})]
    (comparison-dashboard dashboard left right {:left {:cell-query (decode-base64-json cell-query)}})))
(api/define-routes)
 

Handle creating bookmarks for the user. Bookmarks are in three tables and should be thought of as a tuple of (model, model-id) rather than a row in a table with an id. The DELETE takes the model and id because DELETE's do not necessarily support request bodies. The POST is therefore shaped in this same manner. Since there are three underlying tables the id on the actual bookmark itself is not unique among "bookmarks" and is not a good identifier for using in the API.

(ns metabase.api.bookmark
  (:require
   [compojure.core :refer [DELETE GET POST]]
   [metabase.api.common :as api]
   [metabase.models.bookmark
    :as bookmark
    :refer [CardBookmark CollectionBookmark DashboardBookmark]]
   [metabase.models.card :refer [Card]]
   [metabase.models.collection :refer [Collection]]
   [metabase.models.dashboard :refer [Dashboard]]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

Schema enumerating bookmarkable models.

(def Models
  (into [:enum] ["card" "dashboard" "collection"]))

Schema for an ordered of boomark orderings

(def BookmarkOrderings
  [:sequential [:map
                [:type Models]
                [:item_id ms/PositiveInt]]])

Lookup map from model as a string to [model bookmark-model item-id-key].

(def ^:private lookup
  {"card"       [Card       CardBookmark       :card_id]
   "dashboard"  [Dashboard  DashboardBookmark  :dashboard_id]
   "collection" [Collection CollectionBookmark :collection_id]})

/

(api/defendpoint GET 
  "Fetch all bookmarks for the user"
  []
  ;; already sorted by created_at in query. Can optionally use user sort preferences here and not in the function
  ;; below
  (bookmark/bookmarks-for-user api/*current-user-id*))

/:model/:id

(api/defendpoint POST 
  "Create a new bookmark for user."
  [model id]
  {model Models
   id    ms/PositiveInt}
  (let [[item-model bookmark-model item-key] (lookup model)]
    (api/read-check item-model id)
    (api/check (not (t2/exists? bookmark-model item-key id
                                :user_id api/*current-user-id*))
      [400 "Bookmark already exists"])
    (first (t2/insert-returning-instances! bookmark-model {item-key id :user_id api/*current-user-id*}))))

/:model/:id

(api/defendpoint DELETE 
  "Delete a bookmark. Will delete a bookmark assigned to the user making the request by model and id."
  [model id]
  {model Models
   id    ms/PositiveInt}
  ;; todo: allow admins to include an optional user id to delete for so they can delete other's bookmarks.
  (let [[_ bookmark-model item-key] (lookup model)]
    (t2/delete! bookmark-model
                :user_id api/*current-user-id*
                item-key id)
    api/generic-204-no-content))

/ordering

(api/defendpoint PUT 
  "Sets the order of bookmarks for user."
  [:as {{:keys [orderings]} :body}]
  {orderings BookmarkOrderings}
  (bookmark/save-ordering! api/*current-user-id* orderings)
  api/generic-204-no-content)
(api/define-routes)
 

/api/card endpoints.

(ns metabase.api.card
  (:require
   [cheshire.core :as json]
   [clojure.core.async :as a]
   [clojure.java.io :as io]
   [compojure.core :refer [DELETE GET POST PUT]]
   [medley.core :as m]
   [metabase.api.common :as api]
   [metabase.api.common.validation :as validation]
   [metabase.api.dataset :as api.dataset]
   [metabase.api.field :as api.field]
   [metabase.driver :as driver]
   [metabase.events :as events]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.util :as mbql.u]
   [metabase.models
    :refer [Card CardBookmark Collection Database PersistedInfo Table]]
   [metabase.models.card :as card]
   [metabase.models.collection :as collection]
   [metabase.models.collection.root :as collection.root]
   [metabase.models.interface :as mi]
   [metabase.models.params :as params]
   [metabase.models.params.custom-values :as custom-values]
   [metabase.models.persisted-info :as persisted-info]
   [metabase.models.query :as query]
   [metabase.models.query.permissions :as query-perms]
   [metabase.models.revision.last-edit :as last-edit]
   [metabase.models.timeline :as timeline]
   [metabase.public-settings :as public-settings]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.query-processor.card :as qp.card]
   [metabase.query-processor.pivot :as qp.pivot]
   [metabase.related :as related]
   [metabase.server.middleware.offset-paging :as mw.offset-paging]
   [metabase.sync.analyze.query-results :as qr]
   [metabase.task.persist-refresh :as task.persist-refresh]
   [metabase.upload :as upload]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date]
   [metabase.util.i18n :refer [deferred-tru trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [steffan-westcott.clj-otel.api.trace.span :as span]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

----------------------------------------------- Filtered Fetch Fns -----------------------------------------------

(defmulti ^:private cards-for-filter-option*
  {:arglists '([filter-option & args])}
  (fn [filter-option & _]
    (keyword filter-option)))

return all Cards. This is the default filter option.

(defmethod cards-for-filter-option* :all
  [_]
  (t2/select Card, :archived false, {:order-by [[:%lower.name :asc]]}))

return Cards created by the current user

(defmethod cards-for-filter-option* :mine
  [_]
  (t2/select Card, :creator_id api/*current-user-id*, :archived false, {:order-by [[:%lower.name :asc]]}))

return all Cards bookmarked by the current user.

(defmethod cards-for-filter-option* :bookmarked
  [_]
  (let [cards (for [{{:keys [archived], :as card} :card} (t2/hydrate (t2/select [CardBookmark :card_id]
                                                                      :user_id api/*current-user-id*)
                                                                  :card)
                    :when                                 (not archived)]
                card)]
    (sort-by :name cards)))

Return all Cards belonging to Database with database-id.

(defmethod cards-for-filter-option* :database
  [_ database-id]
  (t2/select Card, :database_id database-id, :archived false, {:order-by [[:%lower.name :asc]]}))

Return all Cards belonging to Table with table-id.

(defmethod cards-for-filter-option* :table
  [_ table-id]
  (t2/select Card, :table_id table-id, :archived false, {:order-by [[:%lower.name :asc]]}))

Cards that have been archived.

(defmethod cards-for-filter-option* :archived
  [_]
  (t2/select Card, :archived true, {:order-by [[:%lower.name :asc]]}))

Cards that are using a given model.

(defmethod cards-for-filter-option* :using_model
  [_filter-option model-id]
  (->> (t2/select Card {:select [:c.*]
                        :from [[:report_card :m]]
                        :join [[:report_card :c] [:and
                                                  [:= :c.database_id :m.database_id]
                                                  [:or
                                                   [:like :c.dataset_query (format "%%card__%s%%" model-id)]
                                                   [:like :c.dataset_query (format "%%#%s%%" model-id)]]]]
                        :where [:and [:= :m.id model-id] [:not :c.archived]]})
       ;; now check if model-id really occurs as a card ID
       (filter (fn [card] (some #{model-id} (-> card :dataset_query query/collect-card-ids))))))
(defn- cards-for-filter-option [filter-option model-id-or-nil]
  (-> (apply cards-for-filter-option* filter-option (when model-id-or-nil [model-id-or-nil]))
      (t2/hydrate :creator :collection)))

a valid card filter option.

-------------------------------------------- Fetching a Card or Cards --------------------------------------------

(def ^:private card-filter-options
  (map name (keys (methods cards-for-filter-option*))))

/

(api/defendpoint GET 
  "Get all the Cards. Option filter param `f` can be used to change the set of Cards that are returned; default is
  `all`, but other options include `mine`, `bookmarked`, `database`, `table`, `using_model` and `archived`. See
  corresponding implementation functions above for the specific behavior of each filterp option. :card_index:"
  [f model_id]
  {f        [:maybe (into [:enum] card-filter-options)]
   model_id [:maybe ms/PositiveInt]}
  (let [f (or (keyword f) :all)]
    (when (contains? #{:database :table :using_model} f)
      (api/checkp (integer? model_id) "model_id" (format "model_id is a required parameter when filter mode is '%s'"
                                                         (name f)))
      (case f
        :database    (api/read-check Database model_id)
        :table       (api/read-check Database (t2/select-one-fn :db_id Table, :id model_id))
        :using_model (api/read-check Card model_id)))
    (let [cards          (filter mi/can-read? (cards-for-filter-option f model_id))
          last-edit-info (:card (last-edit/fetch-last-edited-info {:card-ids (map :id cards)}))]
      (into []
            (map (fn [{:keys [id] :as card}]
                   (if-let [edit-info (get last-edit-info id)]
                     (assoc card :last-edit-info edit-info)
                     card)))
            cards))))

Adds additional information to a Card selected with toucan that is needed by the frontend. This should be the same information returned by all API endpoints where the card entity is cached (i.e. GET, PUT, POST) since the frontend replaces the Card it currently has with returned one -- See #4283

(defn hydrate-card-details
  [{card-id :id :as card}]
  (span/with-span!
    {:name       "hydrate-card-details"
     :attributes {:card/id card-id}}
    (-> card
        (t2/hydrate :creator
                    :dashboard_count
                    :can_write
                    :average_query_time
                    :last_query_start
                    :parameter_usage_count
                    [:collection :is_personal]
                    [:moderation_reviews :moderator_details])
        (cond->                                             ; card
          (:dataset card) (t2/hydrate :persisted)))))

/:id

(api/defendpoint GET 
  "Get `Card` with ID."
  [id ignore_view]
  {id ms/PositiveInt
   ignore_view [:maybe :boolean]}
  (let [raw-card (t2/select-one Card :id id)
        card (-> raw-card
                 api/read-check
                 hydrate-card-details
                 ;; Cal 2023-11-27: why is last-edit-info hydrated differently for GET vs PUT and POST
                 (last-edit/with-last-edit-info :card)
                 collection.root/hydrate-root-collection)]
    (u/prog1 card
      (when-not ignore_view
        (events/publish-event! :event/card-read {:object <> :user-id api/*current-user-id*})))))
(defn- card-columns-from-names
  [card names]
  (when-let [names (set names)]
    (filter #(names (:name %)) (:result_metadata card))))
(defn- cols->kebab-case
  [cols]
  (map #(update-keys % u/->kebab-case-en) cols))
(defn- area-bar-line-series-are-compatible?
  [first-card second-card]
  (and (#{:area :line :bar} (:display second-card))
       (let [initial-dimensions (cols->kebab-case
                                  (card-columns-from-names
                                    first-card
                                    (get-in first-card [:visualization_settings :graph.dimensions])))
             new-dimensions     (cols->kebab-case
                                  (card-columns-from-names
                                    second-card
                                    (get-in second-card [:visualization_settings :graph.dimensions])))
             new-metrics        (cols->kebab-case
                                  (card-columns-from-names
                                    second-card
                                    (get-in second-card [:visualization_settings :graph.metrics])))]
         (cond
           ;; must have at least one dimension and one metric
           (or (zero? (count new-dimensions))
               (zero? (count new-metrics)))
           false
           ;; all metrics must be numeric
           (not (every? lib.types.isa/numeric? new-metrics))
           false
           ;; both or neither primary dimension must be dates
           (not= (lib.types.isa/temporal? (first initial-dimensions))
                 (lib.types.isa/temporal? (first new-dimensions)))
           false
           ;; both or neither primary dimension must be numeric
           ;; a timestamp field is both date and number so don't enforce the condition if both fields are dates; see #2811
           (and (not= (lib.types.isa/numeric? (first initial-dimensions))
                      (lib.types.isa/numeric? (first new-dimensions)))
                (not (and
                      (lib.types.isa/temporal? (first initial-dimensions))
                      (lib.types.isa/temporal? (first new-dimensions)))))
           false
           :else true))))

Check if the second-card is compatible to be used as series of card.

(defmulti series-are-compatible?
  (fn [card _second-card]
   (:display card)))
(defmethod series-are-compatible? :area
  [first-card second-card]
  (area-bar-line-series-are-compatible? first-card second-card))
(defmethod series-are-compatible? :line
  [first-card second-card]
  (area-bar-line-series-are-compatible? first-card second-card))
(defmethod series-are-compatible? :bar
  [first-card second-card]
  (area-bar-line-series-are-compatible? first-card second-card))
(defmethod series-are-compatible? :scalar
  [first-card second-card]
  (and (= :scalar (:display second-card))
       (= 1
          (count (:result_metadata first-card))
          (count (:result_metadata second-card)))))
(def ^:private supported-series-display-type (set (keys (methods series-are-compatible?))))

Implementaiton of fetch-compatible-series.

Provide page-size to limit the number of cards returned, it does not guaranteed to return exactly page-size cards. Use fetch-compatible-series for that.

(defn- fetch-compatible-series*
  [card {:keys [query last-cursor page-size exclude-ids] :as _options}]
  (let [matching-cards  (t2/select Card
                                   :archived false
                                   :display [:in supported-series-display-type]
                                   :id [:not= (:id card)]
                                   (cond-> {:order-by [[:id :desc]]
                                            :where    [:and]}
                                     last-cursor
                                     (update :where conj [:< :id last-cursor])
                                     (seq exclude-ids)
                                     (update :where conj [:not [:in :id exclude-ids]])
                                     query
                                     (update :where conj [:like :%lower.name (str "%" (u/lower-case-en query) "%")])
                                     ;; add a little buffer to the page to account for cards that are not
                                     ;; compatible + do not have permissions to read
                                     ;; this is just a heuristic, but it should be good enough
                                     page-size
                                     (assoc :limit (+ 10 page-size))))
        compatible-cards (->> matching-cards
                              (filter mi/can-read?)
                              (filter #(or
                                         ;; columns name on native query are not match with the column name in viz-settings. why??
                                         ;; so we can't use series-are-compatible? to filter out incompatible native cards.
                                         ;; => we assume all native queries are compatible and FE will figure it out later
                                         (= (:query_type %) :native)
                                         (series-are-compatible? card %))))]
    (if page-size
      (take page-size compatible-cards)
      compatible-cards)))

Fetch a list of compatible series for card.

options: - exclude-ids: filter out these card ids - query: filter cards by name - last-cursor: the id of the last card from the previous page - page-size: is nullable, it'll try to fetches exactly page-size cards if there are enough cards.

(defn- fetch-compatible-series
  ([card options]
   (fetch-compatible-series card options []))
  ([card {:keys [page-size] :as options} current-cards]
   (let [cards     (fetch-compatible-series* card options)
         new-cards (concat current-cards cards)]
     ;; if the total card fetches is less than page-size and there are still more, continue fetching
     (if (and (some? page-size)
              (seq cards)
              (< (count cards) page-size))
       (fetch-compatible-series card
                                (merge options
                                       {:page-size   (- page-size (count cards))
                                        :last-cursor (:id (last cards))})
                                new-cards)
       new-cards))))

/:id/series

(api/defendpoint GET 
  "Fetches a list of comptatible series with the card with id `card_id`.
  - `last_cursor` with value is the id of the last card from the previous page to fetch the next page.
  - `query` to search card by name.
  - `exclude_ids` to filter out a list of card ids"
  [id last_cursor query exclude_ids]
  {id          int?
   last_cursor [:maybe ms/PositiveInt]
   query       [:maybe ms/NonBlankString]
   exclude_ids [:maybe [:fn
                        {:error/fn (fn [_ _] (deferred-tru "value must be a sequence of positive integers"))}
                        (fn [ids]
                          (every? pos-int? (api/parse-multi-values-param ids parse-long)))]]}
  (let [exclude_ids  (when exclude_ids (api/parse-multi-values-param exclude_ids parse-long))
        card         (-> (t2/select-one :model/Card :id id) api/check-404 api/read-check)
        card-display (:display card)]
   (when-not (supported-series-display-type card-display)
             (throw (ex-info (tru "Card with type {0} is not compatible to have series" (name card-display))
                             {:display         card-display
                              :allowed-display (map name supported-series-display-type)
                              :status-code     400})))
   (fetch-compatible-series
     card
     {:exclude-ids exclude_ids
      :query       query
      :last-cursor last_cursor
      :page-size   mw.offset-paging/*limit*})))

/:id/timelines

(api/defendpoint GET 
  "Get the timelines for card with ID. Looks up the collection the card is in and uses that."
  [id include start end]
  {id      ms/PositiveInt
   include [:maybe [:= "events"]]
   start   [:maybe ms/TemporalString]
   end     [:maybe ms/TemporalString]}
  (let [{:keys [collection_id] :as _card} (api/read-check Card id)]
    ;; subtlety here. timeline access is based on the collection at the moment so this check should be identical. If
    ;; we allow adding more timelines to a card in the future, we will need to filter on read-check and i don't think
    ;; the read-checks are particularly fast on multiple items
    (timeline/timelines-for-collection collection_id
                                       {:timeline/events? (= include "events")
                                        :events/start     (when start (u.date/parse start))
                                        :events/end       (when end (u.date/parse end))})))

-------------------------------------------------- Saving Cards --------------------------------------------------

Make sure the Current User has the appropriate data permissions to run query. We don't want Users saving Cards with queries they wouldn't be allowed to run!

(defn check-data-permissions-for-query
  [query]
  {:pre [(map? query)]}
  (when-not (query-perms/can-run-query? query)
    (let [required-perms (try
                           (query-perms/perms-set query :throw-exceptions? true)
                           (catch Throwable e
                             e))]
      (throw (ex-info (tru "You cannot save this Question because you do not have permissions to run its query.")
                      {:status-code    403
                       :query          query
                       :required-perms (if (instance? Throwable required-perms)
                                         :error
                                         required-perms)
                       :actual-perms   @api/*current-user-permissions-set*}
                      (when (instance? Throwable required-perms)
                        required-perms))))))

------------------------------------------------- Creating Cards -------------------------------------------------

/

(api/defendpoint POST 
  "Create a new `Card`."
  [:as {{:keys [collection_id collection_position dataset dataset_query description display name
                parameters parameter_mappings result_metadata visualization_settings cache_ttl], :as body} :body}]
  {name                   ms/NonBlankString
   dataset                [:maybe :boolean]
   dataset_query          ms/Map
   parameters             [:maybe [:sequential ms/Parameter]]
   parameter_mappings     [:maybe [:sequential ms/ParameterMapping]]
   description            [:maybe ms/NonBlankString]
   display                ms/NonBlankString
   visualization_settings ms/Map
   collection_id          [:maybe ms/PositiveInt]
   collection_position    [:maybe ms/PositiveInt]
   result_metadata        [:maybe qr/ResultsMetadata]
   cache_ttl              [:maybe ms/PositiveInt]}
  ;; check that we have permissions to run the query that we're trying to save
  (check-data-permissions-for-query dataset_query)
  ;; check that we have permissions for the collection we're trying to save this card to, if applicable
  (collection/check-write-perms-for-collection collection_id)
  (-> (card/create-card! body @api/*current-user*)
      hydrate-card-details
      (assoc :last-edit-info (last-edit/edit-information-for-user @api/*current-user*))))

/:id/copy

(api/defendpoint POST 
  "Copy a `Card`, with the new name 'Copy of _name_'"
  [id]
  {id [:maybe ms/PositiveInt]}
  (let [orig-card (api/read-check Card id)
        new-name  (str (trs "Copy of ") (:name orig-card))
        new-card  (assoc orig-card :name new-name)]
    (-> (card/create-card! new-card @api/*current-user*)
        hydrate-card-details
        (assoc :last-edit-info (last-edit/edit-information-for-user @api/*current-user*)))))

------------------------------------------------- Updating Cards -------------------------------------------------

If the query is being modified, check that we have data permissions to run the query.

(defn- check-allowed-to-modify-query
  [card-before-updates card-updates]
  (let [card-updates (m/update-existing card-updates :dataset_query mbql.normalize/normalize)]
    (when (api/column-will-change? :dataset_query card-before-updates card-updates)
      (check-data-permissions-for-query (:dataset_query card-updates)))))

You must be a superuser to change the value of enable_embedding or embedding_params. Embedding must be enabled.

(defn- check-allowed-to-change-embedding
  [card-before-updates card-updates]
  (when (or (api/column-will-change? :enable_embedding card-before-updates card-updates)
            (api/column-will-change? :embedding_params card-before-updates card-updates))
    (validation/check-embedding-enabled)
    (api/check-superuser)))

/:id

(api/defendpoint PUT 
  "Update a `Card`."
  [id :as {{:keys [dataset_query description display name visualization_settings archived collection_id
                   collection_position enable_embedding embedding_params result_metadata parameters
                   cache_ttl dataset collection_preview]
            :as   card-updates} :body}]
  {id                     ms/PositiveInt
   name                   [:maybe ms/NonBlankString]
   parameters             [:maybe [:sequential ms/Parameter]]
   dataset_query          [:maybe ms/Map]
   dataset                [:maybe :boolean]
   display                [:maybe ms/NonBlankString]
   description            [:maybe :string]
   visualization_settings [:maybe ms/Map]
   archived               [:maybe :boolean]
   enable_embedding       [:maybe :boolean]
   embedding_params       [:maybe ms/EmbeddingParams]
   collection_id          [:maybe ms/PositiveInt]
   collection_position    [:maybe ms/PositiveInt]
   result_metadata        [:maybe qr/ResultsMetadata]
   cache_ttl              [:maybe ms/PositiveInt]
   collection_preview     [:maybe :boolean]}
  (let [card-before-update (t2/hydrate (api/write-check Card id)
                                       [:moderation_reviews :moderator_details])]
    ;; Do various permissions checks
    (doseq [f [collection/check-allowed-to-change-collection
               check-allowed-to-modify-query
               check-allowed-to-change-embedding]]
      (f card-before-update card-updates))
    ;; make sure we have the correct `result_metadata`
    (let [result-metadata-chan  (card/result-metadata-async {:original-query    (:dataset_query card-before-update)
                                                             :query             dataset_query
                                                             :metadata          result_metadata
                                                             :original-metadata (:result_metadata card-before-update)
                                                             :dataset?          (if (some? dataset)
                                                                                  dataset
                                                                                  (:dataset card-before-update))})
          card-updates          (merge card-updates
                                       (when dataset
                                         {:display :table}))
          metadata-timeout      (a/timeout card/metadata-sync-wait-ms)
          [fresh-metadata port] (a/alts!! [result-metadata-chan metadata-timeout])
          timed-out?            (= port metadata-timeout)
          card-updates          (cond-> card-updates
                                  (not timed-out?)
                                  (assoc :result_metadata fresh-metadata))]
      (u/prog1 (-> (card/update-card! {:card-before-update card-before-update
                                       :card-updates       card-updates
                                       :actor              @api/*current-user*})
                   hydrate-card-details
                   (assoc :last-edit-info (last-edit/edit-information-for-user @api/*current-user*)))
        (when timed-out?
          (log/info (trs "Metadata not available soon enough. Saving card {0} and asynchronously updating metadata" id))
          (card/schedule-metadata-saving result-metadata-chan <>))))))

------------------------------------------------- Deleting Cards -------------------------------------------------

/:id

TODO - Pretty sure this endpoint is not actually used any more, since Cards are supposed to get archived (via PUT /api/card/:id) instead of deleted. Should we remove this?

(api/defendpoint DELETE 
  "Delete a Card. (DEPRECATED -- don't delete a Card anymore -- archive it instead.)"
  [id]
  {id ms/PositiveInt}
  (log/warn (tru "DELETE /api/card/:id is deprecated. Instead, change its `archived` value via PUT /api/card/:id."))
  (let [card (api/write-check Card id)]
    (t2/delete! Card :id id)
    (events/publish-event! :event/card-delete {:object card :user-id api/*current-user-id*}))
  api/generic-204-no-content)

-------------------------------------------- Bulk Collections Update ---------------------------------------------

For cards that have a position in the previous collection, add them to the end of the new collection, trying to preseve the order from the original collections. Note it's possible for there to be multiple collections (and thus duplicate collection positions) merged into this new collection. No special tie breaker logic for when that's the case, just use the order the DB returned it in

(defn- update-collection-positions!
  [new-collection-id-or-nil cards]
  ;; Sorting by `:collection_position` to ensure lower position cards are appended first
  (let [sorted-cards        (sort-by :collection_position cards)
        max-position-result (t2/select-one [Card [:%max.collection_position :max_position]]
                              :collection_id new-collection-id-or-nil)
        ;; collection_position for the next card in the collection
        starting-position   (inc (get max-position-result :max_position 0))]
    ;; This is using `map` but more like a `doseq` with multiple seqs. Wrapping this in a `doall` as we don't want it
    ;; to be lazy and we're just going to discard the results
    (doall
     (map (fn [idx {:keys [collection_id collection_position] :as card}]
            ;; We are removing this card from `collection_id` so we need to reconcile any
            ;; `collection_position` entries left behind by this move
            (api/reconcile-position-for-collection! collection_id collection_position nil)
            ;; Now we can update the card with the new collection and a new calculated position
            ;; that appended to the end
            (t2/update! Card
                        (u/the-id card)
                        {:collection_position idx
                         :collection_id       new-collection-id-or-nil}))
          ;; These are reversed because of the classic issue when removing an item from array. If we remove an
          ;; item at index 1, everthing above index 1 will get decremented. By reversing our processing order we
          ;; can avoid changing the index of cards we haven't yet updated
          (reverse (range starting-position (+ (count sorted-cards) starting-position)))
          (reverse sorted-cards)))))
(defn- move-cards-to-collection! [new-collection-id-or-nil card-ids]
  ;; if moving to a collection, make sure we have write perms for it
  (when new-collection-id-or-nil
    (api/write-check Collection new-collection-id-or-nil))
  ;; for each affected card...
  (when (seq card-ids)
    (let [cards (t2/select [Card :id :collection_id :collection_position :dataset_query]
                  {:where [:and [:in :id (set card-ids)]
                                [:or [:not= :collection_id new-collection-id-or-nil]
                                  (when new-collection-id-or-nil
                                    [:= :collection_id nil])]]})] ; poisioned NULLs = ick
      ;; ...check that we have write permissions for it...
      (doseq [card cards]
        (api/write-check card))
      ;; ...and check that we have write permissions for the old collections if applicable
      (doseq [old-collection-id (set (filter identity (map :collection_id cards)))]
        (api/write-check Collection old-collection-id))
      ;; Ensure all of the card updates occur in a transaction. Read commited (the default) really isn't what we want
      ;; here. We are querying for the max card position for a given collection, then using that to base our position
      ;; changes if the cards are moving to a different collection. Without repeatable read here, it's possible we'll
      ;; get duplicates
      (t2/with-transaction [_conn]
        ;; If any of the cards have a `:collection_position`, we'll need to fixup the old collection now that the cards
        ;; are gone and update the position in the new collection
        (when-let [cards-with-position (seq (filter :collection_position cards))]
          (update-collection-positions! new-collection-id-or-nil cards-with-position))
        ;; ok, everything checks out. Set the new `collection_id` for all the Cards that haven't been updated already
        (when-let [cards-without-position (seq (for [card cards
                                                     :when (not (:collection_position card))]
                                                 (u/the-id card)))]
          (t2/update! (t2/table-name Card)
                      {:id [:in (set cards-without-position)]}
                      {:collection_id new-collection-id-or-nil}))))))

/collections

(api/defendpoint POST 
  "Bulk update endpoint for Card Collections. Move a set of `Cards` with `card_ids` into a `Collection` with
  `collection_id`, or remove them from any Collections by passing a `null` `collection_id`."
  [:as {{:keys [card_ids collection_id]} :body}]
  {card_ids      [:sequential ms/PositiveInt]
   collection_id [:maybe ms/PositiveInt]}
  (move-cards-to-collection! collection_id card_ids)
  {:status :ok})

------------------------------------------------ Running a Query -------------------------------------------------

/:card-id/query

(api/defendpoint POST 
  "Run the query associated with a Card."
  [card-id :as {{:keys [parameters ignore_cache dashboard_id collection_preview], :or {ignore_cache false dashboard_id nil}} :body}]
  {card-id            ms/PositiveInt
   ignore_cache       [:maybe :boolean]
   collection_preview [:maybe :boolean]
   dashboard_id       [:maybe ms/PositiveInt]}
  ;; TODO -- we should probably warn if you pass `dashboard_id`, and tell you to use the new
  ;;
  ;;    POST /api/dashboard/:dashboard-id/card/:card-id/query
  ;;
  ;; endpoint instead. Or error in that situtation? We're not even validating that you have access to this Dashboard.
  (qp.card/run-query-for-card-async
   card-id :api
   :parameters   parameters
   :ignore_cache ignore_cache
   :dashboard-id dashboard_id
   :context      (if collection_preview :collection :question)
   :middleware   {:process-viz-settings? false}))

/:card-id/query/:export-format

(api/defendpoint POST 
  "Run the query associated with a Card, and return its results as a file in the specified format.
  `parameters` should be passed as query parameter encoded as a serialized JSON string (this is because this endpoint
  is normally used to power 'Download Results' buttons that use HTML `form` actions)."
  [card-id export-format :as {{:keys [parameters]} :params}]
  {card-id       ms/PositiveInt
   parameters    [:maybe ms/JSONString]
   export-format (into [:enum] api.dataset/export-formats)}
  (qp.card/run-query-for-card-async
   card-id export-format
   :parameters  (json/parse-string parameters keyword)
   :constraints nil
   :context     (api.dataset/export-format->context export-format)
   :middleware  {:process-viz-settings?  true
                 :skip-results-metadata? true
                 :ignore-cached-results? true
                 :format-rows?           false
                 :js-int-to-string?      false}))

----------------------------------------------- Sharing is Caring ------------------------------------------------

/:card-id/public_link

(api/defendpoint POST 
  "Generate publicly-accessible links for this Card. Returns UUID to be used in public links. (If this Card has
  already been shared, it will return the existing public link rather than creating a new one.)  Public sharing must
  be enabled."
  [card-id]
  {card-id ms/PositiveInt}
  (validation/check-has-application-permission :setting)
  (validation/check-public-sharing-enabled)
  (api/check-not-archived (api/read-check Card card-id))
  (let [{existing-public-uuid :public_uuid} (t2/select-one [Card :public_uuid] :id card-id)]
    {:uuid (or existing-public-uuid
               (u/prog1 (str (random-uuid))
                 (t2/update! Card card-id
                             {:public_uuid       <>
                              :made_public_by_id api/*current-user-id*})))}))

/:card-id/public_link

(api/defendpoint DELETE 
  "Delete the publicly-accessible link to this Card."
  [card-id]
  {card-id ms/PositiveInt}
  (validation/check-has-application-permission :setting)
  (validation/check-public-sharing-enabled)
  (api/check-exists? Card :id card-id, :public_uuid [:not= nil])
  (t2/update! Card card-id
              {:public_uuid       nil
               :made_public_by_id nil})
  {:status 204, :body nil})

/public

(api/defendpoint GET 
  "Fetch a list of Cards with public UUIDs. These cards are publicly-accessible *if* public sharing is enabled."
  []
  (validation/check-has-application-permission :setting)
  (validation/check-public-sharing-enabled)
  (t2/select [Card :name :id :public_uuid], :public_uuid [:not= nil], :archived false))

/embeddable

(api/defendpoint GET 
  "Fetch a list of Cards where `enable_embedding` is `true`. The cards can be embedded using the embedding endpoints
  and a signed JWT."
  []
  (validation/check-has-application-permission :setting)
  (validation/check-embedding-enabled)
  (t2/select [Card :name :id], :enable_embedding true, :archived false))

/:id/related

(api/defendpoint GET 
  "Return related entities."
  [id]
  {id ms/PositiveInt}
  (-> (t2/select-one Card :id id) api/read-check related/related))

/related

(api/defendpoint POST 
  "Return related entities for an ad-hoc query."
  [:as {query :body}]
  (related/related (query/adhoc-query query)))

/pivot/:card-id/query

(api/defendpoint POST 
  "Run the query associated with a Card."
  [card-id :as {{:keys [parameters ignore_cache]
                 :or   {ignore_cache false}} :body}]
  {card-id      ms/PositiveInt
   ignore_cache [:maybe :boolean]}
  (qp.card/run-query-for-card-async card-id :api
                            :parameters parameters,
                            :qp-runner qp.pivot/run-pivot-query
                            :ignore_cache ignore_cache))

/:card-id/persist

(api/defendpoint POST 
  "Mark the model (card) as persisted. Runs the query and saves it to the database backing the card and hot swaps this
  query in place of the model's query."
  [card-id]
  {card-id ms/PositiveInt}
  (premium-features/assert-has-feature :cache-granular-controls (tru "Granular cache controls"))
  (api/let-404 [{:keys [dataset database_id] :as card} (t2/select-one Card :id card-id)]
    (let [database (t2/select-one Database :id database_id)]
      (api/write-check database)
      (when-not (driver/database-supports? (:engine database)
                                           :persist-models database)
        (throw (ex-info (tru "Database does not support persisting")
                        {:status-code 400
                         :database    (:name database)})))
      (when-not (driver/database-supports? (:engine database)
                                           :persist-models-enabled database)
        (throw (ex-info (tru "Persisting models not enabled for database")
                        {:status-code 400
                         :database    (:name database)})))
      (when-not dataset
        (throw (ex-info (tru "Card is not a model") {:status-code 400})))
      (when-let [persisted-info (persisted-info/turn-on-model! api/*current-user-id* card)]
        (task.persist-refresh/schedule-refresh-for-individual! persisted-info))
      api/generic-204-no-content)))

/:card-id/refresh

(api/defendpoint POST 
  "Refresh the persisted model caching `card-id`."
  [card-id]
  {card-id ms/PositiveInt}
  (api/let-404 [card           (t2/select-one Card :id card-id)
                persisted-info (t2/select-one PersistedInfo :card_id card-id)]
    (when (not (:dataset card))
      (throw (ex-info (trs "Cannot refresh a non-model question") {:status-code 400})))
    (when (:archived card)
      (throw (ex-info (trs "Cannot refresh an archived model") {:status-code 400})))
    (api/write-check (t2/select-one Database :id (:database_id persisted-info)))
    (task.persist-refresh/schedule-refresh-for-individual! persisted-info)
    api/generic-204-no-content))

/:card-id/unpersist

(api/defendpoint POST 
  "Unpersist this model. Deletes the persisted table backing the model and all queries after this will use the card's
  query rather than the saved version of the query."
  [card-id]
  {card-id ms/PositiveInt}
  (premium-features/assert-has-feature :cache-granular-controls (tru "Granular cache controls"))
  (api/let-404 [_card (t2/select-one Card :id card-id)]
    (api/let-404 [persisted-info (t2/select-one PersistedInfo :card_id card-id)]
      (api/write-check (t2/select-one Database :id (:database_id persisted-info)))
      (persisted-info/mark-for-pruning! {:id (:id persisted-info)} "off")
      api/generic-204-no-content)))

Get param values for the "old style" parameters. This mimic's the api/dashboard version except we don't have chain-filter issues or dashcards to worry about.

(defn mapping->field-values
  [card param query]
  (when-let [field-clause (params/param-target->field-clause (:target param) card)]
    (when-let [field-id (mbql.u/match-one field-clause [:field (id :guard integer?) _] id)]
      (api.field/search-values-from-field-id field-id query))))

Fetch values for a parameter that contain query. If query is nil or not provided, return all values.

The source of values could be: - static-list: user defined values list - card: values is result of running a card

(mu/defn param-values
  ([card param-key]
   (param-values card param-key nil))
  ([card      :- ms/Map
    param-key :- ms/NonBlankString
    query     :- [:maybe ms/NonBlankString]]
   (let [param (get (m/index-by :id (or (seq (:parameters card))
                                        ;; some older cards or cards in e2e just use the template tags on native queries
                                        (card/template-tag-parameters card)))
                    param-key)]
     (when-not param
       (throw (ex-info (tru "Card does not have a parameter with the ID {0}" (pr-str param-key))
                       {:status-code 400})))
     (custom-values/parameter->values param query (fn [] (mapping->field-values card param query))))))

/:card-id/params/:param-key/values

(api/defendpoint GET 
  "Fetch possible values of the parameter whose ID is `:param-key`.
    ;; fetch values for Card 1 parameter 'abc' that are possible
    GET /api/card/1/params/abc/values"
  [card-id param-key]
  {card-id   ms/PositiveInt
   param-key ms/NonBlankString}
  (param-values (api/read-check Card card-id) param-key))

/:card-id/params/:param-key/search/:query

(api/defendpoint GET 
  "Fetch possible values of the parameter whose ID is `:param-key` that contain `:query`.
    ;; fetch values for Card 1 parameter 'abc' that contain 'Orange';
     GET /api/card/1/params/abc/search/Orange
  Currently limited to first 1000 results."
  [card-id param-key query]
  {card-id   ms/PositiveInt
   param-key ms/NonBlankString
   query     ms/NonBlankString}
  (param-values (api/read-check Card card-id) param-key query))

This helper function exists to make testing the POST /api/card/from-csv endpoint easier.

(defn- from-csv!
  [{:keys [collection-id filename file]}]
  (try
    (let [model (upload/create-csv-upload! {:collection-id collection-id
                                            :filename      filename
                                            :file          file
                                            :schema-name   (public-settings/uploads-schema-name)
                                            :table-prefix  (public-settings/uploads-table-prefix)
                                            :db-id         (or (public-settings/uploads-database-id)
                                                               (throw (ex-info (tru "The uploads database is not configured.")
                                                                               {:status-code 422})))})]
      {:status 200
       :body   (:id model)})
    (catch Throwable e
      {:status (or (-> e ex-data :status-code)
                   500)
       :body   {:message (or (ex-message e)
                             (tru "There was an error uploading the file"))}})
    (finally (io/delete-file file :silently))))

/from-csv

(api/defendpoint ^:multipart POST 
  "Create a table and model populated with the values from the attached CSV. Returns the model ID if successful."
  [:as {raw-params :params}]
  ;; parse-long returns nil with "root" as the collection ID, which is what we want anyway
  (from-csv! {:collection-id (parse-long (get raw-params "collection_id"))
              :filename      (get-in raw-params ["file" :filename])
              :file          (get-in raw-params ["file" :tempfile])}))
(api/define-routes)
 

/api/collection endpoints. By default, these endpoints operate on Collections in the 'default' namespace, which is the namespace that has things like Dashboards and Cards. Other namespaces of Collections exist as well, such as the :snippet namespace, ('Snippet folders' in the UI). These namespaces are independent hierarchies. To use these endpoints for other Collections namespaces, you can pass the ?namespace= parameter (e.g., ?namespace=snippet).

(ns metabase.api.collection
  (:require
   [cheshire.core :as json]
   [clojure.string :as str]
   [compojure.core :refer [GET POST PUT]]
   [honey.sql.helpers :as sql.helpers]
   [malli.core :as mc]
   [malli.transform :as mtx]
   [medley.core :as m]
   [metabase.api.common :as api]
   [metabase.db :as mdb]
   [metabase.db.query :as mdb.query]
   [metabase.driver.common.parameters :as params]
   [metabase.driver.common.parameters.parse :as params.parse]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.models.card :as card :refer [Card]]
   [metabase.models.collection :as collection :refer [Collection]]
   [metabase.models.collection.graph :as graph]
   [metabase.models.collection.root :as collection.root]
   [metabase.models.dashboard :refer [Dashboard]]
   [metabase.models.interface :as mi]
   [metabase.models.native-query-snippet :refer [NativeQuerySnippet]]
   [metabase.models.permissions :as perms]
   [metabase.models.pulse :as pulse :refer [Pulse]]
   [metabase.models.revision.last-edit :as last-edit]
   [metabase.models.timeline :as timeline :refer [Timeline]]
   [metabase.public-settings.premium-features
    :as premium-features
    :refer [defenterprise]]
   [metabase.server.middleware.offset-paging :as mw.offset-paging]
   [metabase.util :as u]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

when alias defined for namespaced keywords is run through kondo macro, ns should be regarded as used

(comment collection.root/keep-me)
(declare root-collection)
(defn- remove-other-users-personal-collections
  [user-id collections]
  (let [personal-ids (into #{} (comp (filter :personal_owner_id)
                                     (remove (comp #{user-id} :personal_owner_id))
                                     (map :id))
                           collections)
        prefixes     (into #{} (map (fn [id] (format "/%d/" id))) personal-ids)
        personal?    (fn [{^String location :location id :id}]
                       (or (personal-ids id)
                           (prefixes (re-find #"^/\d+/" location))))]
    (if (seq prefixes)
      (remove personal? collections)
      collections)))

/

(api/defendpoint GET 
  "Fetch a list of all Collections that the current user has read permissions for (`:can_write` is returned as an
  additional property of each Collection so you can tell which of these you have write permissions for.)
  By default, this returns non-archived Collections, but instead you can show archived ones by passing
  `?archived=true`.
  By default, admin users will see all collections. To hide other user's collections pass in
  `?exclude-other-user-collections=true`."
  [archived exclude-other-user-collections namespace]
  {archived                       [:maybe ms/BooleanValue]
   exclude-other-user-collections [:maybe ms/BooleanValue]
   namespace                      [:maybe ms/NonBlankString]}
  (as-> (t2/select Collection
                   {:where    [:and
                               [:= :archived archived]
                               (perms/audit-namespace-clause :namespace namespace)
                               (collection/visible-collection-ids->honeysql-filter-clause
                                :id
                                (collection/permissions-set->visible-collection-ids @api/*current-user-permissions-set*))]
                              ;; Order NULL collection types first so that audit collections are last
                    :order-by [[[[:case [:= :type nil] 0 :else 1]] :asc]
                               [:%lower.name :asc]]}) collections
    ;; Remove other users' personal collections
    (if exclude-other-user-collections
      (remove-other-users-personal-collections api/*current-user-id* collections)
      collections)
    ;; include Root Collection at beginning or results if archived isn't `true`
    (if archived
      collections
      (let [root (root-collection namespace)]
        (cond->> collections
          (mi/can-read? root)
          (cons root))))
    (t2/hydrate collections :can_write :is_personal)
    ;; remove the :metabase.models.collection.root/is-root? tag since FE doesn't need it
    ;; and for personal collections we translate the name to user's locale
    (for [collection collections]
      (-> collection
          (dissoc ::collection.root/is-root?)
          collection/personal-collection-with-ui-details))))

Returns only a shallow Collection in the provided collection-id, e.g.

location: /1/ ``` [{:name "A" :location "/1/" :children 1} ... {:name "H" :location "/1/"}]

If the collection-id is nil, then we default to the root collection. ```

(defn- shallow-tree-from-collection-id
  [colls]
  (->> colls
       (map collection/personal-collection-with-ui-details)
       (collection/collections->tree nil)
       (map (fn [coll] (update coll :children #(boolean (seq %)))))))

Clause to restrict which collections are being selected based off collection-id. If collection-id is nil, then restrict to the children and the grandchildren of the root collection. If collection-id is an an integer, then restrict to that collection's parents and children.

(defn- location-from-collection-id-clause
  [collection-id]
  (if collection-id
    [:and
     [:like :location (str "%/" collection-id "/%")]
     [:not [:like :location (str "%/" collection-id "/%/%/%")]]]
    [:not [:like :location "/%/%/"]]))

Select collections based off certain parameters. If shallow is true, we select only the requested collection (or the root, if collection-id is nil) and its immediate children, to avoid reading the entire collection tree when it is not necessary.

(defn- select-collections
  [exclude-archived exclude-other-user-collections namespace shallow collection-id]
  (cond->>
   (t2/select Collection
              {:where [:and
                       (when exclude-archived
                         [:= :archived false])
                       (when shallow
                         (location-from-collection-id-clause collection-id))
                       (perms/audit-namespace-clause :namespace namespace)
                       (collection/visible-collection-ids->honeysql-filter-clause
                        :id
                        (collection/permissions-set->visible-collection-ids @api/*current-user-permissions-set*))]})
    exclude-other-user-collections (remove-other-users-personal-collections api/*current-user-id*)))

/tree

(api/defendpoint GET 
  "Similar to `GET /`, but returns Collections in a tree structure, e.g.
  ```
  [{:name     \"A\"
  :below    #{:card :dataset}
  :children [{:name \"B\"}
             {:name     \"C\"
              :here     #{:dataset :card}
              :below    #{:dataset :card}
              :children [{:name     \"D\"
                          :here     #{:dataset}
                          :children [{:name \"E\"}]}
                         {:name     \"F\"
                          :here     #{:card}
                          :children [{:name \"G\"}]}]}]}
  {:name \"H\"}]
  ```
  The here and below keys indicate the types of items at this particular level of the tree (here) and in its
  subtree (below)."
  [exclude-archived exclude-other-user-collections namespace shallow collection-id]
  {exclude-archived               [:maybe :boolean]
   exclude-other-user-collections [:maybe :boolean]
   namespace                      [:maybe ms/NonBlankString]
   shallow                        [:maybe :boolean]
   collection-id                  [:maybe ms/PositiveInt]}
  (let [collections (select-collections exclude-archived exclude-other-user-collections namespace shallow collection-id)]
    (if shallow
      (shallow-tree-from-collection-id collections)
      (let [collection-type-ids (reduce (fn [acc {:keys [collection_id dataset] :as _x}]
                                          (update acc (if dataset :dataset :card) conj collection_id))
                                        {:dataset #{}
                                         :card    #{}}
                                        (mdb.query/reducible-query {:select-distinct [:collection_id :dataset]
                                                                    :from            [:report_card]
                                                                    :where           [:= :archived false]}))
            collections-with-details (map collection/personal-collection-with-ui-details collections)]
        (collection/collections->tree collection-type-ids collections-with-details)))))

--------------------------------- Fetching a single Collection & its 'children' ----------------------------------

Valid values for the ?model= param accepted by endpoints in this namespace. no_models is for nilling out the set because a nil model set is actually the total model set

(def ^:private valid-model-param-values
  #{"card" "dataset" "collection" "dashboard" "pulse" "snippet" "no_models" "timeline"})
(def ^:private ModelString
  (into [:enum] valid-model-param-values))

This is basically a union type. [[api/defendpoint]] splits the string if it only gets one.

(def ^:private Models
  [:or
   [:sequential ModelString]
   ModelString])

Valid values for the ?pinned_state param accepted by endpoints in this namespace.

(def ^:private valid-pinned-state-values
  #{"all" "is_pinned" "is_not_pinned"})
(def ^:private valid-sort-columns #{"name" "last_edited_at" "last_edited_by" "model"})
(def ^:private valid-sort-directions #{"asc" "desc"})
(defn- normalize-sort-choice [w] (when w (keyword (str/replace w #"_" "-"))))
(def ^:private CollectionChildrenOptions
  [:map
   [:archived?                     :boolean]
   [:pinned-state {:optional true} [:maybe (into [:enum] (map keyword) valid-pinned-state-values)]]
   ;; when specified, only return results of this type.
   [:models       {:optional true} [:maybe [:set (into [:enum] (map keyword) valid-model-param-values)]]]
   [:sort-info    {:optional true} [:maybe [:tuple
                                            (into [:enum {:error/message "sort-columns"}]
                                                  (map normalize-sort-choice)
                                                  valid-sort-columns)
                                            (into [:enum {:error/message "sort-direction"}]
                                                  (map normalize-sort-choice)
                                                  valid-sort-directions)]]]])

Query that will fetch the 'children' of a collection, for different types of objects. Possible options are listed in the [[CollectionChildrenOptions]] schema above.

NOTES:

  • collection will be either a CollectionInstance, or the Root Collection special placeholder object, so do not use u/the-id on it! Use :id, which will return nil for the Root Collection, which is exactly what we want.

  • These queries will be combined into a union-all query. You do not need to put all of the columns into the query, any you don't select will be added in the correct position so the union will work (see all-select-columns for more details).

(defmulti ^:private collection-children-query
  {:arglists '([model collection options])}
  (fn [model _ _] (keyword model)))

TODO -- in Postgres and H2 at least I think we could just do true or false here... not sure about MySQL.

A Honey SQL expression that is always true.

1 = 1

(def ^:private always-true-hsql-expr
  [:= [:inline 1] [:inline 1]])

A Honey SQL expression that is never true.

1 = 2

(def ^:private always-false-hsql-expr
  [:= [:inline 1] [:inline 2]])
(defn- pinned-state->clause
  ([pinned-state]
   (pinned-state->clause pinned-state :collection_position))
  ([pinned-state col]
   (case pinned-state
     :all           always-true-hsql-expr
     :is_pinned     [:<> col nil]
     :is_not_pinned [:= col nil]
     always-true-hsql-expr)))

Poison a query to return no results when filtering to pinned items. Use for items that do not have a notion of pinning so that no results return when asking for pinned items.

(defn- poison-when-pinned-clause
  [pinned-state]
  (if (= pinned-state :is_pinned)
    always-false-hsql-expr
    always-true-hsql-expr))
(defmulti ^:private post-process-collection-children
  {:arglists '([model rows])}
  (fn [model _]
    (keyword model)))
(defmethod ^:private post-process-collection-children :default
  [_ rows]
  rows)
(defmethod collection-children-query :pulse
  [_ collection {:keys [archived? pinned-state]}]
  (-> {:select-distinct [:p.id
                         :p.name
                         :p.entity_id
                         :p.collection_position
                         [(h2x/literal "pulse") :model]]
       :from            [[:pulse :p]]
       :left-join       [[:pulse_card :pc] [:= :p.id :pc.pulse_id]]
       :where           [:and
                         [:= :p.collection_id      (:id collection)]
                         [:= :p.archived           (boolean archived?)]
                         ;; exclude alerts
                         [:= :p.alert_condition    nil]
                         ;; exclude dashboard subscriptions
                         [:= :p.dashboard_id nil]]}
      (sql.helpers/where (pinned-state->clause pinned-state :p.collection_position))))
(defmethod post-process-collection-children :pulse
  [_ rows]
  (for [row rows]
    (dissoc row
            :description :display :authority_level :moderated_status :icon :personal_owner_id
            :collection_preview :dataset_query)))

Collection children query for snippets on OSS. Returns all snippets regardless of collection, because snippet collections are an EE feature.

(defenterprise snippets-collection-children-query
  metabase-enterprise.snippet-collections.api.native-query-snippet
  [_ {:keys [archived?]}]
  {:select [:id :name :entity_id [(h2x/literal "snippet") :model]]
   :from   [[:native_query_snippet :nqs]]
   :where  [:= :archived (boolean archived?)]})
(defmethod collection-children-query :snippet
  [_ collection options]
  (snippets-collection-children-query collection options))
(defmethod collection-children-query :timeline
  [_ collection {:keys [archived? pinned-state]}]
  {:select [:id :name [(h2x/literal "timeline") :model] :description :entity_id :icon]
   :from   [[:timeline :timeline]]
   :where  [:and
            (poison-when-pinned-clause pinned-state)
            [:= :collection_id (:id collection)]
            [:= :archived (boolean archived?)]]})
(defmethod post-process-collection-children :timeline
  [_ rows]
  (for [row rows]
    (dissoc row
            :description :display :collection_position :authority_level :moderated_status
            :collection_preview :dataset_query)))
(defmethod post-process-collection-children :snippet
  [_ rows]
  (for [row rows]
    (dissoc row
            :description :collection_position :display :authority_level
            :moderated_status :icon :personal_owner_id :collection_preview
            :dataset_query)))
(defn- card-query [dataset? collection {:keys [archived? pinned-state]}]
  (-> {:select    (cond->
                    [:c.id :c.name :c.description :c.entity_id :c.collection_position :c.display :c.collection_preview
                     :c.dataset_query
                     [(h2x/literal (if dataset? "dataset" "card")) :model]
                     [:u.id :last_edit_user]
                     [:u.email :last_edit_email]
                     [:u.first_name :last_edit_first_name]
                     [:u.last_name :last_edit_last_name]
                     [:r.timestamp :last_edit_timestamp]
                     [{:select   [:status]
                       :from     [:moderation_review]
                       :where    [:and
                                  [:= :moderated_item_type "card"]
                                  [:= :moderated_item_id :c.id]
                                  [:= :most_recent true]]
                       ;; limit 1 to ensure that there is only one result but this invariant should hold true, just
                       ;; protecting against potential bugs
                       :order-by [[:id :desc]]
                       :limit    1}
                      :moderated_status]]
                    dataset?
                    (conj :c.database_id))
       :from      [[:report_card :c]]
       :left-join [[:revision :r] [:and
                                   [:= :r.model_id :c.id]
                                   [:= :r.most_recent true]
                                   [:= :r.model (h2x/literal "Card")]]
                   [:core_user :u] [:= :u.id :r.user_id]]
       :where     [:and
                   [:= :collection_id (:id collection)]
                   [:= :archived (boolean archived?)]
                   [:= :dataset dataset?]]}
      (sql.helpers/where (pinned-state->clause pinned-state))))
(defmethod collection-children-query :dataset
  [_ collection options]
  (card-query true collection options))
(defmethod post-process-collection-children :dataset
  [_ rows]
  (post-process-collection-children :card rows))
(defmethod collection-children-query :card
  [_ collection options]
  (card-query false collection options))

Decide if text, usually (a part of) a query, is fully parametrized given the parameter types described by template-tags (usually the template tags of a native query).

The rules to consider a piece of text fully parametrized is as follows:

  1. All parameters not in an optional block are field-filters or snippets or have a default value.
  2. All required parameters have a default value.

The first rule is absolutely necessary, as queries violating it cannot be executed without externally supplied parameter values. The second rule is more controversial, as field-filters outside of optional blocks ([[ ... ]]) don't prevent the query from being executed without external parameter values (neither do parameters in optional blocks). The rule has been added nonetheless, because marking a parameter as required is something the user does intentionally and queries that are technically executable without parameters can be unacceptably slow without the necessary constraints. (Marking parameters in optional blocks as required doesn't seem to be useful any way, but if the user said it is required, we honor this flag.)

(defn- fully-parametrized-text?
  [text template-tags]
  (try
    (let [obligatory-params (into #{}
                                  (comp (filter params/Param?)
                                        (map :k))
                                  (params.parse/parse text))]
      (and (every? #(or (#{:dimension :snippet} (:type %))
                        (:default %))
                   (map template-tags obligatory-params))
           (every? #(or (not (:required %))
                        (:default %))
                   (vals template-tags))))
    (catch clojure.lang.ExceptionInfo _
      ;; An exception might be thrown during parameter parsing if the syntax is invalid. In this case we return
      ;; true so that we still can try to generate a preview for the query and display an error.
      false)))
(defn- fully-parametrized-query? [row]
  (let [native-query (-> row :dataset_query json/parse-string mbql.normalize/normalize :native)]
    (if-let [template-tags (:template-tags native-query)]
      (fully-parametrized-text? (:query native-query) template-tags)
      true)))
(defn- post-process-card-row [row]
  (-> row
      (dissoc :authority_level :icon :personal_owner_id :dataset_query)
      (update :collection_preview api/bit->boolean)
      (assoc :fully_parametrized (fully-parametrized-query? row))))
(defmethod post-process-collection-children :card
  [_ rows]
  (map post-process-card-row rows))
(defn- dashboard-query [collection {:keys [archived? pinned-state]}]
  (-> {:select    [:d.id :d.name :d.description :d.entity_id :d.collection_position
                   [(h2x/literal "dashboard") :model]
                   [:u.id :last_edit_user]
                   [:u.email :last_edit_email]
                   [:u.first_name :last_edit_first_name]
                   [:u.last_name :last_edit_last_name]
                   [:r.timestamp :last_edit_timestamp]]
       :from      [[:report_dashboard :d]]
       :left-join [[:revision :r] [:and
                                   [:= :r.model_id :d.id]
                                   [:= :r.most_recent true]
                                   [:= :r.model (h2x/literal "Dashboard")]]
                   [:core_user :u] [:= :u.id :r.user_id]]
       :where     [:and
                   [:= :collection_id (:id collection)]
                   [:= :archived (boolean archived?)]]}
      (sql.helpers/where (pinned-state->clause pinned-state))))
(defmethod collection-children-query :dashboard
  [_ collection options]
  (dashboard-query collection options))
(defmethod post-process-collection-children :dashboard
  [_ rows]
  (map #(dissoc %
                :display :authority_level :moderated_status :icon :personal_owner_id :collection_preview
                :dataset_query)
       rows))

Clause to filter out snippet collections from the collection query on OSS instances, and instances without the snippet-collections. EE implementation returns nil, so as to not filter out snippet collections.

(defenterprise snippets-collection-filter-clause
  metabase-enterprise.snippet-collections.api.native-query-snippet
  []
  [:or
   [:= :namespace nil]
   [:not= :namespace (u/qualified-name "snippets")]])
(defn- collection-query
  [collection {:keys [archived? collection-namespace pinned-state]}]
  (-> (assoc (collection/effective-children-query
              collection
              [:= :archived archived?]
              (perms/audit-namespace-clause :namespace (u/qualified-name collection-namespace))
              (snippets-collection-filter-clause))
             ;; We get from the effective-children-query a normal set of columns selected:
             ;; want to make it fit the others to make UNION ALL work
             :select [:id
                      :name
                      :description
                      :entity_id
                      :personal_owner_id
                      [(h2x/literal "collection") :model]
                      :authority_level])
      ;; the nil indicates that collections are never pinned.
      (sql.helpers/where (pinned-state->clause pinned-state nil))))
(defmethod collection-children-query :collection
  [_ collection options]
  (collection-query collection options))
(defmethod post-process-collection-children :collection
  [_ rows]
  (letfn [(update-personal-collection [{:keys [personal_owner_id] :as row}]
            (if personal_owner_id
              ;; when fetching root collection, we might have personal collection
              (assoc row :name (collection/user->personal-collection-name (:personal_owner_id row) :user))
              (dissoc row :personal_owner_id)))]
    (for [row rows]
      ;; Go through this rigamarole instead of hydration because we
      ;; don't get models back from ulterior over-query
      ;; Previous examination with logging to DB says that there's no N+1 query for this.
      ;; However, this was only tested on H2 and Postgres
      (-> row
          (assoc :can_write (mi/can-write? Collection (:id row)))
          (dissoc :collection_position :display :moderated_status :icon
                  :collection_preview :dataset_query)
          update-personal-collection))))
(mu/defn ^:private coalesce-edit-info :- last-edit/MaybeAnnotated
  "Hoist all of the last edit information into a map under the key :last-edit-info. Considers this information present
  if `:last_edit_user` is not nil."
  [row]
  (letfn [(select-as [original k->k']
            (reduce (fn [m [k k']] (assoc m k' (get original k)))
                    {}
                    k->k'))]
    (let [mapping {:last_edit_user       :id
                   :last_edit_last_name  :last_name
                   :last_edit_first_name :first_name
                   :last_edit_email      :email
                   :last_edit_timestamp  :timestamp}]
      (cond-> (apply dissoc row :model_ranking (keys mapping))
        ;; don't use contains as they all have the key, we care about a value present
        (:last_edit_user row) (assoc :last-edit-info (select-as row mapping))))))

Post process any data. Have a chance to process all of the same type at once using post-process-collection-children. Must respect the order passed in.

(defn- post-process-rows
  [rows]
  (->> (map-indexed (fn [i row] (vary-meta row assoc ::index i)) rows) ;; keep db sort order
       (group-by :model)
       (into []
             (comp (map (fn [[model rows]]
                          (post-process-collection-children (keyword model) rows)))
                   cat
                   (map coalesce-edit-info)))
       (sort-by (comp ::index meta))))
(defn- model-name->toucan-model [model-name]
  (case (keyword model-name)
    :collection Collection
    :card       Card
    :dataset    Card
    :dashboard  Dashboard
    :pulse      Pulse
    :snippet    NativeQuerySnippet
    :timeline   Timeline))

Takes a honeysql select column and returns a keyword of which column it is.

eg: (select-name :id) -> :id (select-name [(literal "card") :model]) -> :model (select-name :p.id) -> :id

(defn- select-name
  [x]
  (if (vector? x)
    (recur (second x))
    (-> x name (str/split #"\.") peek keyword)))

All columns that need to be present for the union-all. Generated with the comment form below. Non-text columns that are optional (not id, but lastedituser for example) must have a type so that the union-all can unify the nil with the correct column type.

(def ^:private all-select-columns
  [:id :name :description :entity_id :display [:collection_preview :boolean] :dataset_query
   :model :collection_position :authority_level [:personal_owner_id :integer]
   :last_edit_email :last_edit_first_name :last_edit_last_name :moderated_status :icon
   [:last_edit_user :integer] [:last_edit_timestamp :timestamp] [:database_id :integer]])

Ensures that all necessary columns are in the select-columns collection, adding [nil :column] as necessary.

(defn- add-missing-columns
  [select-columns necessary-columns]
  (let [columns (m/index-by select-name select-columns)]
    (map (fn [col]
           (let [[col-name typpe] (u/one-or-many col)]
             (get columns col-name (if (and typpe (= (mdb/db-type) :postgres))
                                     [(h2x/cast typpe nil) col-name]
                                     [nil col-name]))))
         necessary-columns)))
(defn- add-model-ranking
  [select-clause model]
  (let [rankings {:dashboard  1
                  :pulse      2
                  :dataset    3
                  :card       4
                  :snippet    5
                  :collection 6
                  :timeline   7}]
    (conj select-clause [[:inline (get rankings model 100)]
                         :model_ranking])))
(comment
  ;; generate the set of columns across all child queries. Remember to add type info if not a text column
  (into []
        (comp cat (map select-name) (distinct))
        (for [model [:card :dashboard :snippet :pulse :collection :timeline]]
          (:select (collection-children-query model {:id 1 :location "/"} nil)))))

Given the client side sort-info, return sort clause to effect this. db-type is necessary due to complications from treatment of nulls in the different app db types.

(defn children-sort-clause
  [sort-info db-type]
  (case sort-info
    nil                     [[:%lower.name :asc]]
    [:name :asc]            [[:%lower.name :asc]]
    [:name :desc]           [[:%lower.name :desc]]
    [:last-edited-at :asc]  [(if (= db-type :mysql)
                               [:%isnull.last_edit_timestamp]
                               [:last_edit_timestamp :nulls-last])
                             [:last_edit_timestamp :asc]
                             [:%lower.name :asc]]
    [:last-edited-at :desc] (remove nil?
                                    [(case db-type
                                       :mysql    [:%isnull.last_edit_timestamp]
                                       :postgres [:last_edit_timestamp :desc-nulls-last]
                                       :h2       nil)
                                     [:last_edit_timestamp :desc]
                                     [:%lower.name :asc]])
    [:last-edited-by :asc]  [(if (= db-type :mysql)
                               [:%isnull.last_edit_last_name]
                               [:last_edit_last_name :nulls-last])
                             [:last_edit_last_name :asc]
                             (if (= db-type :mysql)
                               [:%isnull.last_edit_first_name]
                               [:last_edit_first_name :nulls-last])
                             [:last_edit_first_name :asc]
                             [:%lower.name :asc]]
    [:last-edited-by :desc] (remove nil?
                                    [(case db-type
                                       :mysql    [:%isnull.last_edit_last_name]
                                       :postgres [:last_edit_last_name :desc-nulls-last]
                                       :h2       nil)
                                     [:last_edit_last_name :desc]
                                     (case db-type
                                       :mysql    [:%isnull.last_edit_first_name]
                                       :postgres [:last_edit_last_name :desc-nulls-last]
                                       :h2       nil)
                                     [:last_edit_first_name :desc]
                                     [:%lower.name :asc]])
    [:model :asc]           [[:model_ranking :asc]  [:%lower.name :asc]]
    [:model :desc]          [[:model_ranking :desc] [:%lower.name :asc]]))
(defn- collection-children*
  [collection models {:keys [sort-info] :as options}]
  (let [sql-order   (children-sort-clause sort-info (mdb/db-type))
        models      (sort (map keyword models))
        queries     (for [model models
                          :let  [query              (collection-children-query model collection options)
                                 select-clause-type (some
                                                     (fn [k]
                                                       (when (get query k)
                                                         k))
                                                     [:select :select-distinct])]]
                      (-> query
                          (update select-clause-type add-missing-columns all-select-columns)
                          (update select-clause-type add-model-ranking model)))
        total-query {:select [[:%count.* :count]]
                     :from   [[{:union-all queries} :dummy_alias]]}
        rows-query  {:select   [:*]
                     :from     [[{:union-all queries} :dummy_alias]]
                     :order-by sql-order}
        ;; We didn't implement collection pagination for snippets namespace for root/items
        ;; Rip out the limit for now and put it back in when we want it
        limit-query (if (or
                         (nil? mw.offset-paging/*limit*)
                         (nil? mw.offset-paging/*offset*)
                         (= (:collection-namespace options) "snippets"))
                      rows-query
                      (assoc rows-query
                             :limit  mw.offset-paging/*limit*
                             :offset mw.offset-paging/*offset*))
        res         {:total  (->> (mdb.query/query total-query) first :count)
                     :data   (->> (mdb.query/query limit-query) post-process-rows)
                     :models models}
        limit-res   (assoc res
                           :limit  mw.offset-paging/*limit*
                           :offset mw.offset-paging/*offset*)]
    (if (= (:collection-namespace options) "snippets")
      res
      limit-res)))

Fetch a sequence of 'child' objects belonging to a Collection, filtered using options.

(mu/defn ^:private collection-children
  [{collection-namespace :namespace, :as collection} :- collection/CollectionWithLocationAndIDOrRoot
   {:keys [models], :as options}                     :- CollectionChildrenOptions]
  (let [valid-models (for [model-kw [:collection :dataset :card :dashboard :pulse :snippet :timeline]
                           ;; only fetch models that are specified by the `model` param; or everything if it's empty
                           :when    (or (empty? models) (contains? models model-kw))
                           :let     [toucan-model       (model-name->toucan-model model-kw)
                                     allowed-namespaces (collection/allowed-namespaces toucan-model)]
                           :when    (or (= model-kw :collection)
                                        (contains? allowed-namespaces (keyword collection-namespace)))]
                       model-kw)]
    (if (seq valid-models)
      (collection-children* collection valid-models (assoc options :collection-namespace collection-namespace))
      {:total  0
       :data   []
       :limit  mw.offset-paging/*limit*
       :offset mw.offset-paging/*offset*
       :models valid-models})))

Add a standard set of details to collection, including things like effective_location. Works for either a normal Collection or the Root Collection.

(mu/defn ^:private collection-detail
  [collection :- collection/CollectionWithLocationAndIDOrRoot]
  (-> collection
      collection/personal-collection-with-ui-details
      (t2/hydrate :parent_id :effective_location [:effective_ancestors :can_write] :can_write :is_personal)))

/:id

(api/defendpoint GET 
  "Fetch a specific Collection with standard details added"
  [id]
  {id ms/PositiveInt}
  (collection-detail (api/read-check Collection id)))

/root/timelines

(api/defendpoint GET 
  "Fetch the root Collection's timelines."
  [include archived]
  {include  [:maybe [:= "events"]]
   archived [:maybe :boolean]}
  (timeline/timelines-for-collection nil {:timeline/events?   (= include "events")
                                          :timeline/archived? archived}))

/:id/timelines

(api/defendpoint GET 
  "Fetch a specific Collection's timelines."
  [id include archived]
  {id       ms/PositiveInt
   include  [:maybe [:= "events"]]
   archived [:maybe :boolean]}
  (timeline/timelines-for-collection id {:timeline/events?   (= include "events")
                                         :timeline/archived? archived}))

/:id/items

(api/defendpoint GET 
  "Fetch a specific Collection's items with the following options:
  *  `models` - only include objects of a specific set of `models`. If unspecified, returns objects of all models
  *  `archived` - when `true`, return archived objects *instead* of unarchived ones. Defaults to `false`.
  *  `pinned_state` - when `is_pinned`, return pinned objects only.
                   when `is_not_pinned`, return non pinned objects only.
                   when `all`, return everything. By default returns everything"
  [id models archived pinned_state sort_column sort_direction]
  {id             ms/PositiveInt
   models         [:maybe Models]
   archived       [:maybe ms/BooleanString]
   pinned_state   [:maybe (into [:enum] valid-pinned-state-values)]
   sort_column    [:maybe (into [:enum] valid-sort-columns)]
   sort_direction [:maybe (into [:enum] valid-sort-directions)]}
  (let [model-kwds (set (map keyword (u/one-or-many models)))]
    (collection-children (api/read-check Collection id)
                         {:models       model-kwds
                          :archived?    (Boolean/parseBoolean archived)
                          :pinned-state (keyword pinned_state)
                          :sort-info    [(or (some-> sort_column normalize-sort-choice) :name)
                                         (or (some-> sort_direction normalize-sort-choice) :asc)]})))

-------------------------------------------- GET /api/collection/root --------------------------------------------

(defn- root-collection [collection-namespace]
  (collection-detail (collection/root-collection-with-ui-details collection-namespace)))

/root

(api/defendpoint GET 
  "Return the 'Root' Collection object with standard details added"
  [namespace]
  {namespace [:maybe ms/NonBlankString]}
  (-> (root-collection namespace)
      (api/read-check)
      (dissoc ::collection.root/is-root?)))

If you pass in explicitly keywords that you can't see, you can't see them. But there is an exception for the collections, because you might not be able to see the top-level collections but be able to see, children of those invisible top-level collections.

(defn- visible-model-kwds
  [root-collection model-set]
  (if (mi/can-read? root-collection)
    model-set
    (if (or (empty? model-set) (contains? model-set :collection))
      #{:collection}
      #{:no_models})))

/root/items

(api/defendpoint GET 
  "Fetch objects that the current user should see at their root level. As mentioned elsewhere, the 'Root' Collection
  doesn't actually exist as a row in the application DB: it's simply a virtual Collection where things with no
  `collection_id` exist. It does, however, have its own set of Permissions.
  This endpoint will actually show objects with no `collection_id` for Users that have Root Collection
  permissions, but for people without Root Collection perms, we'll just show the objects that have an effective
  location of `/`.
  This endpoint is intended to power a 'Root Folder View' for the Current User, so regardless you'll see all the
  top-level objects you're allowed to access.
  By default, this will show the 'normal' Collections namespace; to view a different Collections namespace, such as
  `snippets`, you can pass the `?namespace=` parameter."
  [models archived namespace pinned_state sort_column sort_direction]
  {models         [:maybe Models]
   archived       [:maybe ms/BooleanString]
   namespace      [:maybe ms/NonBlankString]
   pinned_state   [:maybe (into [:enum] valid-pinned-state-values)]
   sort_column    [:maybe (into [:enum] valid-sort-columns)]
   sort_direction [:maybe (into [:enum] valid-sort-directions)]}
  ;; Return collection contents, including Collections that have an effective location of being in the Root
  ;; Collection for the Current User.
  (let [root-collection (assoc collection/root-collection :namespace namespace)
        model-set       (set (map keyword (u/one-or-many models)))
        model-kwds      (visible-model-kwds root-collection model-set)]
    (collection-children
     root-collection
     {:models       model-kwds
      :archived?    (Boolean/parseBoolean archived)
      :pinned-state (keyword pinned_state)
      :sort-info    [(or (some-> sort_column normalize-sort-choice) :name)
                     (or (some-> sort_direction normalize-sort-choice) :asc)]})))

----------------------------------------- Creating/Editing a Collection ------------------------------------------

Check that you're allowed to write Collection with collection-id; if collection-id is nil, check that you have Root Collection perms.

(defn- write-check-collection-or-root-collection
  [collection-id collection-namespace]
  (api/write-check (if collection-id
                     (t2/select-one Collection :id collection-id)
                     (cond-> collection/root-collection
                       collection-namespace (assoc :namespace collection-namespace)))))

Create a new collection.

(defn create-collection!
  [{:keys [name description parent_id namespace authority_level]}]
  ;; To create a new collection, you need write perms for the location you are going to be putting it in...
  (write-check-collection-or-root-collection parent_id namespace)
  (when (some? authority_level)
    ;; make sure only admin and an EE token is present to be able to create an Official token
    (premium-features/assert-has-feature :official-collections (tru "Official Collections"))
    (api/check-superuser))
  ;; Now create the new Collection :)
  (first
    (t2/insert-returning-instances!
      Collection
      (merge
        {:name        name
         :description description
         :authority_level authority_level
         :namespace   namespace}
        (when parent_id
          {:location (collection/children-location (t2/select-one [Collection :location :id] :id parent_id))})))))

/

(api/defendpoint POST 
  "Create a new Collection."
  [:as {{:keys [name description parent_id namespace authority_level] :as body} :body}]
  {name            ms/NonBlankString
   description     [:maybe ms/NonBlankString]
   parent_id       [:maybe ms/PositiveInt]
   namespace       [:maybe ms/NonBlankString]
   authority_level [:maybe collection/AuthorityLevel]}
  (create-collection! body))

If input the PUT /api/collection/:id endpoint (collection-updates) specify that we should move a Collection, do appropriate permissions checks and move it (and its descendants).

TODO - I'm not 100% sure it makes sense that moving a Collection requires a special call to move-collection!, while archiving is handled automatically as part of the pre-update logic when you change a Collection's archived value. They are both recursive operations; couldn't we just have moving happen automatically when you change a :location as well?

(defn- move-collection-if-needed!
  [collection-before-update collection-updates]
  ;; is a [new] parent_id update specified in the PUT request?
  (when (contains? collection-updates :parent_id)
    (let [orig-location (:location collection-before-update)
          new-parent-id (:parent_id collection-updates)
          new-parent    (if new-parent-id
                          (t2/select-one [Collection :location :id] :id new-parent-id)
                          collection/root-collection)
          new-location  (collection/children-location new-parent)]
      ;; check and make sure we're actually supposed to be moving something
      (when (not= orig-location new-location)
        ;; ok, make sure we have perms to do this operation
        (api/check-403
         (perms/set-has-full-permissions-for-set? @api/*current-user-permissions-set*
           (collection/perms-for-moving collection-before-update new-parent)))
        ;; ok, we're good to move!
        (collection/move-collection! collection-before-update new-location)))))

If input the PUT /api/collection/:id endpoint (collection-updates) specify that we should change the archived status of a Collection, do appropriate permissions checks. (Actual recurisve (un)archiving logic is handled by Collection's pre-update, so we do not need to manually call collection/archive-collection! and the like in this namespace.)

(defn- check-allowed-to-archive-or-unarchive
  [collection-before-update collection-updates]
  (when (api/column-will-change? :archived collection-before-update collection-updates)
    ;; Check that we have approprate perms
    (api/check-403
     (perms/set-has-full-permissions-for-set? @api/*current-user-permissions-set*
       (collection/perms-for-archiving collection-before-update)))))

When a collection is archived, all of it's cards are also marked as archived, but this is down in the model layer which will not cause the archive notification code to fire. This will delete the relevant alerts and notify the users just as if they had be archived individually via the card API.

(defn- maybe-send-archived-notifications!
  [& {:keys [collection-before-update collection-updates actor]}]
  (when (api/column-will-change? :archived collection-before-update collection-updates)
    (when-let [alerts (seq (pulse/retrieve-alerts-for-cards
                            {:card-ids (t2/select-pks-set Card :collection_id (u/the-id collection-before-update))}))]
      (card/delete-alert-and-notify-archived! {:alerts alerts :actor actor}))))

/:id

(api/defendpoint PUT 
  "Modify an existing Collection, including archiving or unarchiving it, or moving it."
  [id, :as {{:keys [name description archived parent_id authority_level], :as collection-updates} :body}]
  {id              ms/PositiveInt
   name            [:maybe ms/NonBlankString]
   description     [:maybe ms/NonBlankString]
   archived        [:maybe ms/BooleanValue]
   parent_id       [:maybe ms/PositiveInt]
   authority_level [:maybe collection/AuthorityLevel]}
  ;; do we have perms to edit this Collection?
  (let [collection-before-update (api/write-check Collection id)]
    ;; if we're trying to *archive* the Collection, make sure we're allowed to do that
    (check-allowed-to-archive-or-unarchive collection-before-update collection-updates)
    ;; if authority_level is changing, make sure we're allowed to do that
    (when (and (contains? collection-updates :authority_level)
               (not= (keyword authority_level) (:authority_level collection-before-update)))
      (premium-features/assert-has-feature :official-collections (tru "Official Collections"))
      (api/check-403 (and api/*is-superuser?*
                          ;; pre-update of model checks if the collection is a personal collection and rejects changes
                          ;; to authority_level, but it doesn't check if it is a sub-collection of a personal one so we add that
                          ;; here
                          (not (collection/is-personal-collection-or-descendant-of-one? collection-before-update)))))
    ;; ok, go ahead and update it! Only update keys that were specified in the `body`. But not `parent_id` since
    ;; that's not actually a property of Collection, and since we handle moving a Collection separately below.
    (let [updates (u/select-keys-when collection-updates :present [:name :description :archived :authority_level])]
      (when (seq updates)
        (t2/update! Collection id updates)))
    ;; if we're trying to *move* the Collection (instead or as well) go ahead and do that
    (move-collection-if-needed! collection-before-update collection-updates)
    ;; if we *did* end up archiving this Collection, we most post a few notifications
    (maybe-send-archived-notifications! {:collection-before-update collection-before-update
                                         :collection-updates       collection-updates
                                         :actor                    @api/*current-user*}))
  ;; finally, return the updated object
  (collection-detail (t2/select-one Collection :id id)))

------------------------------------------------ GRAPH ENDPOINTS -------------------------------------------------

/graph

(api/defendpoint GET 
  "Fetch a graph of all Collection Permissions."
  [namespace]
  {namespace [:maybe ms/NonBlankString]}
  (api/check-superuser)
  (graph/graph namespace))

an id for a [[Collection]].

(def CollectionID 
  [pos-int? {:title "Collection ID"}])

an id for a [[PermissionsGroup]].

(def GroupID 
  [pos-int? {:title "Group ID"}])

Malli enum for what sort of collection permissions we have. (:write :read or :none)

(def CollectionPermissions
  [:and keyword? [:enum :write :read :none]])

Map describing permissions for a (Group x Collection)

(def GroupPermissionsGraph
  [:map-of
   [:or
    ;; We need the [:and keyword ...] piece to make decoding "root" work. There's a merged fix for this, but it hasn't
    ;; been released as of malli 0.9.2. When the malli version gets bumped, we should remove this.
    [:and keyword? [:= :root]]
    CollectionID]
   CollectionPermissions])

Map describing permissions for 1 or more groups. Revision # is used for consistency

(def PermissionsGraph
  [:map
   [:revision int?]
   [:groups [:map-of GroupID GroupPermissionsGraph]]])

Building it this way is a lot faster then calling mc/decode

(def ^:private graph-decoder
  (mc/decoder PermissionsGraph (mtx/string-transformer)))
(defn- decode-graph [permission-graph]
  ;; TODO: should use a coercer for this?
  (graph-decoder permission-graph))

/graph

(api/defendpoint PUT 
  "Do a batch update of Collections Permissions by passing in a modified graph.
  Will overwrite parts of the graph that are present in the request, and leave the rest unchanged."
  [:as {{:keys [namespace], :as body} :body}]
  {body      :map
   namespace [:maybe ms/NonBlankString]}
  (api/check-superuser)
  (->> (dissoc body :namespace)
       decode-graph
       (graph/update-graph! namespace))
  (graph/graph namespace))
(api/define-routes)
 

API Endpoints at Metabase

We use a custom macro called defendpoint for defining all endpoints. It's best illustrated with an example:


(ns metabase.api.dashboard ...)

(api/defendpoint GET "/"
 "Get `Dashboards`. With filter option `f`..."
 [f]
 {f [:maybe [:enum "all" "mine" "archived"]]}
 (let ...))

 ; ...

(api/define-routes)

As you can see, the arguments are:

  • The HTTP verb. (GET, PUT, POST, etc)
  • The route. This will automatically have api and the namespace prefixed to it, so in this case "/" is defining the route for /api/dashboard/.
  • A docstring. Apart from being helpful to us, this is used for API documentation for third-party devs, so please be thorough!
  • A schema. This uses Malli's vector syntax. This is documented on Malli's page, of course, but we also have some of our own schemas defined. Start by looking in metabase.util.malli.schema
  • The parameters. This uses Compojure's destructuring syntax (a superset of Clojure's normal destructuring syntax).
  • The actual code for the endpoint. The returned value could be one of several types. The Right Thing (such as converting to JSON or setting an appropriate status code) usually happens by default. Consult Compojure's documentation, but it may be more instructive to look at examples in our codebase.

Dynamic variables and utility functions/macros for writing API functions.

(ns metabase.api.common
  (:require
   [clojure.set :as set]
   [clojure.spec.alpha :as s]
   [clojure.string :as str]
   [compojure.core :as compojure]
   [medley.core :as m]
   [metabase.api.common.internal
    :refer [add-route-param-schema
            auto-coerce
            route-dox
            validate-params
            route-fn-name
            wrap-response-if-needed]]
   [metabase.config :as config]
   [metabase.events :as events]
   [metabase.models.interface :as mi]
   [metabase.util :as u]
   [metabase.util.i18n :as i18n :refer [deferred-tru tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [ring.middleware.multipart-params :as mp]
   [toucan2.core :as t2]))
(declare check-403 check-404)

----------------------------------------------- DYNAMIC VARIABLES ------------------------------------------------ These get bound by middleware for each HTTP request.

Int ID or nil of user associated with current API call.

(def ^:dynamic ^Integer *current-user-id*
  nil)

Delay that returns the User (or nil) associated with the current API call. ex. @*current-user*

(def ^:dynamic *current-user*
  (atom nil)) ; default binding is just something that will return nil when dereferenced

Is the current user a superuser?

(def ^:dynamic ^Boolean *is-superuser?*
  false)

Is the current user a group manager of at least one group?

(def ^:dynamic ^Boolean *is-group-manager?*
  false)

Delay to the set of permissions granted to the current user. See documentation in [[metabase.models.permissions]] for more information about the Metabase permissions system.

(def ^:dynamic *current-user-permissions-set*
  (atom #{}))

---------------------------------------- Precondition checking helper fns ----------------------------------------

(defn- check-one [condition code message]
  (when-not condition
    (let [[message info] (if (and (map? message)
                                  (not (i18n/localized-string? message)))
                           [(:message message) message]
                           [message])]
      (throw (ex-info (str message) (assoc info :status-code code)))))
  condition)

Assertion mechanism for use inside API functions. Checks that test is true, or throws an ExceptionInfo with status-code and message.

message can be either a plain string error message, or a map including the key :message and any additional details, such as an :error_code.

This exception is automatically caught in the body of defendpoint functions, and the appropriate HTTP response is generated.

check can be called with the form

(check test code message)

or with the form

(check test [code message])

You can also include multiple tests in a single call:

(check test1 code1 message1 test2 code2 message2)

(defn check
  {:style/indent 1, :arglists '([condition [code message] & more] [condition code message & more])}
  [condition & args]
  (let [[code message & more] (if (sequential? (first args))
                                (concat (first args) (rest args))
                                args)]
    (check-one condition code message)
    (if (seq more)
      (recur (first more) (rest more))
      condition)))

Check that object with ID (or other key/values) exists in the DB, or throw a 404.

(defn check-exists?
  ([entity id]
   (check-exists? entity :id id))
  ([entity k v & more]
   (check-404 (apply t2/exists? entity k v more))))

Check that *current-user* is a superuser or throw a 403. This doesn't require a DB call.

(defn check-superuser
  []
  (check-403 *is-superuser?*))

checkp- functions: as in "check param". These functions expect that you pass a symbol so they can throw exceptions w/ relevant error messages.

Throw an ExceptionInfo that contains information about an invalid API params in the expected format.

(defn throw-invalid-param-exception
  [field-name message]
  (throw (ex-info (tru "Invalid field: {0}" field-name)
           {:status-code 400
            :errors      {(keyword field-name) message}})))

Assertion mechanism for use inside API functions that validates individual input params. Checks that test is true, or throws an ExceptionInfo with field-name and message.

This exception is automatically caught in the body of defendpoint functions, and the appropriate HTTP response is generated.

checkp can be called with the form

(checkp test field-name message)
(defn checkp
  {:style/indent 1}
  ([tst field-name message]
   (when-not tst
     (throw-invalid-param-exception (str field-name) message))))

---------------------------------------------- api-let, api->, etc. ----------------------------------------------

The following all work exactly like the corresponding Clojure versions but take an additional arg at the beginning called RESPONSE-PAIR. RESPONSE-PAIR is of the form [status-code message]. ex.

(let [binding x] ...) -> (api-let [500 \"Not OK!\"] [binding x] ...)

If test is true, bind it to binding and evaluate body. Intended for internal use only by macros such as let-400 below.

(api-let [404 "Not found."] [user @current-user] (:id user))

(defmacro do-api-let
  [response-pair bindings & body]
  ;; so `response-pair` doesn't get evaluated more than once
  (let [response-pair-symb (gensym "response-pair-")]
    `(let [~response-pair-symb ~response-pair
           ~@(vec (apply concat (for [[binding test] (partition-all 2 bindings)]
                                  [binding `(check ~test ~response-pair-symb)])))]
       ~@body)))

GENERIC RESPONSE HELPERS

These are basically the same as the api- versions but with RESPONSE-PAIR already bound

GENERIC 400 RESPONSE HELPERS

(def ^:private generic-400
  [400 (deferred-tru "Invalid Request.")])

Throw a 400 if arg is false or nil, otherwise return as-is.

(defn check-400
  [arg]
  (check arg generic-400))

GENERIC 404 RESPONSE HELPERS

(def ^:private generic-404
  [404 (deferred-tru "Not found.")])

Throw a 404 if arg is false or nil, otherwise return as-is.

(defn check-404
  [arg]
  (check arg generic-404))

Bind a form as with let; throw a 404 if it is nil or false.

(defmacro let-404
  {:style/indent 1}
  [bindings & body]
  `(do-api-let ~generic-404 ~bindings ~@body))

GENERIC 403 RESPONSE HELPERS

If you can't be bothered to write a custom error message

(defn- generic-403 []
  [403 (tru "You don''t have permissions to do that.")])

Throw a 403 (no permissions) if arg is false or nil, otherwise return as-is.

(defn check-403
  [arg]
  (check arg (generic-403)))

Throw a generic 403 (no permissions) error response.

(defn throw-403
  ([]
   (throw-403 nil))
  ([e]
   (throw (ex-info (tru "You don''t have permissions to do that.") {:status-code 403} e))))

GENERIC 500 RESPONSE HELPERS

For when you don't feel like writing something useful

(def ^:private generic-500
  [500 (deferred-tru "Internal server error.")])

Throw a 500 if arg is false or nil, otherwise return as-is.

(defn check-500
  [arg]
  (check arg generic-500))

A 'No Content' response for DELETE endpoints to return.

(def generic-204-no-content
  {:status 204, :body nil})

--------------------------------------- DEFENDPOINT AND RELATED FUNCTIONS ----------------------------------------

(s/def ::defendpoint-args
  (s/cat
   :method      symbol?
   :route       (some-fn string? sequential?)
   :docstr      (s/? string?)
   :args        vector?
   :arg->schema (s/? (s/map-of symbol? any?)) ;; any? is either a plumatic or malli schema
   :body        (s/* any?)))
(defn- parse-defendpoint-args [args]
  (let [parsed (s/conform ::defendpoint-args args)]
    (when (= parsed ::s/invalid)
      (throw (ex-info (str "Invalid defendpoint args: " (s/explain-str ::defendpoint-args args))
                      (s/explain-data ::defendpoint-args args))))
    (let [{:keys [method route docstr args arg->schema body]} parsed
          fn-name                                             (route-fn-name method route)
          route                                               (add-route-param-schema arg->schema route)
          ;; eval the vals in arg->schema to make sure the actual schemas are resolved so we can document
          ;; their API error messages
          docstr                                              (route-dox method route docstr args
                                                                               (m/map-vals #_{:clj-kondo/ignore [:discouraged-var]} eval arg->schema)
                                                                               body)]
      ;; Don't i18n this, it's dev-facing only
      (when-not docstr
        (log/warn (u/format-color 'red "Warning: endpoint %s/%s does not have a docstring. Go add one."
                                  (ns-name *ns*) fn-name)))
      (assoc parsed :fn-name fn-name, :route route, :docstr docstr))))

Log a warning if the request body contains any parameters not included in expected-params (which is presumably populated by the defendpoint schema)

(defn validate-param-values
  [{method :request-method uri :uri body :body} expected-params]
  (when (and (not config/is-prod?)
             (map? body))
    (let [extraneous-params (set/difference (set (keys body))
                                            (set expected-params))]
      (when (seq extraneous-params)
        (log/warnf "Unexpected parameters at %s: %s\nPlease add them to the schema or remove them from the API client"
                   [method uri] (vec extraneous-params))))))

Convert Compojure-style HTTP method symbols (PUT, POST, etc.) to the keywords used internally by Compojure (:put, :post, ...)

(defn method-symbol->keyword
  [method-symbol]
  (-> method-symbol
      name
      u/lower-case-en
      keyword))

Impl macro for [[defendpoint]]; don't use this directly.

(defmacro defendpoint*
  [{:keys [method route fn-name docstr args body arg->schema]}]
  {:pre [(or (string? route) (vector? route))]}
  (let [method-kw       (method-symbol->keyword method)
        allowed-params  (mapv keyword (keys arg->schema))
        prep-route      #'compojure/prepare-route
        multipart?      (get (meta method) :multipart false)
        handler-wrapper (if multipart? mp/wrap-multipart-params identity)]
    `(def ~(vary-meta fn-name
                      assoc
                      :doc          docstr
                      :is-endpoint? true)
       ;; The next form is a copy of `compojure/compile-route`, with the sole addition of the call to
       ;; `validate-param-values`. This is because to validate the request body we need to intercept the request
       ;; before the destructuring takes place. I.e., we need to validate the value of `(:body request#)`, and that's
       ;; not available if we called `compile-route` ourselves.
       (compojure/make-route
        ~method-kw
        ~(prep-route route)
        (~handler-wrapper
         (fn [request#]
           (validate-param-values request# (quote ~allowed-params))
           (compojure/let-request [~args request#]
                                  ~@body)))))))

Define an API function. This automatically does several things:

  • converts route from a simple form like "/:id" to a regex-typed one like ["/:id" :id #"[0-9]+"] based on its malli schema

  • sequentially applies specified annotation functions on args to validate them.

  • automatically calls wrap-response-if-needed on the result of body

  • tags function's metadata in a way that subsequent calls to define-routes (see below) will automatically include the function in the generated defroutes form.

  • Generates a super-sophisticated Markdown-formatted docstring

(defmacro defendpoint
  {:arglists '([method route docstr? args schemas-map? & body])}
  [& defendpoint-args]
  (let [{:keys [args body arg->schema], :as defendpoint-args} (parse-defendpoint-args defendpoint-args)]
    `(defendpoint* ~(assoc defendpoint-args
                           :body `((auto-coerce ~args ~arg->schema
                                                ~@(validate-params arg->schema)
                                                (wrap-response-if-needed
                                                 (do ~@body))))))))

Like defendpoint, but generates an endpoint that accepts the usual [request respond raise] params.

(defmacro defendpoint-async
  {:arglists '([method route docstr? args schemas-map? & body])}
  [& defendpoint-args]
  (let [{:keys [args body arg->schema], :as defendpoint-args} (parse-defendpoint-args defendpoint-args)]
    `(defendpoint* ~(assoc defendpoint-args
                           :args []
                           :body `((fn ~args
                                     ~@(validate-params arg->schema)
                                     ~@body))))))

Return a sequence of all API endpoint functions defined by defendpoint in a namespace.

(defn- namespace->api-route-fns
  [nmspace]
  (for [[_symb varr] (ns-publics nmspace)
        :when       (:is-endpoint? (meta varr))]
    varr))
(defn- api-routes-docstring [nmspace route-fns middleware]
  (str
   (format "Ring routes for %s:\n%s"
           (-> (ns-name nmspace)
               (str/replace #"^metabase\." )
               (str/replace #"\." "/"))
           (u/pprint-to-str route-fns))
   (when (seq middleware)
     (str "\nMiddleware applied to all endpoints in this namespace:\n"
          (u/pprint-to-str middleware)))))

Create a (defroutes routes ...) form that automatically includes all functions created with defendpoint in the current namespace. Optionally specify middleware that will apply to all of the endpoints in the current namespace.

(api/define-routes api/+check-superuser) ; all API endpoints in this namespace will require superuser access

(defmacro define-routes
  {:style/indent 0}
  [& middleware]
  (let [api-route-fns (namespace->api-route-fns *ns*)
        routes        `(compojure/routes ~@api-route-fns)
        docstring     (str "Routes for " *ns*)]
    `(def ~(vary-meta 'routes assoc :doc (api-routes-docstring *ns* api-route-fns middleware))
       ~docstring
       ~(if (seq middleware)
          `(-> ~routes ~@middleware)
          routes))))

Wrap a Ring handler to make sure the current user is a superuser before handling any requests.

(api/+check-superuser routes)

(defn +check-superuser
  [handler]
  (fn
    ([request]
     (check-superuser)
     (handler request))
    ([request respond raise]
     (if-let [e (try
                  (check-superuser)
                  nil
                  (catch Throwable e
                    e))]
       (raise e)
       (handler request respond raise)))))

---------------------------------------- PERMISSIONS CHECKING HELPER FNS -----------------------------------------

Check whether we can read an existing obj, or entity with id. If the object doesn't exist, throw a 404; if we don't have proper permissions, throw a 403. This will fetch the object if it was not already fetched, and returns obj if the check is successful.

(defn read-check
  {:style/indent 2}
  ([obj]
   (check-404 obj)
   (try
     (check-403 (mi/can-read? obj))
     (catch clojure.lang.ExceptionInfo e
       (events/publish-event! :event/read-permission-failure {:user-id    *current-user-id*
                                                              :object     obj
                                                              :has-access false})
       (throw e)))
   obj)
  ([entity id]
   (read-check (t2/select-one entity :id id)))
  ([entity id & other-conditions]
   (read-check (apply t2/select-one entity :id id other-conditions))))

Check whether we can write an existing OBJ, or ENTITY with ID. If the object doesn't exist, throw a 404; if we don't have proper permissions, throw a 403. This will fetch the object if it was not already fetched, and returns OBJ if the check is successful.

(defn write-check
  {:style/indent 2}
  ([obj]
   (check-404 obj)
   (try
     (check-403 (mi/can-write? obj))
     (catch clojure.lang.ExceptionInfo e
       (events/publish-event! :event/write-permission-failure {:user-id *current-user-id*
                                                               :object obj})
       (throw e)))
   obj)
  ([entity id]
   (write-check (t2/select-one entity :id id)))
  ([entity id & other-conditions]
   (write-check (apply t2/select-one entity :id id other-conditions))))

NEW! Check whether the current user has permissions to CREATE a new instance of an object with properties in map m.

This function was added years after read-check and write-check, and at the time of this writing most models do not implement this method. Most POST API endpoints instead have the can-create? logic for a given model hardcoded into them -- this should be considered an antipattern and be refactored out going forward.

(defn create-check
  {:added "0.32.0", :style/indent 2}
  [entity m]
  (try
    (check-403 (mi/can-create? entity m))
    (catch clojure.lang.ExceptionInfo e
      (events/publish-event! :event/create-permission-failure {:model entity
                                                               :user-id *current-user-id*})
      (throw e))))

NEW! Check whether the current user has permissions to UPDATE an object by applying a map of changes.

This function was added years after read-check and write-check, and at the time of this writing most models do not implement this method. Most PUT API endpoints instead have the can-update? logic for a given model hardcoded into them -- this should be considered an antipattern and be refactored out going forward.

(defn update-check
  {:added "0.36.0", :style/indent 2}
  [instance changes]
  (try
    (check-403 (mi/can-update? instance changes))
    (catch clojure.lang.ExceptionInfo e
      (events/publish-event! :event/update-permission-failure {:user-id *current-user-id*
                                                               :object instance})
      (throw e))))

------------------------------------------------ OTHER HELPER FNS ------------------------------------------------

Check that the object exists and is not :archived, or throw a 404. Returns object as-is if check passes.

(defn check-not-archived
  [object]
  (u/prog1 object
    (check-404 object)
    (check (not (:archived object))
      [404 {:message (tru "The object has been archived."), :error_code "archived"}])))

Check on paginated stuff that, if the limit exists, the offset exists, and vice versa.

(defn check-valid-page-params
  [limit offset]
  (check (not (and limit (not offset))) [400 (tru "When including a limit, an offset must also be included.")])
  (check (not (and offset (not limit))) [400 (tru "When including an offset, a limit must also be included.")]))
(mu/defn column-will-change? :- :boolean
  "Helper for PATCH-style operations to see if a column is set to change when `object-updates` (i.e., the input to the
  endpoint) is applied.
    ;; assuming we have a Collection 10, that is not currently archived...
    (api/column-will-change? :archived (t2/select-one Collection :id 10) {:archived true}) ; -> true, because value will change
    (api/column-will-change? :archived (t2/select-one Collection :id 10) {:archived false}) ; -> false, because value did not change
    (api/column-will-change? :archived (t2/select-one Collection :id 10) {}) ; -> false; value not specified in updates (request body)"
  [k :- :keyword object-before-updates :- :map object-updates :- :map]
  (boolean
   (and (contains? object-updates k)
        (not= (get object-before-updates k)
              (get object-updates k)))))

------------------------------------------ COLLECTION POSITION HELPER FNS ----------------------------------------

Compare old-position and new-position to determine what needs to be updated based on the position change. Used for fixing card/dashboard/pulse changes that impact other instances in the collection

(mu/defn reconcile-position-for-collection!
  [collection-id :- [:maybe ms/PositiveInt]
   old-position  :- [:maybe ms/PositiveInt]
   new-position  :- [:maybe ms/PositiveInt]]
  (let [update-fn! (fn [plus-or-minus position-update-clause]
                     (doseq [model '[Card Dashboard Pulse]]
                       (t2/update! model {:collection_id       collection-id
                                          :collection_position position-update-clause}
                                   {:collection_position [plus-or-minus :collection_position 1]})))]
    (when (not= new-position old-position)
      (cond
        (and (nil? new-position)
             old-position)
        (update-fn! :-  [:> old-position])
        (and new-position (nil? old-position))
        (update-fn! :+ [:>= new-position])
        (> new-position old-position)
        (update-fn! :- [:between old-position new-position])
        (< new-position old-position)
        (update-fn! :+ [:between new-position old-position])))))

Intended to cover Cards/Dashboards/Pulses, it only asserts collection id and position, allowing extra keys

(def ^:private ModelWithPosition
  [:map
   [:collection_id       [:maybe ms/PositiveInt]]
   [:collection_position [:maybe ms/PositiveInt]]])

Intended to cover Cards/Dashboards/Pulses updates. Collection id and position are optional, if they are not present, they didn't change. If they are present, they might have changed and we need to compare.

(def ^:private ModelWithOptionalPosition
  [:map
   [:collection_id       {:optional true} [:maybe ms/PositiveInt]]
   [:collection_position {:optional true} [:maybe ms/PositiveInt]]])

Generic function for working on cards/dashboards/pulses. Checks the before and after changes to see if there is any impact to the collection position of that model instance. If so, executes updates to fix the collection position that goes with the change. The 2-arg version of this function is used for a new card/dashboard/pulse (i.e. not updating an existing instance, but creating a new one).

(mu/defn maybe-reconcile-collection-position!
  ([new-model-data :- ModelWithPosition]
   (maybe-reconcile-collection-position! nil new-model-data))
  ([{old-collection-id :collection_id, old-position :collection_position, :as _before-update} :- [:maybe ModelWithPosition]
    {new-collection-id :collection_id, new-position :collection_position, :as model-updates} :- ModelWithOptionalPosition]
   (let [updated-collection? (and (contains? model-updates :collection_id)
                                  (not= old-collection-id new-collection-id))
         updated-position?   (and (contains? model-updates :collection_position)
                                  (not= old-position new-position))]
     (cond
       ;; If the collection hasn't changed, but we have a new collection position, we might need to reconcile
       (and (not updated-collection?) updated-position?)
       (reconcile-position-for-collection! old-collection-id old-position new-position)
       ;; If we have a new collection id, but no new position, reconcile the old collection, then update the new
       ;; collection with the existing position
       (and updated-collection? (not updated-position?))
       (do
         (reconcile-position-for-collection! old-collection-id old-position nil)
         (reconcile-position-for-collection! new-collection-id nil old-position))
       ;; We have a new collection id AND and new collection position
       ;; Update the old collection using the old position
       ;; Update the new collection using the new position
       (and updated-collection? updated-position?)
       (do
         (reconcile-position-for-collection! old-collection-id old-position nil)
         (reconcile-position-for-collection! new-collection-id nil new-position))))))

------------------------------------------ PARAM PARSING FNS ----------------------------------------

Coerce a bit returned by some MySQL/MariaDB versions in some situations to Boolean.

(defn bit->boolean
  [v]
  (if (number? v)
    (not (zero? v))
    v))

Parse a param that could have a single value or multiple values using parse-fn. Always return a vector.

Used for API that can parse single value or multiple values for a param: e.g: single value: api/card/series?exclude_ids=1 multi values: api/card/series?excludeids=1&excludeids=2

Example usage: (parse-multi-values-param "1" parse-long) => [1]

(parse-multi-values-param ["1" "2"] parse-long) => [1, 2]

(defn parse-multi-values-param
  [xs parse-fn]
  (if (sequential? xs)
    (map parse-fn xs)
    [(parse-fn xs)]))
 

Internal functions used by metabase.api.common. These are primarily used as the internal implementation of defendpoint.

(ns metabase.api.common.internal
  (:require
   [clojure.string :as str]
   [clojure.walk :as walk]
   [colorize.core :as colorize]
   [malli.core :as mc]
   [malli.error :as me]
   [malli.transform :as mtx]
   [metabase.async.streaming-response :as streaming-response]
   [metabase.config :as config]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.describe :as umd]
   [metabase.util.malli.schema :as ms]
   [potemkin.types :as p.types])
  (:import
   (metabase.async.streaming_response StreamingResponse)))
(set! *warn-on-reflection* true)
(comment streaming-response/keep-me)

+----------------------------------------------------------------------------------------------------------------+ | DOCSTRING GENERATION | +----------------------------------------------------------------------------------------------------------------+

Generate a string like GET /api/meta/db/:id for a defendpoint route.

(defn- endpoint-name
  ([method route]
   (endpoint-name *ns* method route))
  ([endpoint-namespace method route]
   (format "%s %s%s"
           (name method)
           (-> (.getName (the-ns endpoint-namespace))
               (str/replace #"^metabase\.api\." "/api/")
               ;; HACK to make sure some enterprise endpoints are consistent with the code.
               ;; The right way to fix this is to move them -- see #22687
               ;; /api/ee/sandbox/table -> /api/table, this is an override route for /api/table if sandbox is available
               (str/replace #"^metabase-enterprise\.sandbox\.api\.table" "/api/table")
               ;; /api/ee/sandbox -> /api/mt
               (str/replace #"^metabase-enterprise\.sandbox\.api\." "/api/mt/")
               ;; /api/ee/content-verification -> /api/moderation-review
               (str/replace #"^metabase-enterprise\.content-verification\.api\." "/api/moderation-review/")
               ;; /api/ee/sso/sso/ -> /auth/sso
               (str/replace #"^metabase-enterprise\.sso\.api\." "/auth/")
               ;; this should be only the replace for enterprise once we resolved #22687
               (str/replace #"^metabase-enterprise\.([^\.]+)\.api\." "/api/ee/$1/"))
           (if (vector? route)
             (first route)
             route))))

A version of flatten that will actually flatten a form such as:

[id :as {{:keys [datasetquery description display name visualizationsettings]} :body}]

(defn- args-form-flatten
  [form]
  (cond
    (map? form) (args-form-flatten (mapcat (fn [[k v]]
                                             [(args-form-flatten k) (args-form-flatten v)])
                                           form))
    (sequential? form) (mapcat args-form-flatten form)
    :else       [form]))

Return a map of arg -> nil for args taken from the arguments vector. This map is merged with the ones found in the schema validation map to build a complete map of args used by the endpoint.

(defn- args-form-symbols
  [form]
  (into {} (for [arg   (args-form-flatten form)
                 :when (and (symbol? arg)
                            (not= arg 'body))]
             {arg nil})))

Generate the docstring for schema for use in auto-generated API documentation.

(defn- dox-for-schema
  [schema route-str]
  (try (umd/describe schema)
       (catch Exception _
         (ex-data
          (when (and schema config/is-dev?) ;; schema is nil for any var without a schema. That's ok!
            (log/warn
             (u/format-color 'red (str "Invalid Malli Schema: %s defined at %s")
                             (u/pprint-to-str schema)
                             (u/add-period route-str)))))
         "")))

Return the appropriate name for this param-symb based on its schema. Usually this is just the name of the param-symb, but if the schema used a call to su/api-param we;ll use that name instead.

(defn- param-name
  [param-symb schema]
  (or (when (record? schema)
        (:api-param-name schema))
      (name param-symb)))

Generate the params section of the documentation for a defendpoint-defined function by using the param-symb->schema map passed in after the argslist.

(defn- format-route-schema-dox
  [param-symb->schema route-str]
  ;; these are here
  (when (seq param-symb->schema)
    (str "\n\n### PARAMS:\n\n"
         (str/join "\n\n"
                   (for [[param-symb schema] param-symb->schema]
                     (format "*  **`%s`** %s"
                             (param-name param-symb schema)
                             (dox-for-schema schema route-str)))))))

Return a markdown-formatted string to be used as documentation for a defendpoint function.

(defn- format-route-dox
  [route-str docstr param->schema]
  (str (format "## `%s`" route-str)
       (when (seq docstr)
         (str "\n\n" (u/add-period docstr)))
       (format-route-schema-dox param->schema route-str)))

Does the BODY of this defendpoint form contain a call to check-superuser?

(defn- contains-superuser-check?
  [body]
  (let [body (set body)]
    (or (contains? body '(check-superuser))
        (contains? body '(api/check-superuser)))))

Prints a markdown route doc for defendpoint

(defn route-dox
  [method route docstr args param->schema body]
  (format-route-dox (endpoint-name method route)
                    (str (u/add-period docstr) (when (contains-superuser-check? body)
                                                 "\n\nYou must be a superuser to do this."))
                    (merge (args-form-symbols args)
                           param->schema)))

+----------------------------------------------------------------------------------------------------------------+ | AUTO-PARSING + ROUTE TYPING | +----------------------------------------------------------------------------------------------------------------+

Parse value (presumabily a string) as an Integer, or throw a 400 exception. Used to automatically to parse id parameters in defendpoint functions.

(defn parse-int
  [^String value]
  (try (Integer/parseInt value)
       (catch NumberFormatException _
         (throw (ex-info (tru "Not a valid integer: ''{0}''" value) {:status-code 400})))))

Map of param-type -> map with the following keys:

:route-param-regex Regex pattern that should be used for params in Compojure route forms :parser Function that should be used to parse args

(def ^:dynamic *auto-parse-types*
  {:int  {:route-param-regex #"[0-9]+"
          :parser            'metabase.api.common.internal/parse-int}
   :uuid {:route-param-regex u/uuid-regex
          :parser            nil}})

Sequence of [param-pattern parse-type] pairs. A param with name matching PARAM-PATTERN should be considered to be of AUTO-PARSE-TYPE.

(def ^:private ^:const  auto-parse-arg-name-patterns
  [[#"^uuid$"       :uuid]
   [#"^session_id$" :uuid]
   [#"^[\w-_]*id$"  :int]])

Return a key into *auto-parse-types* if arg has a matching pattern in auto-parse-arg-name-patterns.

(arg-type :id) -> :int

(defn arg-type
  [arg]
  (some (fn [[pattern type]]
          (when (re-find pattern (name arg))
            type))
        auto-parse-arg-name-patterns))

TYPIFY-ROUTE

If keyword arg has a matching type, return a pair like [arg route-param-regex], where route-param-regex is the regex that this param that arg must match.

(route-param-regex :id) -> [:id #"[0-9]+"]

(defn route-param-regex
  [arg]
  (some->> (arg-type arg)
           *auto-parse-types*
           :route-param-regex
           (vector arg)))

Return a sequence of keywords for URL args in string route.

(route-arg-keywords "/:id/cards") -> [:id]

(defn route-arg-keywords
  [route]
  (->> (re-seq #":([\w-]+)" route)
       (map second)
       (map keyword)))

Note: this is called in a macro context, so it can potentially be passed a symbol that evaluates to a schema.

(defn- ->matching-regex
  [schema]
  (let [schema-type (try (mc/type schema)
                         (catch clojure.lang.ExceptionInfo _
                           (mc/type #_:clj-kondo/ignore (eval schema))))]
    [schema-type
     (condp = schema-type
       ;; can use any regex directly
       :re (first (try (mc/children schema)
                       (catch clojure.lang.ExceptionInfo _
                         (mc/children #_:clj-kondo/ignore (eval schema)))))
       :keyword #"[\S]+"
       'pos-int? #"[0-9]+"
       :int #"-?[0-9]+"
       'int? #"-?[0-9]+"
       :uuid u/uuid-regex
       'uuid? u/uuid-regex
       nil)]))
(def ^:private no-regex-schemas #{(mc/type ms/NonBlankString)
                                  (mc/type (mc/schema [:maybe ms/PositiveInt]))
                                  (mc/type [:enum "a" "b"])
                                  :fn
                                  :string})

Expand a route string like "/:id" into a Compojure route form with regexes to match parameters based on malli schemas given in the arg->schema map.

(add-route-param-schema '{id :int} "/:id/card") -> ["/:id/card" :id #"[0-9]+"] (add-route-param-schema {} "/:id/card") -> "/:id/card"

(defn add-route-param-schema
  [arg->schema route]
  (if (vector? route)
    route
    (let [[wildcard & wildcards]
          (->> (for [[k schema] arg->schema
                     :when      (re-find (re-pattern (str ":" k)) route)
                     :let       [[schema-type re] (->matching-regex schema)]]
                 (if re
                   [route (keyword k) re]
                   (when (and config/is-dev? (not (contains? no-regex-schemas schema-type)))
                     (let [overview (str "Warning: missing route-param regex for schema: "
                                         route " " [k schema])
                           fix      (str "Either add `" (pr-str schema-type) "` to "
                                         "metabase.api.common.internal/->matching-regex or "
                                         "metabase.api.common.internal/no-regex-schemas.")]
                       (log/warn (colorize/red overview))
                       (log/warn (colorize/green fix))))))
               (remove nil?))]
      (cond
        ;; multiple hits -> tack them onto the original route shape.
        wildcards (vec (reduce into wildcard (mapv #(drop 1 %) wildcards)))
        wildcard  wildcard
        :else     route))))

ROUTE ARG AUTO PARSING

Given an arg-symbol like id, return a pair like [id (Integer/parseInt id)] that can be used in a let form.

(defn let-form-for-arg
  [arg-symbol]
  (when (symbol? arg-symbol)
    (some-> (arg-type arg-symbol)                                     ; :int
            *auto-parse-types*                                        ; {:parser ... }
            :parser                                                   ; Integer/parseInt
            ((fn [parser] `(when ~arg-symbol (~parser ~arg-symbol)))) ; (when id (Integer/parseInt id))
            ((partial vector arg-symbol)))))                          ; [id (Integer/parseInt id)]

Create a let form that applies corresponding parse-fn for any symbols in args that are present in *auto-parse-types*.

(defmacro auto-parse
  {:style/indent 1}
  [args & body]
  (let [let-forms (->> args
                       (mapcat let-form-for-arg)
                       (filter identity))]
    `(let [~@let-forms]
       ~@body)))

+----------------------------------------------------------------------------------------------------------------+ | AUTO-COERCION | +----------------------------------------------------------------------------------------------------------------+

Transformer used on values coming over the API via defendpoint.

(def defendpoint-transformer
  (mtx/transformer
   (mtx/string-transformer)
   (mtx/json-transformer)))
(defn- extract-symbols [in]
  (let [*symbols (atom [])]
    (walk/postwalk
     (fn [x] (when (symbol? x) (swap! *symbols conj x)) x)
     in)
    @*symbols))
(defn- mauto-let-form [arg->schema arg-symbol]
  (when arg->schema
    (when-let [schema (arg->schema arg-symbol)]
      `[~arg-symbol (mc/decode ~schema ~arg-symbol defendpoint-transformer)])))

Create a let form that tries to coerce the value bound to any symbol in args that are present in arg->schema using [[defendpoint-transformer]].

(defmacro auto-coerce
  {:style/indent 1}
  [args arg->schema & body]
  (let [let-forms (->> args
                       extract-symbols
                       (mapcat #(mauto-let-form arg->schema %))
                       (remove nil?))]
    `(let [~@let-forms] ~@body)))

+----------------------------------------------------------------------------------------------------------------+ | PARAM VALIDATION | +----------------------------------------------------------------------------------------------------------------+

Validate a parameter against its respective malli schema, or throw an Exception.

(defn validate-param
  [field-name value schema]
  (when-not (mc/validate schema value)
    (throw (ex-info (tru "Invalid m field: {0}" field-name)
                    {:status-code 400
                     :errors      {(keyword field-name) (umd/describe schema)}
                     :specific-errors {(keyword field-name)
                                       (-> schema
                                           (mc/explain value)
                                           me/with-spell-checking
                                           (me/humanize {:wrap mu/humanize-include-value}))}}))))

Generate a series of validate-param calls for each param and malli schema pair in PARAM->SCHEMA.

(defn validate-params
  [param->schema]
  (for [[param schema] param->schema]
    `(validate-param '~param ~param ~schema)))

+----------------------------------------------------------------------------------------------------------------+ | MISC. OTHER FNS USED BY DEFENDPOINT | +----------------------------------------------------------------------------------------------------------------+

Generate a symbol suitable for use as the name of an API endpoint fn. Name is just method + route with slashes replaced by underscores.

(route-fn-name GET "/:id") ;-> GET_:id

(defn route-fn-name
  [method route]
  ;; if we were passed a vector like [":id" :id #"[0-9+]"] only use first part
  (let [route (if (vector? route) (first route) route)]
    (-> (str (name method) route)
        (^String .replace "/" "_")
        symbol)))

Protocol for transformations that should be done to the value returned by a defendpoint form before it Compojure/Ring see it.

(p.types/defprotocol+ EndpointResponse
  (wrap-response-if-needed [this]
    "Transform the value returned by a `defendpoint` form as needed, e.g. by adding `:status` and `:body`."))
(extend-protocol EndpointResponse
  Object
  (wrap-response-if-needed [this]
    {:status 200, :body this})

  nil
  (wrap-response-if-needed [_]
    {:status 204, :body nil})

  StreamingResponse
  (wrap-response-if-needed [this]
    this)

  clojure.lang.IPersistentMap
  (wrap-response-if-needed [m]
    (if (and (:status m) (contains? m :body))
      m
      {:status 200, :body m})))
 
(ns metabase.api.common.validation
  (:require
   [clojure.string :as str]
   [metabase.api.common :as api]
   [metabase.config :as config]
   [metabase.embed.settings :as embed.settings]
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings :as public-settings]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.util.i18n :refer [tru]]))

TODO: figure out what other functions to move here from metabase.api.common

Check that the public-sharing-enabled Setting is true, or throw a 400.

(defn check-public-sharing-enabled
  []
  (api/check (public-settings/enable-public-sharing)
             [400 (tru "Public sharing is not enabled.")]))

Is embedding of Cards or Objects (secured access via /api/embed endpoints with a signed JWT enabled?

(defn check-embedding-enabled
  []
  (api/check (embed.settings/enable-embedding)
             [400 (tru "Embedding is not enabled.")]))

If advanced-permissions is enabled, check *current-user* has application permission of type perm-type. Set require-superuser? to true to perform a superuser check when advanced-permissions is disabled.

(defn check-has-application-permission
  ([perm-type]
   (check-has-application-permission perm-type true))
  ([perm-type require-superuser?]
   (if-let [f (and (premium-features/enable-advanced-permissions?)
                   (resolve 'metabase-enterprise.advanced-permissions.common/current-user-has-application-permissions?))]
     (api/check-403 (f perm-type))
     (when require-superuser?
       (api/check-superuser)))))

Check if advanced permissions is enabled to use permission types such as :group-manager or :application-permissions.

(defn check-advanced-permissions-enabled
  [perm-type]
  (api/check (premium-features/enable-advanced-permissions?)
             [402 (tru "The {0} permissions functionality is only enabled if you have a premium token with the advanced-permissions feature."
                       (str/replace (name perm-type) "-" " "))]))

If advanced-permissions is enabled, check is *current-user* a manager of at least one group. Set require-superuser? to false to disable superuser checks if advanced-permissions is not enabled.

(defn check-group-manager
  ([]
   (check-group-manager true))
  ([require-superuser?]
   (if (premium-features/enable-advanced-permissions?)
     (api/check-403 (or api/*is-superuser?* api/*is-group-manager?*))
     (when require-superuser?
       (api/check-superuser)))))

If advanced-permissions is enabled, check is *current-user* is manager of group-or-id. Set require-superuser? to false to disable superuser checks if advanced-permissions is not enabled.

(defn check-manager-of-group
  ([group-or-id]
   (check-manager-of-group group-or-id true))
  ([group-or-id require-superuser?]
   (when config/ee-available?
     (classloader/require 'metabase-enterprise.advanced-permissions.common))
   (if-let [f (and (premium-features/enable-advanced-permissions?)
                   (resolve 'metabase-enterprise.advanced-permissions.common/current-user-is-manager-of-group?))]
     (api/check-403 (or api/*is-superuser?* (f group-or-id)))
     (when require-superuser?
       (api/check-superuser)))))
 

/api/dashboard endpoints.

(ns metabase.api.dashboard
  (:require
   [cheshire.core :as json]
   [clojure.set :as set]
   [compojure.core :refer [DELETE GET POST PUT]]
   [medley.core :as m]
   [metabase.actions.execution :as actions.execution]
   [metabase.analytics.snowplow :as snowplow]
   [metabase.api.common :as api]
   [metabase.api.common.validation :as validation]
   [metabase.api.dataset :as api.dataset]
   [metabase.automagic-dashboards.populate :as populate]
   [metabase.events :as events]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.action :as action]
   [metabase.models.card :as card :refer [Card]]
   [metabase.models.collection :as collection]
   [metabase.models.collection.root :as collection.root]
   [metabase.models.dashboard :as dashboard :refer [Dashboard]]
   [metabase.models.dashboard-card :as dashboard-card :refer [DashboardCard]]
   [metabase.models.dashboard-tab :as dashboard-tab]
   [metabase.models.field :refer [Field]]
   [metabase.models.interface :as mi]
   [metabase.models.params :as params]
   [metabase.models.params.chain-filter :as chain-filter]
   [metabase.models.params.custom-values :as custom-values]
   [metabase.models.query :as query :refer [Query]]
   [metabase.models.query.permissions :as query-perms]
   [metabase.models.revision :as revision]
   [metabase.models.revision.last-edit :as last-edit]
   [metabase.models.table :refer [Table]]
   [metabase.query-processor.dashboard :as qp.dashboard]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.middleware.constraints :as qp.constraints]
   [metabase.query-processor.middleware.permissions :as qp.perms]
   [metabase.query-processor.pivot :as qp.pivot]
   [metabase.query-processor.util :as qp.util]
   [metabase.related :as related]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [steffan-westcott.clj-otel.api.trace.span :as span]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

Get dashboard details for the complete dashboard, including tabs, dashcards, params, etc.

(defn- hydrate-dashboard-details
  [{dashboard-id :id :as dashboard}]
  ;; I'm a bit worried that this is an n+1 situation here. The cards can be batch hydrated i think because they
  ;; have a hydration key and an id. moderation_reviews currently aren't batch hydrated but i'm worried they
  ;; cannot be in this situation
  (span/with-span!
    {:name       "hydrate-dashboard-details"
     :attributes {:dashboard/id dashboard-id}}
    (t2/hydrate dashboard [:dashcards
                           [:card [:moderation_reviews :moderator_details]]
                           [:card :can_write]
                           :series
                           :dashcard/action
                           :dashcard/linkcard-info]
                :tabs
                :collection_authority_level
                :can_write
                :param_fields
                :param_values
                [:collection :is_personal])))

/

(api/defendpoint POST 
  "Create a new Dashboard."
  [:as {{:keys [name description parameters cache_ttl collection_id collection_position], :as _dashboard} :body}]
  {name                ms/NonBlankString
   parameters          [:maybe [:sequential ms/Parameter]]
   description         [:maybe :string]
   cache_ttl           [:maybe ms/PositiveInt]
   collection_id       [:maybe ms/PositiveInt]
   collection_position [:maybe ms/PositiveInt]}
  ;; if we're trying to save the new dashboard in a Collection make sure we have permissions to do that
  (collection/check-write-perms-for-collection collection_id)
  (let [dashboard-data {:name                name
                        :description         description
                        :parameters          (or parameters [])
                        :creator_id          api/*current-user-id*
                        :cache_ttl           cache_ttl
                        :collection_id       collection_id
                        :collection_position collection_position}
        dash           (t2/with-transaction [_conn]
                        ;; Adding a new dashboard at `collection_position` could cause other dashboards in this collection to change
                        ;; position, check that and fix up if needed
                        (api/maybe-reconcile-collection-position! dashboard-data)
                        ;; Ok, now save the Dashboard
                        (first (t2/insert-returning-instances! :model/Dashboard dashboard-data)))]
    (events/publish-event! :event/dashboard-create {:object dash :user-id api/*current-user-id*})
    (snowplow/track-event! ::snowplow/dashboard-created api/*current-user-id* {:dashboard-id (u/the-id dash)})
    (-> dash
        hydrate-dashboard-details
        collection.root/hydrate-root-collection
        (assoc :last-edit-info (last-edit/edit-information-for-user @api/*current-user*)))))

-------------------------------------------- Hiding Unreadable Cards ---------------------------------------------

If CARD is unreadable, replace it with an object containing only its :id.

(defn- hide-unreadable-card
  [card]
  (when card
    (if (mi/can-read? card)
      card
      (select-keys card [:id]))))

Replace the :card and :series entries from dashcards that they user isn't allowed to read with empty objects.

(defn- hide-unreadable-cards
  [dashboard]
  (update dashboard :dashcards (fn [dashcards]
                                 (vec (for [dashcard dashcards]
                                        (-> dashcard
                                            (update :card hide-unreadable-card)
                                            (update :series (partial mapv hide-unreadable-card))))))))

------------------------------------------ Query Average Duration Info -------------------------------------------

Adding the average execution time to all of the Cards in a Dashboard efficiently is somewhat involved. There are a few things that make this tricky:

  1. Queries are usually executed with :constraints that different from how they're actually defined, but not always. This means we should look up hashes for both the query as-is and for the query with default-query-constraints and use whichever one we find

  2. The structure of DashCards themselves is complicated. It has a top-level :card property and (optionally) a sequence of additional Cards under :series

  3. Query hashes are byte arrays, and two identical byte arrays aren't equal to each other in Java; thus they don't work as one would expect when being used as map keys

Here's an overview of the approach used to efficiently add the info:

  1. Build a sequence of query hashes (both as-is and with default constraints) for every card and series in the dashboard cards

  2. Fetch all matching entries from Query in the DB and build a map of hash (converted to a Clojure vector) -> average execution time

  3. Iterate back over each card and look for matching entries in the hash-vec->avg-time for either the normal hash or the hash with default constraints, and add the result as :average_execution_time

Return a tuple of possible hashes that would be associated with executions of CARD. The first is the hash of the query dictionary as-is; the second is one with the default-query-constraints, which is how it will most likely be run.

(defn- card->query-hashes
  [{:keys [dataset_query]}]
  (u/ignore-exceptions
    [(qp.util/query-hash dataset_query)
     (qp.util/query-hash (assoc dataset_query :constraints (qp.constraints/default-query-constraints)))]))

Return a sequence of all the query hashes for this dashcard, including the top-level Card and any Series.

(defn- dashcard->query-hashes
  [{:keys [card series]}]
  (reduce concat
          (card->query-hashes card)
          (for [card series]
            (card->query-hashes card))))

Return a sequence of all the query hashes used in a dashcards.

(defn- dashcards->query-hashes
  [dashcards]
  (apply concat (for [dashcard dashcards]
                  (dashcard->query-hashes dashcard))))

Given some query hashes, return a map of hashes (as normal Clojure vectors) to the average query durations. (The hashes are represented as normal Clojure vectors because identical byte arrays aren't considered equal to one another, and thus do not work as one would expect when used as map keys.)

(defn- hashes->hash-vec->avg-time
  [hashes]
  (when (seq hashes)
    (into {} (for [[k v] (t2/select-fn->fn :query_hash :average_execution_time Query :query_hash [:in hashes])]
               {(vec k) v}))))

Add :query_average_duration info to a card (i.e., the :card property of a DashCard or an entry in its :series array).

(defn- add-query-average-duration-to-card
  [card hash-vec->avg-time]
  (assoc card :query_average_duration (some (fn [query-hash]
                                              (hash-vec->avg-time (vec query-hash)))
                                            (card->query-hashes card))))

Add :query_average_duration to the top-level Card and any Series in a sequence of dashcards.

(defn- add-query-average-duration-to-dashcards
  ([dashcards]
   (add-query-average-duration-to-dashcards dashcards (hashes->hash-vec->avg-time (dashcards->query-hashes dashcards))))
  ([dashcards hash-vec->avg-time]
   (for [dashcard dashcards]
     (-> dashcard
         (update :card   add-query-average-duration-to-card hash-vec->avg-time)
         (update :series (fn [series]
                           (for [card series]
                             (add-query-average-duration-to-card card hash-vec->avg-time))))))))

Add a average_execution_time field to each card (and series) belonging to dashboard.

(defn add-query-average-durations
  [dashboard]
  (update dashboard :dashcards add-query-average-duration-to-dashcards))

Get Dashboard with ID.

(defn- get-dashboard
  [id]
  (span/with-span!
    {:name       "get-dashboard"
     :attributes {:dashboard/id id}}
    (-> (t2/select-one :model/Dashboard :id id)
        api/read-check
        hydrate-dashboard-details
        collection.root/hydrate-root-collection
        api/check-not-archived
        hide-unreadable-cards
        add-query-average-durations)))

Returns a map of which cards we need to copy and which are not to be copied. The :copy key is a map from id to card. The :discard key is a vector of cards which were not copied due to permissions.

(defn- cards-to-copy
  [dashcards]
  (letfn [(split-cards [{:keys [card series] :as db-card}]
            (cond
              (nil? (:card_id db-card)) ; text card
              {}
              ;; cards without permissions are just a map with an :id from [[hide-unreadable-card]]
              (not (mi/model card))
              {:retain nil, :discard (into [card] series)}
              (mi/can-read? card)
              (let [{writable true unwritable false} (group-by (comp boolean mi/can-read?)
                                                               series)]
                {:retain (into [card] writable), :discard unwritable})
              ;; if you can't write the base, we don't have anywhere to put the series
              :else
              {:discard (into [card] series)}))]
    (reduce (fn [acc db-card]
              (let [{:keys [retain discard]} (split-cards db-card)]
                (-> acc
                    (update :copy merge (m/index-by :id retain))
                    (update :discard concat discard))))
            {:copy {}
             :discard []}
            dashcards)))

Takes a dashboard id, and duplicates the cards both on the dashboard's cards and dashcardseries. Returns a map of {:copied {old-card-id duplicated-card} :uncopied [card]} so that the new dashboard can adjust accordingly.

(defn- duplicate-cards
  [dashboard dest-coll-id]
  (let [same-collection? (= (:collection_id dashboard) dest-coll-id)
        {:keys [copy discard]} (cards-to-copy (:dashcards dashboard))]
    (reduce (fn [m [id card]]
              (assoc-in m
                        [:copied id]
                        (if (:dataset card)
                          card
                          (card/create-card!
                           (cond-> (assoc card :collection_id dest-coll-id)
                             same-collection?
                             (update :name #(str % " - " (tru "Duplicate"))))
                           @api/*current-user*
                           ;; creating cards from a transaction. wait until tx complete to signal event
                           true))))
            {:copied {}
             :uncopied discard}
            copy)))
(defn- duplicate-tabs
  [new-dashboard existing-tabs]
  (let [new-tab-ids (t2/insert-returning-pks! :model/DashboardTab
                                              (for [tab existing-tabs]
                                                (-> tab
                                                    (assoc :dashboard_id (:id new-dashboard))
                                                    (dissoc :id :entity_id :created_at :updated_at))))]
    (zipmap (map :id existing-tabs) new-tab-ids)))

Update dashcards in a dashboard for copying. If the dashboard has tabs, fix up the tab ids in dashcards to point to the new tabs. Then if shallow copy, return the cards. If deep copy, replace ids with id from the newly-copied cards. If there is no new id, it means user lacked curate permissions for the cards collections and it is omitted. Dashboard-id is only needed for useful errors.

(defn update-cards-for-copy
  [dashboard-id dashcards deep? id->new-card id->new-tab-id]
  (when (and deep? (nil? id->new-card))
    (throw (ex-info (tru "No copied card information found")
                    {:user-id api/*current-user-id*
                     :dashboard-id dashboard-id})))
  (let [dashcards (if (seq id->new-tab-id)
                    (map #(assoc % :dashboard_tab_id (id->new-tab-id (:dashboard_tab_id %)))
                         dashcards)
                    dashcards)]
    (if-not deep?
      dashcards
      (keep (fn [dashboard-card]
              (cond
               ;; text cards need no manipulation
               (nil? (:card_id dashboard-card))
               dashboard-card
               ;; if we didn't duplicate, it doesn't go in the dashboard
               (not (id->new-card (:card_id dashboard-card)))
               nil
               :else
               (let [new-id (fn [id]
                              (-> id id->new-card :id))]
                 (-> dashboard-card
                     (update :card_id new-id)
                     (assoc :card (-> dashboard-card :card_id id->new-card))
                     (m/update-existing :parameter_mappings
                                        (fn [pms]
                                          (keep (fn [pm]
                                                  (m/update-existing pm :card_id new-id))
                                                pms)))
                     (m/update-existing :series
                                        (fn [series]
                                          (keep (fn [card]
                                                  (when-let [id' (new-id (:id card))]
                                                    (assoc card :id id')))
                                                series)))))))
            dashcards))))

/:from-dashboard-id/copy

(api/defendpoint POST 
  "Copy a Dashboard."
  [from-dashboard-id :as {{:keys [name description collection_id collection_position
                                  is_deep_copy], :as _dashboard} :body}]
  {from-dashboard-id      [:maybe ms/PositiveInt]
   name                   [:maybe ms/NonBlankString]
   description            [:maybe :string]
   collection_id          [:maybe ms/PositiveInt]
   collection_position    [:maybe ms/PositiveInt]
   is_deep_copy           [:maybe :boolean]}
  ;; if we're trying to save the new dashboard in a Collection make sure we have permissions to do that
  (collection/check-write-perms-for-collection collection_id)
  (let [existing-dashboard (get-dashboard from-dashboard-id)
        dashboard-data {:name                (or name (:name existing-dashboard))
                        :description         (or description (:description existing-dashboard))
                        :parameters          (or (:parameters existing-dashboard) [])
                        :creator_id          api/*current-user-id*
                        :collection_id       collection_id
                        :collection_position collection_position}
        new-cards      (atom nil)
        dashboard      (t2/with-transaction [_conn]
                        ;; Adding a new dashboard at `collection_position` could cause other dashboards in this
                        ;; collection to change position, check that and fix up if needed
                        (api/maybe-reconcile-collection-position! dashboard-data)
                        ;; Ok, now save the Dashboard
                        (let [dash (first (t2/insert-returning-instances! :model/Dashboard dashboard-data))
                              {id->new-card :copied uncopied :uncopied}
                              (when is_deep_copy
                                (duplicate-cards existing-dashboard collection_id))
                              id->new-tab-id (when-let [existing-tabs (seq (:tabs existing-dashboard))]
                                               (duplicate-tabs dash existing-tabs))]
                          (reset! new-cards (vals id->new-card))
                          (when-let [dashcards (seq (update-cards-for-copy from-dashboard-id
                                                                           (:dashcards existing-dashboard)
                                                                           is_deep_copy
                                                                           id->new-card
                                                                           id->new-tab-id))]
                            (api/check-500 (dashboard/add-dashcards! dash dashcards)))
                          (cond-> dash
                            (seq uncopied)
                            (assoc :uncopied uncopied))))]
    (snowplow/track-event! ::snowplow/dashboard-created api/*current-user-id* {:dashboard-id (u/the-id dashboard)})
    ;; must signal event outside of tx so cards are visible from other threads
    (when-let [newly-created-cards (seq @new-cards)]
      (doseq [card newly-created-cards]
        (events/publish-event! :event/card-create {:object card :user-id api/*current-user-id*})))
    (events/publish-event! :event/dashboard-create {:object dashboard :user-id api/*current-user-id*})
    dashboard))

--------------------------------------------- Fetching/Updating/Etc. ---------------------------------------------

/:id

(api/defendpoint GET 
  "Get Dashboard with ID."
  [id]
  {id ms/PositiveInt}
  (let [dashboard (get-dashboard id)]
    (events/publish-event! :event/dashboard-read {:object dashboard :user-id api/*current-user-id*})
    (last-edit/with-last-edit-info dashboard :dashboard)))

You must be a superuser to change the value of enable_embedding or embedding_params. Embedding must be enabled.

(defn- check-allowed-to-change-embedding
  [dash-before-update dash-updates]
  (when (or (api/column-will-change? :enable_embedding dash-before-update dash-updates)
            (api/column-will-change? :embedding_params dash-before-update dash-updates))
    (validation/check-embedding-enabled)
    (api/check-superuser)))

/:id

TODO - We can probably remove this in the near future since it should no longer be needed now that we're going to be setting :archived to true via the PUT endpoint instead

(api/defendpoint DELETE 
  "Delete a Dashboard.
  This will remove also any questions/models/segments/metrics that use this database."
  [id]
  {id ms/PositiveInt}
  (log/warn (str "DELETE /api/dashboard/:id is deprecated. Instead of deleting a Dashboard, you should change its "
                 "`archived` value via PUT /api/dashboard/:id."))
  (let [dashboard (api/write-check :model/Dashboard id)]
    (t2/delete! :model/Dashboard :id id)
    (events/publish-event! :event/dashboard-delete {:object dashboard :user-id api/*current-user-id*}))
  api/generic-204-no-content)
(defn- param-target->field-id [target query]
  (when-let [field-clause (params/param-target->field-clause target {:dataset_query query})]
    (mbql.u/match-one field-clause [:field (id :guard integer?) _] id)))

Starting in 0.41.0, you must have data permissions in order to add or modify a DashboardCard parameter mapping.

TODO -- should we only check new or modified mappings?

(mu/defn ^:private check-parameter-mapping-permissions
  {:added "0.41.0"}
  [parameter-mappings :- [:sequential dashboard-card/ParamMapping]]
  (when (seq parameter-mappings)
    ;; calculate a set of all Field IDs referenced by parameter mappings; then from those Field IDs calculate a set of
    ;; all Table IDs to which those Fields belong. This is done in a batched fashion so we can avoid N+1 query issues
    ;; if there happen to be a lot of parameters
    (let [card-ids              (into #{}
                                      (comp (map :card-id)
                                            (remove nil?))
                                      parameter-mappings)]
      (when (seq card-ids)
        (let [card-id->query        (t2/select-pk->fn :dataset_query Card :id [:in card-ids])
              field-ids             (set (for [{:keys [target card-id]} parameter-mappings
                                               :when                    card-id
                                               :let                     [query    (or (card-id->query card-id)
                                                                                      (throw (ex-info (tru "Card {0} does not exist or does not have a valid query."
                                                                                                           card-id)
                                                                                                      {:status-code 404
                                                                                                       :card-id     card-id})))
                                                                         field-id (param-target->field-id target query)]
                                               :when                    field-id]
                                           field-id))
              table-ids             (when (seq field-ids)
                                      (t2/select-fn-set :table_id Field :id [:in field-ids]))
              table-id->database-id (when (seq table-ids)
                                      (t2/select-pk->fn :db_id Table :id [:in table-ids]))]
          (doseq [table-id table-ids
                  :let     [database-id (table-id->database-id table-id)]]
            ;; check whether we'd actually be able to query this Table (do we have ad-hoc data perms for it?)
            (when-not (query-perms/can-query-table? database-id table-id)
              (throw (ex-info (tru "You must have data permissions to add a parameter referencing the Table {0}."
                                   (pr-str (t2/select-one-fn :name Table :id table-id)))
                              {:status-code        403
                               :database-id        database-id
                               :table-id           table-id
                               :actual-permissions @api/*current-user-permissions-set*})))))))))

Returns a map of DashboardCard ID -> parameter mappings for a Dashboard of the form

{ #{{:target [:dimension [:field 1000 nil]] :parameter_id "abcdef"}}}

(defn- existing-parameter-mappings
  [dashboard-id]
  (m/map-vals (fn [mappings]
                (into #{} (map #(select-keys % [:target :parameter_id])) mappings))
              (t2/select-pk->fn :parameter_mappings DashboardCard :dashboard_id dashboard-id)))

In 0.41.0+ you now require data permissions for the Table in question to add or modify Dashboard parameter mappings. Check that the current user has the appropriate permissions. Don't check any parameter mappings that already exist for this Dashboard -- only check permissions for new or modified ones.

(defn- check-updated-parameter-mapping-permissions
  [dashboard-id dashcards]
  (let [dashcard-id->existing-mappings (existing-parameter-mappings dashboard-id)
        existing-mapping?              (fn [dashcard-id mapping]
                                         (let [[mapping]         (mi/normalize-parameters-list [mapping])
                                               existing-mappings (get dashcard-id->existing-mappings dashcard-id)]
                                           (contains? existing-mappings (select-keys mapping [:target :parameter_id]))))
        new-mappings                   (for [{mappings :parameter_mappings, dashcard-id :id} dashcards
                                             mapping mappings
                                             :when (not (existing-mapping? dashcard-id mapping))]
                                         (assoc mapping :dashcard-id dashcard-id))
        ;; need to add the appropriate `:card-id` for all the new mappings we're going to check.
        dashcard-id->card-id           (when (seq new-mappings)
                                         (t2/select-pk->fn :card_id DashboardCard
                                           :dashboard_id dashboard-id
                                           :id           [:in (set (map :dashcard-id new-mappings))]))
        new-mappings                   (for [{:keys [dashcard-id], :as mapping} new-mappings]
                                         (assoc mapping :card-id (get dashcard-id->card-id dashcard-id)))]
    (check-parameter-mapping-permissions new-mappings)))
(defn- create-dashcards!
  [dashboard dashcards]
  (doseq [{:keys [card_id]} dashcards
          :when  (pos-int? card_id)]
    (api/check-not-archived (api/read-check Card card_id)))
  (check-parameter-mapping-permissions (for [{:keys [card_id parameter_mappings]} dashcards
                                             mapping parameter_mappings]
                                        (assoc mapping :card-id card_id)))
  (api/check-500 (dashboard/add-dashcards! dashboard dashcards)))
(defn- update-dashcards! [dashboard dashcards]
  (check-updated-parameter-mapping-permissions (:id dashboard) dashcards)
  ;; transform the dashcard data to the format of the DashboardCard model
  ;; so update-dashcards! can compare them with existing dashcards
  (dashboard/update-dashcards! dashboard (map dashboard-card/from-parsed-json dashcards))
  dashcards)
(defn- delete-dashcards! [dashcard-ids]
  (let [dashboard-cards (t2/select DashboardCard :id [:in dashcard-ids])]
    (dashboard-card/delete-dashboard-cards! dashcard-ids)
    dashboard-cards))
(defn- do-update-dashcards!
  [dashboard current-cards new-cards]
  (let [{:keys [to-create to-update to-delete]} (u/classify-changes current-cards new-cards)]
    (when (seq to-update)
      (update-dashcards! dashboard to-update))
    {:deleted-dashcards (when (seq to-delete)
                          (delete-dashcards! (map :id to-delete)))
     :created-dashcards (when (seq to-create)
                          (create-dashcards! dashboard to-create))}))
(def ^:private UpdatedDashboardCard
  [:map
   ;; id can be negative, it indicates a new card and BE should create them
   [:id                                  int?]
   [:size_x                              ms/PositiveInt]
   [:size_y                              ms/PositiveInt]
   [:row                                 ms/IntGreaterThanOrEqualToZero]
   [:col                                 ms/IntGreaterThanOrEqualToZero]
   [:parameter_mappings {:optional true} [:maybe [:sequential [:map
                                                               [:parameter_id ms/NonBlankString]
                                                               [:target       :any]]]]]
   [:series             {:optional true} [:maybe [:sequential map?]]]])
(def ^:private UpdatedDashboardTab
  [:map
   ;; id can be negative, it indicates a new card and BE should create them
   [:id   ms/Int]
   [:name ms/NonBlankString]])
(defn- track-dashcard-and-tab-events!
  [{dashboard-id :id :as dashboard}
   {:keys [created-dashcards deleted-dashcards
           created-tab-ids deleted-tab-ids total-num-tabs]}]
  ;; Dashcard events
  (when (seq deleted-dashcards)
    (events/publish-event! :event/dashboard-remove-cards
                           {:object dashboard :user-id api/*current-user-id* :dashcards deleted-dashcards}))
  (when (seq created-dashcards)
    (events/publish-event! :event/dashboard-add-cards
                           {:object dashboard :user-id api/*current-user-id* :dashcards created-dashcards})
    (for [{:keys [card_id]} created-dashcards
          :when             (pos-int? card_id)]
      (snowplow/track-event! ::snowplow/question-added-to-dashboard
                             api/*current-user-id*
                             {:dashboard-id dashboard-id :question-id card_id :user-id api/*current-user-id*})))
  ;; Tabs events
  (when (seq deleted-tab-ids)
    (snowplow/track-event! ::snowplow/dashboard-tab-deleted
                           api/*current-user-id*
                           {:dashboard-id   dashboard-id
                            :num-tabs       (count deleted-tab-ids)
                            :total-num-tabs total-num-tabs}))
  (when (seq created-tab-ids)
    (snowplow/track-event! ::snowplow/dashboard-tab-created
                           api/*current-user-id*
                           {:dashboard-id   dashboard-id
                            :num-tabs       (count created-tab-ids)
                            :total-num-tabs total-num-tabs})))

Updates a Dashboard. Designed to be reused by PUT /api/dashboard/:id and PUT /api/dashboard/:id/cards

(defn- update-dashboard
  [id {:keys [dashcards tabs] :as dash-updates}]
  (span/with-span!
    {:name       "update-dashboard"
     :attributes {:dashboard/id id}}
    (let [current-dash               (api/write-check Dashboard id)
          changes-stats              (atom nil)
          ;; tabs are always sent in production as well when dashcards are updated, but there are lots of
          ;; tests that exclude it. so this only checks for dashcards
          update-dashcards-and-tabs? (contains? dash-updates :dashcards)]
      (collection/check-allowed-to-change-collection current-dash dash-updates)
      (check-allowed-to-change-embedding current-dash dash-updates)
      (api/check-500
        (do
          (t2/with-transaction [_conn]
            ;; If the dashboard has an updated position, or if the dashboard is moving to a new collection, we might need to
            ;; adjust the collection position of other dashboards in the collection
            (api/maybe-reconcile-collection-position! current-dash dash-updates)
            (when-let [updates (not-empty
                                 (u/select-keys-when
                                   dash-updates
                                   :present #{:description :position :collection_id :collection_position :cache_ttl}
                                   :non-nil #{:name :parameters :caveats :points_of_interest :show_in_getting_started :enable_embedding
                                              :embedding_params :archived :auto_apply_filters}))]
              (t2/update! Dashboard id updates))
            (when update-dashcards-and-tabs?
              (when (not (false? (:archived false)))
                (api/check-not-archived current-dash))
              (let [{current-dashcards :dashcards
                     current-tabs      :tabs
                     :as               hydrated-current-dash} (t2/hydrate current-dash [:dashcards :series :card] :tabs)
                    _                       (when (and (seq current-tabs)
                                                       (not (every? #(some? (:dashboard_tab_id %)) dashcards)))
                                              (throw (ex-info (tru "This dashboard has tab, makes sure every card has a tab")
                                                              {:status-code 400})))
                    new-tabs                (map-indexed (fn [idx tab] (assoc tab :position idx)) tabs)
                    {:keys [old->new-tab-id
                            deleted-tab-ids]
                     :as   tabs-changes-stats} (dashboard-tab/do-update-tabs! (:id current-dash) current-tabs new-tabs)
                    deleted-tab-ids         (set deleted-tab-ids)
                    current-dashcards       (remove (fn [dashcard]
                                                      (contains? deleted-tab-ids (:dashboard_tab_id dashcard)))
                                                    current-dashcards)
                    new-dashcards           (cond->> dashcards
                                                     ;; fixup the temporary tab ids with the real ones
                                                     (seq old->new-tab-id)
                                                     (map (fn [card]
                                                            (if-let [real-tab-id (get old->new-tab-id (:dashboard_tab_id card))]
                                                              (assoc card :dashboard_tab_id real-tab-id)
                                                              card))))
                    dashcards-changes-stats (do-update-dashcards! hydrated-current-dash current-dashcards new-dashcards)]
                (reset! changes-stats
                        (merge
                          (select-keys tabs-changes-stats [:created-tab-ids :deleted-tab-ids :total-num-tabs])
                          (select-keys dashcards-changes-stats [:created-dashcards :deleted-dashcards]))))))
          true))
      (let [dashboard (t2/select-one :model/Dashboard id)]
        ;; skip publishing the event if it's just a change in its collection position
        (when-not (= #{:collection_position}
                     (set (keys dash-updates)))
          (events/publish-event! :event/dashboard-update {:object dashboard :user-id api/*current-user-id*}))
        (track-dashcard-and-tab-events! dashboard @changes-stats)
        (-> dashboard
            hydrate-dashboard-details
            (assoc :last-edit-info (last-edit/edit-information-for-user @api/*current-user*)))))))

/:id

(api/defendpoint PUT 
  "Update a Dashboard, and optionally the `dashcards` and `tabs` of a Dashboard. The request body should be a JSON object with the same
  structure as the response from `GET /api/dashboard/:id`."
  [id :as {{:keys [description name parameters caveats points_of_interest show_in_getting_started enable_embedding
                   embedding_params position archived collection_id collection_position cache_ttl dashcards tabs]
            :as dash-updates} :body}]
  {id                      ms/PositiveInt
   name                    [:maybe ms/NonBlankString]
   description             [:maybe :string]
   caveats                 [:maybe :string]
   points_of_interest      [:maybe :string]
   show_in_getting_started [:maybe :boolean]
   enable_embedding        [:maybe :boolean]
   embedding_params        [:maybe ms/EmbeddingParams]
   parameters              [:maybe [:sequential ms/Parameter]]
   position                [:maybe ms/PositiveInt]
   archived                [:maybe :boolean]
   collection_id           [:maybe ms/PositiveInt]
   collection_position     [:maybe ms/PositiveInt]
   cache_ttl               [:maybe ms/PositiveInt]
   dashcards               [:maybe (ms/maps-with-unique-key [:sequential UpdatedDashboardCard] :id)]
   tabs                    [:maybe (ms/maps-with-unique-key [:sequential UpdatedDashboardTab] :id)]}
  (update-dashboard id dash-updates))

/:id/cards

(api/defendpoint PUT 
  "(DEPRECATED -- Use the `PUT /api/dashboard/:id` endpoint instead.)
   Update `Cards` and `Tabs` on a Dashboard. Request body should have the form:
    {:cards        [{:id                 ... ; DashboardCard ID
                     :size_x             ...
                     :size_y             ...
                     :row                ...
                     :col                ...
                     :parameter_mappings ...
                     :series             [{:id 123
                                           ...}]}
                     ...]
     :tabs [{:id       ... ; DashboardTab ID
                     :name     ...}]}"
  [id :as {{:keys [cards tabs]} :body}]
  {id           ms/PositiveInt
   cards        (ms/maps-with-unique-key [:sequential UpdatedDashboardCard] :id)
   ;; tabs should be required in production, making it optional because lots of
   ;; e2e tests curerntly doesn't include it
   tabs [:maybe (ms/maps-with-unique-key [:sequential UpdatedDashboardTab] :id)]}
  (log/warn
   "DELETE /api/dashboard/:id/cards is deprecated. Use PUT /api/dashboard/:id instead.")
  (let [dashboard (update-dashboard id {:dashcards cards :tabs tabs})]
    {:cards (:dashcards dashboard)
     :tabs  (:tabs dashboard)}))

/:id/revisions

(api/defendpoint GET 
  "Fetch `Revisions` for Dashboard with ID."
  [id]
  {id ms/PositiveInt}
  (api/read-check :model/Dashboard id)
  (revision/revisions+details :model/Dashboard id))

/:id/revert

(api/defendpoint POST 
  "Revert a Dashboard to a prior `Revision`."
  [id :as {{:keys [revision_id]} :body}]
  {id ms/PositiveInt
   revision_id ms/PositiveInt}
  (api/write-check :model/Dashboard id)
  (revision/revert!
   {:entity      :model/Dashboard
    :id          id
    :user-id     api/*current-user-id*
    :revision-id revision_id}))

----------------------------------------------- Sharing is Caring ------------------------------------------------

/:dashboard-id/public_link

(api/defendpoint POST 
  "Generate publicly-accessible links for this Dashboard. Returns UUID to be used in public links. (If this
  Dashboard has already been shared, it will return the existing public link rather than creating a new one.) Public
  sharing must be enabled."
  [dashboard-id]
  {dashboard-id ms/PositiveInt}
  (api/check-superuser)
  (validation/check-public-sharing-enabled)
  (api/check-not-archived (api/read-check :model/Dashboard dashboard-id))
  {:uuid (or (t2/select-one-fn :public_uuid :model/Dashboard :id dashboard-id)
             (u/prog1 (str (random-uuid))
               (t2/update! :model/Dashboard dashboard-id
                           {:public_uuid       <>
                            :made_public_by_id api/*current-user-id*})))})

/:dashboard-id/public_link

(api/defendpoint DELETE 
  "Delete the publicly-accessible link to this Dashboard."
  [dashboard-id]
  {dashboard-id ms/PositiveInt}
  (validation/check-has-application-permission :setting)
  (validation/check-public-sharing-enabled)
  (api/check-exists? :model/Dashboard :id dashboard-id, :public_uuid [:not= nil], :archived false)
  (t2/update! :model/Dashboard dashboard-id
              {:public_uuid       nil
               :made_public_by_id nil})
  {:status 204, :body nil})

/public

(api/defendpoint GET 
  "Fetch a list of Dashboards with public UUIDs. These dashboards are publicly-accessible *if* public sharing is
  enabled."
  []
  (validation/check-has-application-permission :setting)
  (validation/check-public-sharing-enabled)
  (t2/select [:model/Dashboard :name :id :public_uuid], :public_uuid [:not= nil], :archived false))

/embeddable

(api/defendpoint GET 
  "Fetch a list of Dashboards where `enable_embedding` is `true`. The dashboards can be embedded using the embedding
  endpoints and a signed JWT."
  []
  (validation/check-has-application-permission :setting)
  (validation/check-embedding-enabled)
  (t2/select [:model/Dashboard :name :id], :enable_embedding true, :archived false))

/:id/related

(api/defendpoint GET 
  "Return related entities."
  [id]
  {id ms/PositiveInt}
  (-> (t2/select-one :model/Dashboard :id id) api/read-check related/related))

---------------------------------------------- Transient dashboards ----------------------------------------------

/save/collection/:parent-collection-id

(api/defendpoint POST 
  "Save a denormalized description of dashboard into collection with ID `:parent-collection-id`."
  [parent-collection-id :as {dashboard :body}]
  {parent-collection-id ms/PositiveInt}
  (collection/check-write-perms-for-collection parent-collection-id)
  (let [dashboard (dashboard/save-transient-dashboard! dashboard parent-collection-id)]
    (events/publish-event! :event/dashboard-create {:object dashboard :user-id api/*current-user-id*})
    dashboard))

/save

(api/defendpoint POST 
  "Save a denormalized description of dashboard."
  [:as {dashboard :body}]
  (let [parent-collection-id (if api/*is-superuser?*
                               (:id (populate/get-or-create-root-container-collection))
                               (t2/select-one-fn :id 'Collection
                                                 :personal_owner_id api/*current-user-id*))
        dashboard (dashboard/save-transient-dashboard! dashboard parent-collection-id)]
    (events/publish-event! :event/dashboard-create {:object dashboard :user-id api/*current-user-id*})
    dashboard))

------------------------------------- Chain-filtering param value endpoints --------------------------------------

How many results to return when chain filtering

(def ^:const result-limit
  1000)

Fetch the :field clause from dashcard referenced by :template-tag.

(get-template-tag [:template-tag :company] some-dashcard) ; -> [:field 100 nil]

(defn- get-template-tag
  [dimension card]
  (when-let [[_ tag] (mbql.u/check-clause :template-tag dimension)]
    (get-in card [:dataset_query :native :template-tags (u/qualified-name tag)])))
(defn- param-type->op [type]
  (if (get-in mbql.s/parameter-types [type :operator])
    (keyword (name type))
    :=))
(mu/defn ^:private param->fields
  [{:keys [mappings] :as param} :- mbql.s/Parameter]
  (for [{:keys [target] {:keys [card]} :dashcard} mappings
        :let  [[_ dimension] (->> (mbql.normalize/normalize-tokens target :ignore-path)
                                  (mbql.u/check-clause :dimension))]
        :when dimension
        :let  [ttag      (get-template-tag dimension card)
               dimension (condp mbql.u/is-clause? dimension
                           :field        dimension
                           :expression   dimension
                           :template-tag (:dimension ttag)
                           (log/error "cannot handle this dimension" {:dimension dimension}))
               field-id  (or
                          ;; Get the field id from the field-clause if it contains it. This is the common case
                          ;; for mbql queries.
                          (mbql.u/match-one dimension [:field (id :guard integer?) _] id)
                          ;; Attempt to get the field clause from the model metadata corresponding to the field.
                          ;; This is the common case for native queries in which mappings from original columns
                          ;; have been performed using model metadata.
                          (:id (qp.util/field->field-info dimension (:result_metadata card))))]
        :when field-id]
    {:field-id field-id
     :op       (param-type->op (:type param))
     :options  (merge (:options ttag)
                      (:options param))}))
(mu/defn ^:private chain-filter-constraints :- chain-filter/Constraints
  [dashboard constraint-param-key->value]
  (vec (for [[param-key value] constraint-param-key->value
             :let              [param (get-in dashboard [:resolved-params param-key])]
             :when             param
             field             (param->fields param)]
         (assoc field :value value))))

Get filter values when only field-refs (e.g. [:field "SOURCE" {:base-type :type/Text}]) are provided (rather than field-ids). This is a common case for nested queries.

(defn filter-values-from-field-refs
  [dashboard param-key]
  (let [dashboard       (t2/hydrate dashboard :resolved-params)
        param           (get-in dashboard [:resolved-params param-key])
        results         (for [{:keys [target] {:keys [card]} :dashcard} (:mappings param)
                              :let [[_ dimension] (->> (mbql.normalize/normalize-tokens target :ignore-path)
                                                       (mbql.u/check-clause :dimension))]
                              :when dimension]
                          (custom-values/values-from-card card dimension))]
    (when-some [values (seq (distinct (mapcat :values results)))]
      (let [has_more_values (boolean (some true? (map :has_more_values results)))]
        {:values          (cond->> values
                                   (seq values)
                                   (sort-by (case (count (first values))
                                              2 second
                                              1 first)))
         :has_more_values has_more_values}))))
(mu/defn chain-filter :- ms/FieldValuesResult
  "C H A I N filters!
  Used to query for values that populate chained filter dropdowns and text search boxes."
  ([dashboard param-key constraint-param-key->value]
   (chain-filter dashboard param-key constraint-param-key->value nil))
  ([dashboard                   :- ms/Map
    param-key                   :- ms/NonBlankString
    constraint-param-key->value :- ms/Map
    query                       :- [:maybe ms/NonBlankString]]
   (let [dashboard   (t2/hydrate dashboard :resolved-params)
         constraints (chain-filter-constraints dashboard constraint-param-key->value)
         param       (get-in dashboard [:resolved-params param-key])
         field-ids   (map :field-id (param->fields param))]
     (if (empty? field-ids)
       (or (filter-values-from-field-refs dashboard param-key)
           (throw (ex-info (tru "Parameter {0} does not have any Fields associated with it" (pr-str param-key))
                           {:param       (get (:resolved-params dashboard) param-key)
                            :status-code 400})))
       (try
         (let [results         (map (if (seq query)
                                      #(chain-filter/chain-filter-search % constraints query :limit result-limit)
                                      #(chain-filter/chain-filter % constraints :limit result-limit))
                                    field-ids)
               values          (distinct (mapcat :values results))
               has_more_values (boolean (some true? (map :has_more_values results)))]
           ;; results can come back as [[v] ...] *or* as [[orig remapped] ...]. Sort by remapped value if it's there
           {:values          (cond->> values
                                      (seq values)
                                      (sort-by (case (count (first values))
                                                 2 second
                                                 1 first)))
            :has_more_values has_more_values})
         (catch clojure.lang.ExceptionInfo e
           (if (= (:type (u/all-ex-data e)) qp.error-type/missing-required-permissions)
             (api/throw-403 e)
             (throw e))))))))

Fetch values for a parameter.

The source of values could be: - static-list: user defined values list - card: values is result of running a card - nil: chain-filter

(mu/defn param-values
  ([dashboard param-key constraint-param-key->value]
   (param-values dashboard param-key constraint-param-key->value nil))
  ([dashboard                   :- :map
    param-key                   :- ms/NonBlankString
    constraint-param-key->value :- :map
    query                       :- [:maybe ms/NonBlankString]]
   (let [dashboard (t2/hydrate dashboard :resolved-params)
         param     (get (:resolved-params dashboard) param-key)]
     (when-not param
       (throw (ex-info (tru "Dashboard does not have a parameter with the ID {0}" (pr-str param-key))
                       {:resolved-params (keys (:resolved-params dashboard))
                        :status-code     400})))
     (custom-values/parameter->values
       param
       query
       (fn [] (chain-filter dashboard param-key constraint-param-key->value query))))))

/:id/params/:param-key/values

(api/defendpoint GET 
  "Fetch possible values of the parameter whose ID is `:param-key`. If the values come directly from a query, optionally
  restrict these values by passing query parameters like `other-parameter=value` e.g.
    ;; fetch values for Dashboard 1 parameter 'abc' that are possible when parameter 'def' is set to 100
    GET /api/dashboard/1/params/abc/values?def=100"
  [id param-key :as {constraint-param-key->value :query-params}]
  {id ms/PositiveInt}
  (let [dashboard (api/read-check :model/Dashboard id)]
    ;; If a user can read the dashboard, then they can lookup filters. This also works with sandboxing.
    (binding [qp.perms/*param-values-query* true]
      (param-values dashboard param-key constraint-param-key->value))))

/:id/params/:param-key/search/:query

(api/defendpoint GET 
  "Fetch possible values of the parameter whose ID is `:param-key` that contain `:query`. Optionally restrict
  these values by passing query parameters like `other-parameter=value` e.g.
    ;; fetch values for Dashboard 1 parameter 'abc' that contain 'Cam' and are possible when parameter 'def' is set
    ;; to 100
     GET /api/dashboard/1/params/abc/search/Cam?def=100
  Currently limited to first 1000 results."
  [id param-key query :as {constraint-param-key->value :query-params}]
  {id    ms/PositiveInt
   query ms/NonBlankString}
  (let [dashboard (api/read-check :model/Dashboard id)]
    ;; If a user can read the dashboard, then they can lookup filters. This also works with sandboxing.
    (binding [qp.perms/*param-values-query* true]
      (param-values dashboard param-key constraint-param-key->value query))))

/params/valid-filter-fields

(api/defendpoint GET 
  "Utility endpoint for powering Dashboard UI. Given some set of `filtered` Field IDs (presumably Fields used in
  parameters) and a set of `filtering` Field IDs that will be used to restrict values of `filtered` Fields, for each
  `filtered` Field ID return the subset of `filtering` Field IDs that would actually be used in a chain filter query
  with these Fields.
  e.g. in a chain filter query like
  GET /api/dashboard/10/params/PARAM_1/values?PARAM_2=100
  Assume `PARAM_1` maps to Field 1 and `PARAM_2` maps to Fields 2 and 3. The underlying MBQL query may or may not
  filter against Fields 2 and 3, depending on whether an FK relationship that lets us create a join against Field 1
  can be found. You can use this endpoint to determine which of those Fields is actually used:
  GET /api/dashboard/params/valid-filter-fields?filtered=1&filtering=2&filtering=3
  ;; ->
  {1 [2 3]}
  Results are returned as a map of
  `filtered` Field ID -> subset of `filtering` Field IDs that would be used in chain filter query"
  [:as {{:keys [filtered filtering]} :params}]
  {filtered  [:or ms/IntGreaterThanOrEqualToZero
              [:+ ms/IntGreaterThanOrEqualToZero]]
   filtering [:maybe [:or ms/IntGreaterThanOrEqualToZero
                      [:+ ms/IntGreaterThanOrEqualToZero]]]}
  (let [filtered-field-ids  (if (sequential? filtered) (set filtered) #{filtered})
        filtering-field-ids (if (sequential? filtering) (set filtering) #{filtering})]
    (doseq [field-id (set/union filtered-field-ids filtering-field-ids)]
      (api/read-check Field field-id))
    (into {} (for [field-id filtered-field-ids]
               [field-id (sort (chain-filter/filterable-field-ids field-id filtering-field-ids))]))))

Schema for a parameter map with an string :id.

(def ParameterWithID
  (mu/with-api-error-message
    [:and
     [:map
      [:id ms/NonBlankString]]
     [:map-of :keyword :any]]
    (deferred-tru "value must be a parameter map with an 'id' key")))

---------------------------------- Executing the action associated with a Dashcard -------------------------------

/:dashboard-id/dashcard/:dashcard-id/execute

(api/defendpoint GET 
  "Fetches the values for filling in execution parameters. Pass PK parameters and values to select."
  [dashboard-id dashcard-id parameters]
  {dashboard-id ms/PositiveInt
   dashcard-id  ms/PositiveInt
   parameters   ms/JSONString}
  (api/read-check :model/Dashboard dashboard-id)
  (actions.execution/fetch-values
   (api/check-404 (action/dashcard->action dashcard-id))
   (json/parse-string parameters)))

/:dashboard-id/dashcard/:dashcard-id/execute

(api/defendpoint POST 
  "Execute the associated Action in the context of a `Dashboard` and `DashboardCard` that includes it.
   `parameters` should be the mapped dashboard parameters with values.
   `extra_parameters` should be the extra, user entered parameter values."
  [dashboard-id dashcard-id :as {{:keys [parameters], :as _body} :body}]
  {dashboard-id ms/PositiveInt
   dashcard-id  ms/PositiveInt
   parameters  [:maybe [:map-of :keyword :any]]}
  (api/read-check :model/Dashboard dashboard-id)
  ;; Undo middleware string->keyword coercion
  (actions.execution/execute-dashcard! dashboard-id dashcard-id (update-keys parameters name)))

---------------------------------- Running the query associated with a Dashcard ----------------------------------

/:dashboard-id/dashcard/:dashcard-id/card/:card-id/query

(api/defendpoint POST 
  "Run the query associated with a Saved Question (`Card`) in the context of a `Dashboard` that includes it."
  [dashboard-id dashcard-id card-id :as {{:keys [parameters], :as body} :body}]
  {dashboard-id  ms/PositiveInt
   dashcard-id   ms/PositiveInt
   card-id       ms/PositiveInt
   parameters    [:maybe [:sequential ParameterWithID]]}
  (m/mapply qp.dashboard/run-query-for-dashcard-async
            (merge
             body
             {:dashboard-id dashboard-id
              :card-id      card-id
              :dashcard-id  dashcard-id})))

/:dashboard-id/dashcard/:dashcard-id/card/:card-id/query/:export-format

(api/defendpoint POST 
  "Run the query associated with a Saved Question (`Card`) in the context of a `Dashboard` that includes it, and return
  its results as a file in the specified format.
  `parameters` should be passed as query parameter encoded as a serialized JSON string (this is because this endpoint
  is normally used to power 'Download Results' buttons that use HTML `form` actions)."
  [dashboard-id dashcard-id card-id export-format :as {{:keys [parameters], :as request-parameters} :params}]
  {dashboard-id  ms/PositiveInt
   dashcard-id   ms/PositiveInt
   card-id       ms/PositiveInt
   parameters    [:maybe ms/JSONString]
   export-format api.dataset/ExportFormat}
  (m/mapply qp.dashboard/run-query-for-dashcard-async
            (merge
             request-parameters
             {:dashboard-id  dashboard-id
              :card-id       card-id
              :dashcard-id   dashcard-id
              :export-format export-format
              :parameters    (json/parse-string parameters keyword)
              :context       (api.dataset/export-format->context export-format)
              :constraints   nil
              ;; TODO -- passing this `:middleware` map is a little repetitive, need to think of a way to not have to
              ;; specify this all over the codebase any time we want to do a query with an export format. Maybe this
              ;; should be the default if `export-format` isn't `:api`?
              :middleware    {:process-viz-settings?  true
                              :skip-results-metadata? true
                              :ignore-cached-results? true
                              :format-rows?           false
                              :js-int-to-string?      false}})))

/pivot/:dashboard-id/dashcard/:dashcard-id/card/:card-id/query

(api/defendpoint POST 
  "Run a pivot table query for a specific DashCard."
  [dashboard-id dashcard-id card-id :as {{:keys [parameters], :as body} :body}]
  {dashboard-id ms/PositiveInt
   dashcard-id  ms/PositiveInt
   card-id      ms/PositiveInt
   parameters   [:maybe [:sequential ParameterWithID]]}
  (m/mapply qp.dashboard/run-query-for-dashcard-async
            (merge
             body
             {:dashboard-id dashboard-id
              :card-id      card-id
              :dashcard-id  dashcard-id
              :qp-runner    qp.pivot/run-pivot-query})))
(api/define-routes)
 

/api/database endpoints.

(ns metabase.api.database
  (:require
   [clojure.string :as str]
   [compojure.core :refer [DELETE GET POST PUT]]
   [medley.core :as m]
   [metabase.analytics.snowplow :as snowplow]
   [metabase.api.common :as api]
   [metabase.api.table :as api.table]
   [metabase.config :as config]
   [metabase.db.connection :as mdb.connection]
   [metabase.db.query :as mdb.query]
   [metabase.driver :as driver]
   [metabase.driver.ddl.interface :as ddl.i]
   [metabase.driver.h2 :as h2]
   [metabase.driver.util :as driver.u]
   [metabase.events :as events]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.card :refer [Card]]
   [metabase.models.collection :as collection :refer [Collection]]
   [metabase.models.database
    :as database
    :refer [Database protected-password]]
   [metabase.models.field :refer [Field readable-fields-only]]
   [metabase.models.interface :as mi]
   [metabase.models.permissions :as perms]
   [metabase.models.persisted-info :as persisted-info]
   [metabase.models.secret :as secret]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.models.table :refer [Table]]
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings :as public-settings]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.sample-data :as sample-data]
   [metabase.sync.analyze :as analyze]
   [metabase.sync.field-values :as field-values]
   [metabase.sync.schedules :as sync.schedules]
   [metabase.sync.sync-metadata :as sync-metadata]
   [metabase.sync.util :as sync-util]
   [metabase.task.persist-refresh :as task.persist-refresh]
   [metabase.upload :as upload]
   [metabase.util :as u]
   [metabase.util.cron :as u.cron]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.i18n :refer [deferred-tru trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

Schema for a valid database engine name, e.g. h2 or postgres.

(def DBEngineString
  (mu/with-api-error-message
   [:and
    ms/NonBlankString
    [:fn
     {:error/message "Valid database engine"}
     #(u/ignore-exceptions (driver/the-driver %))]]
   (deferred-tru "value must be a valid database engine.")))

----------------------------------------------- GET /api/database ------------------------------------------------

(defn- add-tables [dbs]
  (let [db-id->tables (group-by :db_id (filter mi/can-read? (t2/select Table
                                                              :active          true
                                                              :db_id           [:in (map :id dbs)]
                                                              :visibility_type nil
                                                              {:order-by [[:%lower.schema :asc]
                                                                          [:%lower.display_name :asc]]})))]
    (for [db dbs]
      (assoc db :tables (get db-id->tables (:id db) [])))))
(mu/defn ^:private add-native-perms-info :- [:maybe
                                             [:sequential
                                              [:map
                                               [:native_permissions [:enum :write :none]]]]]
  "For each database in DBS add a `:native_permissions` field describing the current user's permissions for running
  native (e.g. SQL) queries. Will be either `:write` or `:none`. `:write` means you can run ad-hoc native queries,
  and save new Cards with native queries; `:none` means you can do neither.
  For the curious: the use of `:write` and `:none` is mainly for legacy purposes, when we had data-access-based
  permissions; there was a specific option where you could give a Perms Group permissions to run existing Cards with
  native queries, but not to create new ones. With the advent of what is currently being called 'Space-Age
  Permissions', all Cards' permissions are based on their parent Collection, removing the need for native read perms."
  [dbs :- [:maybe [:sequential :map]]]
  (for [db dbs]
    (assoc db :native_permissions (if (perms/set-has-full-permissions? @api/*current-user-permissions-set*
                                        (perms/adhoc-native-query-path (u/the-id db)))
                                    :write
                                    :none))))
(defn- card-database-supports-nested-queries? [{{database-id :database, :as database} :dataset_query, :as _card}]
  (when database-id
    (when-let [driver (driver.u/database->driver database-id)]
      (driver/database-supports? driver :nested-queries database))))

We know a card has ambiguous columns if any of the columns that come back end in _2 (etc.) because that's what clojure.java.jdbc 'helpfully' does for us automatically. Presence of ambiguous columns disqualifies a query for use as a source query because something like

SELECT name FROM ( SELECT x.name, y.name FROM x LEFT JOIN y on x.id = y.id )

would be ambiguous. Too many things break when attempting to use a query like this. In the future, this may be supported, but it will likely require rewriting the source SQL query to add appropriate aliases (this is even trickier if the source query uses SELECT *).

(defn- card-has-ambiguous-columns?
  [{result-metadata :result_metadata, dataset-query :dataset_query}]
  (and (= (:type dataset-query) :native)
       (some (partial re-find #"_2$")
             (map (comp name :name) result-metadata))))

Since cumulative count and cumulative sum aggregations are done in Clojure-land we can't use Cards that use queries with those aggregations as source queries. This function determines whether card is using one of those queries so we can filter it out in Clojure-land.

(defn- card-uses-unnestable-aggregation?
  [{{{aggregations :aggregation} :query} :dataset_query}]
  (mbql.u/match aggregations #{:cum-count :cum-sum}))

Does card's query meet the conditions required for it to be used as a source query for another query?

(defn card-can-be-used-as-source-query?
  [card]
  (and (card-database-supports-nested-queries? card)
       (not (or (card-uses-unnestable-aggregation? card)
                (card-has-ambiguous-columns? card)))))
(defn- ids-of-dbs-that-support-source-queries []
  (set (filter (fn [db-id]
                 (try
                   (when-let [db (t2/select-one Database :id db-id)]
                     (driver/database-supports? (:engine db) :nested-queries db))
                   (catch Throwable e
                     (log/error e (tru "Error determining whether Database supports nested queries")))))
               (t2/select-pks-set Database))))

Fetch the Cards that can be used as source queries (e.g. presented as virtual tables). Since Cards can be either dataset or card, pass in the question-type of :dataset or :card

(defn- source-query-cards
  [question-type & {:keys [additional-constraints xform], :or {xform identity}}]
  {:pre [(#{:card :dataset} question-type)]}
  (when-let [ids-of-dbs-that-support-source-queries (not-empty (ids-of-dbs-that-support-source-queries))]
    (transduce
     (comp (map (partial mi/do-after-select Card))
           (filter card-can-be-used-as-source-query?)
           xform)
     (completing conj #(t2/hydrate % :collection))
     []
     (mdb.query/reducible-query {:select   [:name :description :database_id :dataset_query :id :collection_id :result_metadata
                                            [{:select   [:status]
                                              :from     [:moderation_review]
                                              :where    [:and
                                                         [:= :moderated_item_type "card"]
                                                         [:= :moderated_item_id :report_card.id]
                                                         [:= :most_recent true]]
                                              :order-by [[:id :desc]]
                                              :limit    1}
                                             :moderated_status]]
                                 :from     [:report_card]
                                 :where    (into [:and
                                                  [:not= :result_metadata nil]
                                                  [:= :archived false]
                                                  [:= :dataset (= question-type :dataset)]
                                                  [:in :database_id ids-of-dbs-that-support-source-queries]
                                                  (collection/visible-collection-ids->honeysql-filter-clause
                                                   (collection/permissions-set->visible-collection-ids
                                                    @api/*current-user-permissions-set*))]
                                                 additional-constraints)
                                 :order-by [[:%lower.name :asc]]}))))

Truthy if a single Card that can be used as a source query exists.

(defn- source-query-cards-exist?
  [question-type]
  (seq (source-query-cards question-type :xform (take 1))))

Return a sequence of 'virtual' Table metadata for eligible Cards. (This takes the Cards from source-query-cards and returns them in a format suitable for consumption by the Query Builder.)

(defn- cards-virtual-tables
  [question-type & {:keys [include-fields?]}]
  (for [card (source-query-cards question-type)]
    (api.table/card->virtual-table card :include-fields? include-fields?)))
(defn- saved-cards-virtual-db-metadata [question-type & {:keys [include-tables? include-fields?]}]
  (when (public-settings/enable-nested-queries)
    (cond-> {:name               (trs "Saved Questions")
             :id                 lib.schema.id/saved-questions-virtual-database-id
             :features           #{:basic-aggregations}
             :is_saved_questions true}
      include-tables? (assoc :tables (cards-virtual-tables question-type
                                                           :include-fields? include-fields?)))))

"Virtual" tables for saved cards simulate the db->schema->table hierarchy by doing fake-db->collection->card

(defn- add-saved-questions-virtual-database [dbs & options]
  (let [virtual-db-metadata (apply saved-cards-virtual-db-metadata :card options)]
    ;; only add the 'Saved Questions' DB if there are Cards that can be used
    (cond-> dbs
      (and (source-query-cards-exist? :card) virtual-db-metadata) (concat [virtual-db-metadata]))))

Filters the provided list of databases by data model perms, returning only the databases for which the current user can fully or partially edit the data model. If the user does not have data access for any databases, returns only the name and ID of these databases, removing all other fields.

(defn- filter-databases-by-data-model-perms
  [dbs]
  (let [filtered-dbs
        (if-let [f (when config/ee-available?
                     (classloader/require 'metabase-enterprise.advanced-permissions.common)
                     (resolve 'metabase-enterprise.advanced-permissions.common/filter-databases-by-data-model-perms))]
          (f dbs)
          dbs)]
    (map
     (fn [db] (if (mi/can-read? db)
                db
                (select-keys db [:id :name :tables])))
     filtered-dbs)))

Given a DB, checks that current-user has any data model editing perms for the DB. If yes, returns the DB, with its tables also filtered by data model editing perms. If it does not, throws a permissions exception.

(defn- check-db-data-model-perms
  [db]
  (let [filtered-dbs (filter-databases-by-data-model-perms [db])]
    (api/check-403 (first filtered-dbs))))

Are uploads supported for this database?

(defn- uploadable-db?
  [db]
  (driver/database-supports? (driver.u/database->driver db) :uploads db))

Add an entry to each DB about whether the user can upload to it.

(defn- add-can-upload-to-dbs
  [dbs]
  (let [uploads-db-id (public-settings/uploads-database-id)]
    (for [db dbs]
      (assoc db :can_upload (and (= (:id db) uploads-db-id)
                                 (upload/can-create-upload? db (public-settings/uploads-schema-name)))))))
(defn- dbs-list
  [& {:keys [include-tables?
             include-saved-questions-db?
             include-saved-questions-tables?
             include-editable-data-model?
             include-analytics?
             exclude-uneditable-details?
             include-only-uploadable?]}]
  (let [dbs (t2/select Database (merge {:order-by [:%lower.name :%lower.engine]}
                                       (when-not include-analytics?
                                         {:where [:= :is_audit false]})))
        filter-by-data-access? (not (or include-editable-data-model? exclude-uneditable-details?))]
    (cond-> (add-native-perms-info dbs)
      include-tables?              add-tables
      true                         add-can-upload-to-dbs
      include-editable-data-model? filter-databases-by-data-model-perms
      exclude-uneditable-details?  (#(filter mi/can-write? %))
      filter-by-data-access?       (#(filter mi/can-read? %))
      include-saved-questions-db?  (add-saved-questions-virtual-database :include-tables? include-saved-questions-tables?)
      ;; Perms checks for uploadable DBs are handled by exclude-uneditable-details? (see below)
      include-only-uploadable?     (#(filter uploadable-db? %)))))

/

(api/defendpoint GET 
  "Fetch all `Databases`.
  * `include=tables` means we should hydrate the Tables belonging to each DB. Default: `false`.
  * `saved` means we should include the saved questions virtual database. Default: `false`.
  * `include_editable_data_model` will only include DBs for which the current user has data model editing
    permissions. (If `include=tables`, this also applies to the list of tables in each DB). Should only be used if
    Enterprise Edition code is available the advanced-permissions feature is enabled.
  * `exclude_uneditable_details` will only include DBs for which the current user can edit the DB details. Has no
    effect unless Enterprise Edition code is available and the advanced-permissions feature is enabled.
  * `include_only_uploadable` will only include DBs into which Metabase can insert new data."
  [include saved include_editable_data_model exclude_uneditable_details include_only_uploadable include_analytics]
  {include                       (mu/with-api-error-message
                                   [:maybe [:= "tables"]]
                                   (deferred-tru "include must be either empty or the value 'tables'"))
   include_analytics             [:maybe :boolean]
   saved                         [:maybe :boolean]
   include_editable_data_model   [:maybe :boolean]
   exclude_uneditable_details    [:maybe :boolean]
   include_only_uploadable       [:maybe :boolean]}
  (let [include-tables?                 (= include "tables")
        include-saved-questions-tables? (and saved include-tables?)
        only-editable?                  (or include_only_uploadable exclude_uneditable_details)
        db-list-res                     (or (dbs-list :include-tables?                 include-tables?
                                                      :include-saved-questions-db?     saved
                                                      :include-saved-questions-tables? include-saved-questions-tables?
                                                      :include-editable-data-model?    include_editable_data_model
                                                      :exclude-uneditable-details?     only-editable?
                                                      :include-analytics?              include_analytics
                                                      :include-only-uploadable?        include_only_uploadable)
                                            [])]
   {:data  db-list-res
    :total (count db-list-res)}))

--------------------------------------------- GET /api/database/:id ----------------------------------------------

(mu/defn ^:private expanded-schedules [db :- (mi/InstanceOf Database)]
  {:cache_field_values (u.cron/cron-string->schedule-map (:cache_field_values_schedule db))
   :metadata_sync      (u.cron/cron-string->schedule-map (:metadata_sync_schedule db))})

Add 'expanded' versions of the cron schedules strings for DB in a format that is appropriate for frontend consumption.

(defn- add-expanded-schedules
  [db]
  (assoc db :schedules (expanded-schedules db)))
(defn- filter-sensitive-fields
  [fields]
  (remove #(= :sensitive (:visibility_type %)) fields))

If URL param ?include= was passed to GET /api/database/:id, hydrate the Database appropriately.

(defn- get-database-hydrate-include
  [db include]
  (if-not include
    db
    (-> (t2/hydrate db (case include
                         "tables"        :tables
                         "tables.fields" [:tables [:fields [:target :has_field_values] :has_field_values]]))
        (update :tables (fn [tables]
                          (cond->> tables
                            ; filter hidden tables
                            true                        (filter (every-pred (complement :visibility_type) mi/can-read?))
                            ; filter hidden fields
                            (= include "tables.fields") (map #(update % :fields filter-sensitive-fields))))))))

Add an entry about whether the user can upload to this DB.

(defn- add-can-upload
  [db]
  (assoc db :can_upload (and (= (u/the-id db) (public-settings/uploads-database-id))
                             (upload/can-create-upload? db (public-settings/uploads-schema-name)))))

/:id

(api/defendpoint GET 
  "Get a single Database with `id`. Optionally pass `?include=tables` or `?include=tables.fields` to include the Tables
  belonging to this database, or the Tables and Fields, respectively.  If the requestor has write permissions for the DB
  (i.e. is an admin or has data model permissions), then certain inferred secret values will also be included in the
  returned details (see [[metabase.models.secret/expand-db-details-inferred-secret-values]] for full details).
  Passing include_editable_data_model will only return tables for which the current user has data model editing
  permissions, if Enterprise Edition code is available and a token with the advanced-permissions feature is present.
  In addition, if the user has no data access for the DB (aka block permissions), it will return only the DB name, ID
  and tables, with no additional metadata."
  [id include include_editable_data_model exclude_uneditable_details]
  {id      ms/PositiveInt
   include [:maybe [:enum "tables" "tables.fields"]]}
  (let [include-editable-data-model? (Boolean/parseBoolean include_editable_data_model)
        exclude-uneditable-details?  (Boolean/parseBoolean exclude_uneditable_details)
        filter-by-data-access?       (not (or include-editable-data-model? exclude-uneditable-details?))
        database                     (api/check-404 (t2/select-one Database :id id))]
    (cond-> database
      filter-by-data-access?       api/read-check
      exclude-uneditable-details?  api/write-check
      true                         add-expanded-schedules
      true                         (get-database-hydrate-include include)
      true                         add-can-upload
      include-editable-data-model? check-db-data-model-perms
      (mi/can-write? database)     (->
                                    secret/expand-db-details-inferred-secret-values
                                    (assoc :can-manage true)))))

List of models that are used to report usage on a database.

(def ^:private database-usage-models
  [:question :dataset :metric :segment])

A Honey SQL expression that is never true.

1 = 2

(def ^:private always-false-hsql-expr
  [:= [:inline 1] [:inline 2]])

Query that will returns the number of model that use the database with id database-id. The query must returns a scalar, and the method could return nil in case no query is available.

(defmulti ^:private database-usage-query
  {:arglists '([model database-id table-ids])}
  (fn [model _database-id _table-ids] (keyword model)))
(defmethod database-usage-query :question
  [_ db-id _table-ids]
  {:select [[:%count.* :question]]
   :from   [:report_card]
   :where  [:and
            [:= :database_id db-id]
            [:= :dataset false]]})
(defmethod database-usage-query :dataset
  [_ db-id _table-ids]
  {:select [[:%count.* :dataset]]
   :from   [:report_card]
   :where  [:and
            [:= :database_id db-id]
            [:= :dataset true]]})
(defmethod database-usage-query :metric
  [_ _db-id table-ids]
  {:select [[:%count.* :metric]]
   :from   [:metric]
   :where  (if table-ids
             [:in :table_id table-ids]
             always-false-hsql-expr)})
(defmethod database-usage-query :segment
  [_ _db-id table-ids]
  {:select [[:%count.* :segment]]
   :from   [:segment]
   :where  (if table-ids
             [:in :table_id table-ids]
             always-false-hsql-expr)})

/:id/usage_info

(api/defendpoint GET 
  "Get usage info for a database.
  Returns a map with keys are models and values are the number of entities that use this database."
  [id]
  {id ms/PositiveInt}
  (api/check-superuser)
  (api/check-404 (t2/exists? Database :id id))
  (let [table-ids (t2/select-pks-set Table :db_id id)]
    (first (mdb.query/query
             {:select [:*]
              :from   (for [model database-usage-models
                            :let [query (database-usage-query model id table-ids)]
                            :when query]
                        [query model])}))))

----------------------------------------- GET /api/database/:id/metadata -----------------------------------------

Since the normal :id param in the normal version of the endpoint will never match with negative numbers we'll create another endpoint to specifically match the ID of the 'virtual' database. The defendpoint macro requires either strings or vectors for the route so we'll have to use a vector and create a regex to only match the virtual ID (and nothing else).

(api/defendpoint GET ["/:virtual-db/metadata" :virtual-db (re-pattern (str lib.schema.id/saved-questions-virtual-database-id))]
  "Endpoint that provides metadata for the Saved Questions 'virtual' database. Used for fooling the frontend
   and allowing it to treat the Saved Questions virtual DB just like any other database."
  []
  (saved-cards-virtual-db-metadata :card :include-tables? true, :include-fields? true))
(defn- db-metadata [id include-hidden? include-editable-data-model? remove_inactive?]
  (let [db (-> (if include-editable-data-model?
                 (api/check-404 (t2/select-one Database :id id))
                 (api/read-check Database id))
               (t2/hydrate [:tables [:fields [:target :has_field_values] :has_field_values] :segments :metrics]))
        db (if include-editable-data-model?
             ;; We need to check data model perms after hydrating tables, since this will also filter out tables for
             ;; which the *current-user* does not have data model perms
             (check-db-data-model-perms db)
             db)]
    (-> db
        (update :tables (if include-hidden?
                          identity
                          (fn [tables]
                            (->> tables
                                 (remove :visibility_type)
                                 (map #(update % :fields filter-sensitive-fields))))))
        (update :tables (fn [tables]
                          (if-not include-editable-data-model?
                            ;; If we're filtering by data model perms, table perm checks were already done by
                            ;; check-db-data-model-perms
                            (filter mi/can-read? tables)
                            tables)))
        (update :tables (fn [tables]
                          (for [table tables]
                            (-> table
                                (update :segments (partial filter mi/can-read?))
                                (update :metrics  (partial filter mi/can-read?))))))
        (update :tables (if remove_inactive?
                          (fn [tables]
                            (filter :active tables))
                          identity)))))

/:id/metadata

(api/defendpoint GET 
  "Get metadata about a `Database`, including all of its `Tables` and `Fields`. Returns DB, fields, and field values.
  By default only non-hidden tables and fields are returned. Passing include_hidden=true includes them.
  Passing include_editable_data_model will only return tables for which the current user has data model editing
  permissions, if Enterprise Edition code is available and a token with the advanced-permissions feature is present.
  In addition, if the user has no data access for the DB (aka block permissions), it will return only the DB name, ID
  and tables, with no additional metadata."
  [id include_hidden include_editable_data_model remove_inactive]
  {id                          ms/PositiveInt
   include_hidden              [:maybe ms/BooleanString]
   include_editable_data_model [:maybe ms/BooleanString]
   remove_inactive             [:maybe ms/BooleanString]}
  (db-metadata id
               (Boolean/parseBoolean include_hidden)
               (Boolean/parseBoolean include_editable_data_model)
               (Boolean/parseBoolean remove_inactive)))

--------------------------------- GET /api/database/:id/autocomplete_suggestions ---------------------------------

(defn- autocomplete-tables [db-id search-string limit]
  (t2/select [Table :id :db_id :schema :name]
    {:where    [:and [:= :db_id db-id]
                     [:= :active true]
                     [:like :%lower.name (u/lower-case-en search-string)]
                     [:= :visibility_type nil]]
     :order-by [[:%lower.name :asc]]
     :limit    limit}))

Returns cards that match the search string in the given database, ordered by id. search-card-slug should be in a format like '123-foo-bar' or '123' or 'foo-bar', where 123 is the card ID and foo-bar is a prefix of the card name converted into a slug.

If the search string contains a number like '123' we match that as a prefix against the card IDs. If the search string contains a number at the start AND text like '123-foo' we match do an exact match on card ID, and a substring match on the card name. If the search string does not start with a number, and is text like 'foo' we match that as a substring on the card name.

(defn- autocomplete-cards
  [database-id search-card-slug]
  (let [search-id   (re-find #"\d*" search-card-slug)
        search-name (-> (re-matches #"\d*-?(.*)" search-card-slug)
                        second
                        (str/replace #"-" " ")
                        u/lower-case-en)]
    (t2/select [Card :id :dataset :database_id :name :collection_id [:collection.name :collection_name]]
               {:where    [:and
                           [:= :report_card.database_id database-id]
                           [:= :report_card.archived false]
                           (cond
                             ;; e.g. search-string = "123"
                             (and (not-empty search-id) (empty? search-name))
                             [:like
                              (h2x/cast (if (= (mdb.connection/db-type) :mysql) :char :text) :report_card.id)
                              (str search-id "%")]
                             ;; e.g. search-string = "123-foo"
                             (and (not-empty search-id) (not-empty search-name))
                             [:and
                              [:= :report_card.id (Integer/parseInt search-id)]
                              ;; this is a prefix match to be consistent with substring matches on the entire slug
                              [:like [:lower :report_card.name] (str search-name "%")]]
                             ;; e.g. search-string = "foo"
                             (and (empty? search-id) (not-empty search-name))
                             [:like [:lower :report_card.name] (str "%" search-name "%")])]
                :left-join [[:collection :collection] [:= :collection.id :report_card.collection_id]]
                :order-by [[:dataset :desc]         ; prioritize models
                           [:report_card.id :desc]] ; then most recently created
                :limit    50})))
(defn- autocomplete-fields [db-id search-string limit]
  (t2/select [Field :name :base_type :semantic_type :id :table_id [:table.name :table_name]]
             :metabase_field.active          true
             :%lower.metabase_field/name     [:like (u/lower-case-en search-string)]
             :metabase_field.visibility_type [:not-in ["sensitive" "retired"]]
             :table.db_id                    db-id
             {:order-by  [[[:lower :metabase_field.name] :asc]
                          [[:lower :table.name] :asc]]
              :left-join [[:metabase_table :table] [:= :table.id :metabase_field.table_id]]
              :limit     limit}))
(defn- autocomplete-results [tables fields limit]
  (let [tbl-count   (count tables)
        fld-count   (count fields)
        take-tables (min tbl-count (- limit (/ fld-count 2)))
        take-fields (- limit take-tables)]
    (concat (for [{table-name :name} (take take-tables tables)]
              [table-name "Table"])
            (for [{:keys [table_name base_type semantic_type name]} (take take-fields fields)]
              [name (str table_name
                         " "
                         base_type
                         (when semantic_type
                           (str " " semantic_type)))]))))

match-string is a string that will be used with ilike. The it will be lowercased by autocomplete-{tables,fields}.

(defn- autocomplete-suggestions
  [db-id match-string]
  (let [limit  50
        tables (filter mi/can-read? (autocomplete-tables db-id match-string limit))
        fields (readable-fields-only (autocomplete-fields db-id match-string limit))]
    (autocomplete-results tables fields limit)))

Valid options for the autocomplete types. Can match on a substring ("%input%"), on a prefix ("input%"), or reject autocompletions. Large instances with lots of fields might want to use prefix matching or turn off the feature if it causes too many problems.

(def ^:private autocomplete-matching-options
  #{:substring :prefix :off})
(defsetting native-query-autocomplete-match-style
  (deferred-tru
    (str "Matching style for native query editor's autocomplete. Can be \"substring\", \"prefix\", or \"off\". "
         "Larger instances can have performance issues matching using substring, so can use prefix matching, "
         " or turn autocompletions off."))
  :visibility :public
  :type       :keyword
  :default    :substring
  :audit      :raw-value
  :setter     (fn [v]
                (let [v (cond-> v (string? v) keyword)]
                  (if (autocomplete-matching-options v)
                    (setting/set-value-of-type! :keyword :native-query-autocomplete-match-style v)
                    (throw (ex-info (tru "Invalid `native-query-autocomplete-match-style` option")
                                    {:option v
                                     :valid-options autocomplete-matching-options}))))))

/:id/autocomplete_suggestions

(api/defendpoint GET 
  "Return a list of autocomplete suggestions for a given `prefix`, or `substring`. Should only specify one, but
  `substring` will have priority if both are present.
  This is intended for use with the ACE Editor when the User is typing raw SQL. Suggestions include matching `Tables`
  and `Fields` in this `Database`.
  Tables are returned in the format `[table_name \"Table\"]`;
  When Fields have a semantic_type, they are returned in the format `[field_name \"table_name base_type semantic_type\"]`
  When Fields lack a semantic_type, they are returned in the format `[field_name \"table_name base_type\"]`"
  [id prefix substring]
  {id        ms/PositiveInt
   prefix    [:maybe ms/NonBlankString]
   substring [:maybe ms/NonBlankString]}
  (api/read-check Database id)
  (when (and (str/blank? prefix) (str/blank? substring))
    (throw (ex-info (tru "Must include prefix or search") {:status-code 400})))
  (try
    (cond
      substring
      (autocomplete-suggestions id (str "%" substring "%"))
      prefix
      (autocomplete-suggestions id (str prefix "%")))
    (catch Throwable e
      (log/warn e (trs "Error with autocomplete: {0}" (ex-message e))))))

/:id/cardautocompletesuggestions

(api/defendpoint GET 
  "Return a list of `Card` autocomplete suggestions for a given `query` in a given `Database`.
  This is intended for use with the ACE Editor when the User is typing in a template tag for a `Card`, e.g. {{#...}}."
  [id query]
  {id    ms/PositiveInt
   query ms/NonBlankString}
  (api/read-check Database id)
  (try
    (->> (autocomplete-cards id query)
         (filter mi/can-read?)
         (map #(select-keys % [:id :name :dataset :collection_name])))
    (catch Throwable e
      (log/warn e (trs "Error with autocomplete: {0}" (ex-message e))))))

------------------------------------------ GET /api/database/:id/fields ------------------------------------------

/:id/fields

(api/defendpoint GET 
  "Get a list of all `Fields` in `Database`."
  [id]
  {id ms/PositiveInt}
  (api/read-check Database id)
  (let [fields (filter mi/can-read? (-> (t2/select [Field :id :name :display_name :table_id :base_type :semantic_type]
                                          :table_id        [:in (t2/select-fn-set :id Table, :db_id id)]
                                          :visibility_type [:not-in ["sensitive" "retired"]])
                                        (t2/hydrate :table)))]
    (for [{:keys [id name display_name table base_type semantic_type]} fields]
      {:id            id
       :name          name
       :display_name  display_name
       :base_type     base_type
       :semantic_type semantic_type
       :table_name    (:name table)
       :schema        (:schema table)})))

----------------------------------------- GET /api/database/:id/idfields -----------------------------------------

/:id/idfields

(api/defendpoint GET 
  "Get a list of all primary key `Fields` for `Database`."
  [id include_editable_data_model]
  {id ms/PositiveInt}
  (let [[db-perm-check field-perm-check] (if (Boolean/parseBoolean include_editable_data_model)
                                           [check-db-data-model-perms mi/can-write?]
                                           [api/read-check mi/can-read?])]
    (db-perm-check (t2/select-one Database :id id))
    (sort-by (comp u/lower-case-en :name :table)
             (filter field-perm-check (-> (database/pk-fields {:id id})
                                          (t2/hydrate :table))))))

----------------------------------------------- POST /api/database -----------------------------------------------

Try out the connection details for a database and useful error message if connection fails, returns nil if connection succeeds.

(defn test-database-connection
  [engine {:keys [host port] :as details}, & {:keys [log-exception]
                                              :or   {log-exception true}}]
  {:pre [(some? engine)]}
  (let [engine  (keyword engine)
        details (assoc details :engine engine)]
    (try
      (cond
        (driver.u/can-connect-with-details? engine details :throw-exceptions)
        nil
        (and host port (u/host-port-up? host port))
        {:message (tru "Connection to ''{0}:{1}'' successful, but could not connect to DB."
                       host port)}
        (and host (u/host-up? host))
        {:message (tru "Connection to host ''{0}'' successful, but port {1} is invalid."
                       host port)
         :errors  {:port (deferred-tru "check your port settings")}}
        host
        {:message (tru "Host ''{0}'' is not reachable" host)
         :errors  {:host (deferred-tru "check your host settings")}}
        :else
        {:message (tru "Unable to connect to database.")})
      (catch Throwable e
        (when (and log-exception (not (some->> e ex-cause ex-data ::driver/can-connect-message?)))
          (log/error e (trs "Cannot connect to Database")))
        (if (-> e ex-data :message)
          (ex-data e)
          {:message (.getMessage e)})))))

Does the given engine have an :ssl setting?

TODO - Just make :ssl a feature

(defn- supports-ssl?
  [driver]
  {:pre [(driver/available? driver)]}
  (let [driver-props (set (for [field (driver/connection-properties driver)]
                            (:name field)))]
    (contains? driver-props "ssl")))
(mu/defn ^:private test-connection-details :- :map
  "Try a making a connection to database `engine` with `details`.
  If the `details` has SSL explicitly enabled, go with that and do not accept plaintext connections. If it is disabled,
  try twice: once with SSL, and a second time without if the first fails. If either attempt is successful, returns
  the details used to successfully connect. Otherwise returns a map with the connection error message. (This map will
  also contain the key `:valid` = `false`, which you can use to distinguish an error from valid details.)"
  [engine  :- DBEngineString
   details :- :map]
  (let [;; Try SSL first if SSL is supported and not already enabled
        ;; If not successful or not applicable, details-with-ssl will be nil
        details-with-ssl (assoc details :ssl true)
        details-with-ssl (when (and (supports-ssl? (keyword engine))
                                    (not (true? (:ssl details)))
                                    (nil? (test-database-connection engine details-with-ssl :log-exception false)))
                           details-with-ssl)]
    (or
      ;; Opportunistic SSL
      details-with-ssl
      ;; Try with original parameters
      (some-> (test-database-connection engine details)
              (assoc :valid false))
      details)))

/

(api/defendpoint POST 
  "Add a new `Database`."
  [:as {{:keys [name engine details is_full_sync is_on_demand schedules auto_run_queries cache_ttl]} :body}]
  {name             ms/NonBlankString
   engine           DBEngineString
   details          ms/Map
   is_full_sync     [:maybe :boolean]
   is_on_demand     [:maybe :boolean]
   schedules        [:maybe sync.schedules/ExpandedSchedulesMap]
   auto_run_queries [:maybe :boolean]
   cache_ttl        [:maybe ms/PositiveInt]}
  (api/check-superuser)
  (when cache_ttl
    (api/check (premium-features/enable-cache-granular-controls?)
               [402 (tru (str "The cache TTL database setting is only enabled if you have a premium token with the "
                              "cache granular controls feature."))]))
  (let [is-full-sync?    (or (nil? is_full_sync)
                             (boolean is_full_sync))
        details-or-error (test-connection-details engine details)
        valid?           (not= (:valid details-or-error) false)]
    (if valid?
      ;; no error, proceed with creation. If record is inserted successfuly, publish a `:database-create` event.
      ;; Throw a 500 if nothing is inserted
      (u/prog1 (api/check-500 (first (t2/insert-returning-instances!
                                      Database
                                      (merge
                                       {:name         name
                                        :engine       engine
                                        :details      details-or-error
                                        :is_full_sync is-full-sync?
                                        :is_on_demand (boolean is_on_demand)
                                        :cache_ttl    cache_ttl
                                        :creator_id   api/*current-user-id*}
                                       (sync.schedules/schedule-map->cron-strings
                                        (if (:let-user-control-scheduling details)
                                          (sync.schedules/scheduling schedules)
                                          (sync.schedules/default-randomized-schedule)))
                                       (when (some? auto_run_queries)
                                         {:auto_run_queries auto_run_queries})))))
        (events/publish-event! :event/database-create {:object <> :user-id api/*current-user-id*})
        (snowplow/track-event! ::snowplow/database-connection-successful
                               api/*current-user-id*
                               {:database     engine
                                :database-id  (u/the-id <>)
                                :source       :admin
                                :dbms-version (:version (driver/dbms-version (keyword engine) <>))}))
      ;; failed to connect, return error
      (do
        (snowplow/track-event! ::snowplow/database-connection-failed
                               api/*current-user-id*
                               {:database engine :source :setup})
        {:status 400
         :body   (dissoc details-or-error :valid)}))))

/validate

(api/defendpoint POST 
  "Validate that we can connect to a database given a set of details."
  ;; TODO - why do we pass the DB in under the key `details`?
  [:as {{{:keys [engine details]} :details} :body}]
  {engine  DBEngineString
   details :map}
  (api/check-superuser)
  (let [details-or-error (test-connection-details engine details)]
    {:valid (not (false? (:valid details-or-error)))}))

--------------------------------------- POST /api/database/sample_database ----------------------------------------

/sample_database

(api/defendpoint POST 
  "Add the sample database as a new `Database`."
  []
  (api/check-superuser)
  (sample-data/add-sample-database!)
  (t2/select-one Database :is_sample true))

--------------------------------------------- PUT /api/database/:id ----------------------------------------------

Replace any sensitive values not overriden in the PUT with the original values

(defn- upsert-sensitive-fields
  [database details]
  (when details
    (merge (:details database)
           (reduce
            (fn [details k]
              (if (= protected-password (get details k))
                (m/update-existing details k (constantly (get-in database [:details k])))
                details))
            details
            (database/sensitive-fields-for-db database)))))

/:id/persist

(api/defendpoint POST 
  "Attempt to enable model persistence for a database. If already enabled returns a generic 204."
  [id]
  {id ms/PositiveInt}
  (api/check (public-settings/persisted-models-enabled)
             400
             (tru "Persisting models is not enabled."))
  (api/let-404 [database (t2/select-one Database :id id)]
    (api/write-check database)
    (if (-> database :settings :persist-models-enabled)
      ;; todo: some other response if already persisted?
      api/generic-204-no-content
      (let [[success? error] (ddl.i/check-can-persist database)
            schema           (ddl.i/schema-name database (public-settings/site-uuid))]
        (if success?
          ;; do secrets require special handling to not clobber them or mess up encryption?
          (do (t2/update! Database id {:settings (assoc (:settings database) :persist-models-enabled true)})
              (task.persist-refresh/schedule-persistence-for-database!
                database
                (public-settings/persisted-model-refresh-cron-schedule))
              api/generic-204-no-content)
          (throw (ex-info (ddl.i/error->message error schema)
                          {:error error
                           :database (:name database)})))))))

/:id/unpersist

(api/defendpoint POST 
  "Attempt to disable model persistence for a database. If already not enabled, just returns a generic 204."
  [id]
  {id ms/PositiveInt}
  (api/let-404 [database (t2/select-one Database :id id)]
    (api/write-check database)
    (if (-> database :settings :persist-models-enabled)
      (do (t2/update! Database id {:settings (dissoc (:settings database) :persist-models-enabled)})
          (persisted-info/mark-for-pruning! {:database_id id})
          (task.persist-refresh/unschedule-persistence-for-database! database)
          api/generic-204-no-content)
      ;; todo: a response saying this was a no-op? an error? same on the post to persist
      api/generic-204-no-content)))

/:id

(api/defendpoint PUT 
  "Update a `Database`."
  [id :as {{:keys [name engine details is_full_sync is_on_demand description caveats points_of_interest schedules
                   auto_run_queries refingerprint cache_ttl settings]} :body}]
  {id                 ms/PositiveInt
   name               [:maybe ms/NonBlankString]
   engine             [:maybe DBEngineString]
   refingerprint      [:maybe :boolean]
   details            [:maybe ms/Map]
   schedules          [:maybe sync.schedules/ExpandedSchedulesMap]
   description        [:maybe :string]   ; :string instead of ms/NonBlankString because we don't care
   caveats            [:maybe :string]   ; whether someone sets these to blank strings
   points_of_interest [:maybe :string]
   auto_run_queries   [:maybe :boolean]
   cache_ttl          [:maybe ms/PositiveInt]
   settings           [:maybe ms/Map]}
  ;; TODO - ensure that custom schedules and let-user-control-scheduling go in lockstep
  (let [existing-database (api/write-check (t2/select-one Database :id id))
        details           (some->> details
                                   (driver.u/db-details-client->server (or engine (:engine existing-database)))
                                   (upsert-sensitive-fields existing-database))
        ;; verify that we can connect to the database if `:details` OR `:engine` have changed.
        details-changed?  (some-> details (not= (:details existing-database)))
        engine-changed?   (some-> engine keyword (not= (:engine existing-database)))
        conn-error        (when (or details-changed? engine-changed?)
                            (test-database-connection (or engine (:engine existing-database))
                                                      (or details (:details existing-database))))
        full-sync?        (some-> is_full_sync boolean)]
    (if conn-error
      ;; failed to connect, return error
      {:status 400
       :body   conn-error}
      ;; no error, proceed with update
      (do
        ;; TODO - is there really a reason to let someone change the engine on an existing database?
        ;;       that seems like the kind of thing that will almost never work in any practical way
        ;; TODO - this means one cannot unset the description. Does that matter?
        (t2/update! Database id
                    (m/remove-vals
                      nil?
                      (merge
                        {:name               name
                         :engine             engine
                         :details            details
                         :refingerprint      refingerprint
                         :is_full_sync       full-sync?
                         :is_on_demand       (boolean is_on_demand)
                         :description        description
                         :caveats            caveats
                         :points_of_interest points_of_interest
                         :auto_run_queries   auto_run_queries}
                        ;; upsert settings with a PATCH-style update. `nil` key means unset the Setting.
                        (when (seq settings)
                          {:settings (into {}
                                           (remove (fn [[_k v]] (nil? v)))
                                           (merge (:settings existing-database) settings))})
                        (cond
                          ;; transition back to metabase managed schedules. the schedule
                          ;; details, even if provided, are ignored. database is the
                          ;; current stored value and check against the incoming details
                          (and (get-in existing-database [:details :let-user-control-scheduling])
                               (not (:let-user-control-scheduling details)))
                          (sync.schedules/schedule-map->cron-strings (sync.schedules/default-randomized-schedule))
                          ;; if user is controlling schedules
                          (:let-user-control-scheduling details)
                          (sync.schedules/schedule-map->cron-strings (sync.schedules/scheduling schedules))))))
        ;; do nothing in the case that user is not in control of
        ;; scheduling. leave them as they are in the db
        ;; unlike the other fields, folks might want to nil out cache_ttl. it should also only be settable on EE
        ;; with the advanced-config feature enabled.
        (when (premium-features/enable-cache-granular-controls?)
          (t2/update! Database id {:cache_ttl cache_ttl}))
        (let [db (t2/select-one Database :id id)]
          (events/publish-event! :event/database-update {:object db
                                                         :user-id api/*current-user-id*
                                                         :previous-object existing-database})
          ;; return the DB with the expanded schedules back in place
          (add-expanded-schedules db))))))

-------------------------------------------- DELETE /api/database/:id --------------------------------------------

/:id

(api/defendpoint DELETE 
  "Delete a `Database`."
  [id]
  {id ms/PositiveInt}
  (api/check-superuser)
  (api/let-404 [db (t2/select-one Database :id id)]
    (api/check-403 (mi/can-write? db))
    (t2/delete! Database :id id)
    (events/publish-event! :event/database-delete {:object db :user-id api/*current-user-id*}))
  api/generic-204-no-content)

------------------------------------------ POST /api/database/:id/sync_schema -------------------------------------------

/:id/sync_schema

Should somehow trigger sync-database/sync-database!

(api/defendpoint POST 
  "Trigger a manual update of the schema metadata for this `Database`."
  [id]
  {id ms/PositiveInt}
  ;; just wrap this in a future so it happens async
  (let [db (api/write-check (t2/select-one Database :id id))]
    (events/publish-event! :event/database-manual-sync {:object db :user-id api/*current-user-id*})
    (if-let [ex (try
                  ;; it's okay to allow testing H2 connections during sync. We only want to disallow you from testing them for the
                  ;; purposes of creating a new H2 database.
                  (binding [h2/*allow-testing-h2-connections* true]
                    (driver.u/can-connect-with-details? (:engine db) (:details db) :throw-exceptions))
                  nil
                  (catch Throwable e
                    e))]
      (throw (ex-info (ex-message ex) {:status-code 422}))
      (do
        (future
          (sync-metadata/sync-db-metadata! db)
          (analyze/analyze-db! db))
        {:status :ok}))))

/:id/dismiss_spinner

(api/defendpoint POST 
  "Manually set the initial sync status of the `Database` and corresponding
  tables to be `complete` (see #20863)"
  [id]
  {id ms/PositiveInt}
  ;; manual full sync needs to be async, but this is a simple update of `Database`
  (let [db     (api/write-check (t2/select-one Database :id id))
        tables (map api/write-check (:tables (first (add-tables [db]))))]
    (sync-util/set-initial-database-sync-complete! db)
    ;; avoid n+1
    (when-let [table-ids (seq (map :id tables))]
      (t2/update! Table {:id [:in table-ids]} {:initial_sync_status "complete"})))
  {:status :ok})

------------------------------------------ POST /api/database/:id/rescan_values -------------------------------------------

TODO - do we also want an endpoint to manually trigger analysis. Or separate ones for classification/fingerprinting?

Boolean indicating whether the rescan_values job should be done async or not. Defaults to true. Should only be rebound in tests to force the scan to block.

(def ^:dynamic *rescan-values-async*
  true)

/:id/rescan_values

Should somehow trigger cached-values/cache-field-values-for-database!

(api/defendpoint POST 
  "Trigger a manual scan of the field values for this `Database`."
  [id]
  {id ms/PositiveInt}
  ;; just wrap this is a future so it happens async
  (let [db (api/write-check (t2/select-one Database :id id))]
    (events/publish-event! :event/database-manual-scan {:object db :user-id api/*current-user-id*})
    ;; Override *current-user-permissions-set* so that permission checks pass during sync. If a user has DB detail perms
    ;; but no data perms, they should stll be able to trigger a sync of field values. This is fine because we don't
    ;; return any actual field values from this API. (#21764)
    (binding [api/*current-user-permissions-set* (atom #{"/"})]
      (if *rescan-values-async*
        (future (field-values/update-field-values! db))
        (field-values/update-field-values! db))))
  {:status :ok})

"Discard saved field values" action in db UI

(defn- database->field-values-ids [database-or-id]
  (map :id (mdb.query/query {:select    [[:fv.id :id]]
                             :from      [[:metabase_fieldvalues :fv]]
                             :left-join [[:metabase_field :f] [:= :fv.field_id :f.id]
                                         [:metabase_table :t] [:= :f.table_id :t.id]]
                             :where     [:= :t.db_id (u/the-id database-or-id)]})))
(defn- delete-all-field-values-for-database! [database-or-id]
  (when-let [field-values-ids (seq (database->field-values-ids database-or-id))]
    (t2/query-one {:delete-from :metabase_fieldvalues
                   :where       [:in :id field-values-ids]})))

/:id/discard_values

TODO - should this be something like DELETE /api/database/:id/field_values instead?

(api/defendpoint POST 
  "Discards all saved field values for this `Database`."
  [id]
  {id ms/PositiveInt}
  (let [db (api/write-check (t2/select-one Database :id id))]
    (events/publish-event! :event/database-discard-field-values {:object db :user-id api/*current-user-id*})
    (delete-all-field-values-for-database! db))
  {:status :ok})

------------------------------------------ GET /api/database/:id/schemas -----------------------------------------

Does the current user have permissions to know the schema with schema-name exists? (Do they have permissions to see at least some of its tables?)

(defn- can-read-schema?
  [database-id schema-name]
  (or
   (perms/set-has-partial-permissions? @api/*current-user-permissions-set*
                                       (perms/data-perms-path database-id schema-name))
   (perms/set-has-full-permissions? @api/*current-user-permissions-set*
                                    (perms/data-model-write-perms-path database-id schema-name))))

/:id/syncable_schemas

(api/defendpoint GET 
  "Returns a list of all syncable schemas found for the database `id`."
  [id]
  {id ms/PositiveInt}
  (let [db (api/check-404 (t2/select-one Database id))]
    (api/check-403 (mi/can-write? db))
    (->> db
         (driver/syncable-schemas (:engine db))
         (vec)
         (sort))))

/:id/schemas

(api/defendpoint GET 
  "Returns a list of all the schemas with tables found for the database `id`. Excludes schemas with no tables."
  [id include_editable_data_model include_hidden]
  {id                          ms/PositiveInt
   include_editable_data_model [:maybe ms/BooleanValue]
   include_hidden              [:maybe ms/BooleanValue]}
  (let [filter-schemas (fn [schemas]
                         (if include_editable_data_model
                           (if-let [f (u/ignore-exceptions
                                       (classloader/require 'metabase-enterprise.advanced-permissions.common)
                                       (resolve 'metabase-enterprise.advanced-permissions.common/filter-schema-by-data-model-perms))]
                             (map :schema (f (map (fn [s] {:db_id id :schema s}) schemas)))
                             schemas)
                           (filter (partial can-read-schema? id) schemas)))]
    (if include_editable_data_model
      (api/check-404 (t2/select-one Database id))
      (api/read-check Database id))
    (->> (t2/select-fn-set :schema Table
                           :db_id id :active true
                           (merge
                            {:order-by [[:%lower.schema :asc]]}
                            (when-not include_hidden
                              ;; a non-nil value means Table is hidden -- see [[metabase.models.table/visibility-types]]
                              {:where [:= :visibility_type nil]})))
         filter-schemas
         ;; for `nil` schemas return the empty string
         (map #(if (nil? %) "" %))
         distinct
         sort)))
(api/defendpoint GET ["/:virtual-db/schemas"
                      :virtual-db (re-pattern (str lib.schema.id/saved-questions-virtual-database-id))]
  "Returns a list of all the schemas found for the saved questions virtual database."
  []
  (when (public-settings/enable-nested-queries)
    (->> (cards-virtual-tables :card)
         (map :schema)
         distinct
         (sort-by u/lower-case-en))))
(api/defendpoint GET ["/:virtual-db/datasets"
                      :virtual-db (re-pattern (str lib.schema.id/saved-questions-virtual-database-id))]
  "Returns a list of all the datasets found for the saved questions virtual database."
  []
  (when (public-settings/enable-nested-queries)
    (->> (cards-virtual-tables :dataset)
         (map :schema)
         distinct
         (sort-by u/lower-case-en))))

------------------------------------- GET /api/database/:id/schema/:schema ---------------------------------------

(defn- schema-tables-list
  ([db-id schema]
   (schema-tables-list db-id schema nil nil))
  ([db-id schema include_hidden include_editable_data_model]
   (when-not include_editable_data_model
     (api/read-check Database db-id)
     (api/check-403 (can-read-schema? db-id schema)))
   (let [tables (if include_hidden
                  (t2/select Table
                             :db_id db-id
                             :schema schema
                             :active true
                             {:order-by [[:display_name :asc]]})
                  (t2/select Table
                             :db_id db-id
                             :schema schema
                             :active true
                             :visibility_type nil
                             {:order-by [[:display_name :asc]]}))]
     (if include_editable_data_model
       (if-let [f (when config/ee-available?
                    (classloader/require 'metabase-enterprise.advanced-permissions.common)
                    (resolve 'metabase-enterprise.advanced-permissions.common/filter-tables-by-data-model-perms))]
         (f tables)
         tables)
       (filter mi/can-read? tables)))))

/:id/schema/:schema

(api/defendpoint GET 
  "Returns a list of Tables for the given Database `id` and `schema`"
  [id include_hidden include_editable_data_model schema]
  {id                          ms/PositiveInt
   include_hidden              [:maybe ms/BooleanValue]
   include_editable_data_model [:maybe ms/BooleanValue]}
  (api/check-404 (seq (schema-tables-list
                       id
                       schema
                       include_hidden
                       include_editable_data_model))))

/:id/schema/

(api/defendpoint GET 
  "Return a list of Tables for a Database whose `schema` is `nil` or an empty string."
  [id include_hidden include_editable_data_model]
  {id                          ms/PositiveInt
   include_hidden              [:maybe ms/BooleanValue]
   include_editable_data_model [:maybe ms/BooleanValue]}
  (api/check-404 (seq (concat (schema-tables-list id nil include_hidden include_editable_data_model)
                              (schema-tables-list id "" include_hidden include_editable_data_model)))))
(api/defendpoint GET ["/:virtual-db/schema/:schema"
                      :virtual-db (re-pattern (str lib.schema.id/saved-questions-virtual-database-id))]
  "Returns a list of Tables for the saved questions virtual database."
  [schema]
  (when (public-settings/enable-nested-queries)
    (->> (source-query-cards
          :card
          :additional-constraints [(if (= schema (api.table/root-collection-schema-name))
                                     [:= :collection_id nil]
                                     [:in :collection_id (api/check-404 (not-empty (t2/select-pks-set Collection :name schema)))])])
         (map api.table/card->virtual-table))))
(api/defendpoint GET ["/:virtual-db/datasets/:schema"
                      :virtual-db (re-pattern (str lib.schema.id/saved-questions-virtual-database-id))]
  "Returns a list of Tables for the datasets virtual database."
  [schema]
  (when (public-settings/enable-nested-queries)
    (->> (source-query-cards
          :dataset
          :additional-constraints [(if (= schema (api.table/root-collection-schema-name))
                                     [:= :collection_id nil]
                                     [:in :collection_id (api/check-404 (not-empty (t2/select-pks-set Collection :name schema)))])])
         (map api.table/card->virtual-table))))
(api/define-routes)
 

/api/dataset endpoints.

(ns metabase.api.dataset
  (:require
   [cheshire.core :as json]
   [clojure.string :as str]
   [compojure.core :refer [POST]]
   [metabase.api.common :as api]
   [metabase.api.field :as api.field]
   [metabase.driver :as driver]
   [metabase.driver.util :as driver.u]
   [metabase.events :as events]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.schema :as mbql.s]
   [metabase.models.card :refer [Card]]
   [metabase.models.database :as database :refer [Database]]
   [metabase.models.params.custom-values :as custom-values]
   [metabase.models.persisted-info :as persisted-info]
   [metabase.models.query :as query]
   [metabase.models.table :refer [Table]]
   [metabase.query-processor :as qp]
   [metabase.query-processor.middleware.constraints :as qp.constraints]
   [metabase.query-processor.middleware.permissions :as qp.perms]
   [metabase.query-processor.pivot :as qp.pivot]
   [metabase.query-processor.streaming :as qp.streaming]
   [metabase.query-processor.util :as qp.util]
   [metabase.shared.models.visualization-settings :as mb.viz]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [steffan-westcott.clj-otel.api.trace.span :as span]
   [toucan2.core :as t2]))

-------------------------------------------- Running a Query Normally --------------------------------------------

Return the ID of the Card used as the "source" query of this query, if applicable; otherwise return nil. Used so :card-id context can be passed along with the query so Collections perms checking is done if appropriate. This fn is a wrapper for the function of the same name in the QP util namespace; it adds additional permissions checking as well.

(defn- query->source-card-id
  [outer-query]
  (when-let [source-card-id (qp.util/query->source-card-id outer-query)]
    (log/info (trs "Source query for this query is Card {0}" (pr-str source-card-id)))
    (api/read-check Card source-card-id)
    source-card-id))
(defn- run-query-async
  [{:keys [database], :as query}
   & {:keys [context export-format qp-runner]
      :or   {context       :ad-hoc
             export-format :api
             qp-runner     qp/process-query-and-save-with-max-results-constraints!}}]
  (span/with-span!
    {:name "run-query-async"}
    (when (and (not= (:type query) "internal")
               (not= database lib.schema.id/saved-questions-virtual-database-id))
      (when-not database
        (throw (ex-info (tru "`database` is required for all queries whose type is not `internal`.")
                        {:status-code 400, :query query})))
      (api/read-check Database database))
    ;; store table id trivially iff we get a query with simple source-table
    (let [table-id (get-in query [:query :source-table])]
      (when (int? table-id)
        (events/publish-event! :event/table-read {:object  (t2/select-one Table :id table-id)
                                                  :user-id api/*current-user-id*})))
    ;; add sensible constraints for results limits on our query
    (let [source-card-id (query->source-card-id query)
          source-card    (when source-card-id
                           (t2/select-one [Card :result_metadata :dataset] :id source-card-id))
          info           (cond-> {:executed-by api/*current-user-id*
                                  :context     context
                                  :card-id     source-card-id}
                           (:dataset source-card)
                           (assoc :metadata/dataset-metadata (:result_metadata source-card)))]
      (binding [qp.perms/*card-id* source-card-id]
        (qp.streaming/streaming-response [{:keys [rff context]} export-format]
                                         (qp-runner query info rff context))))))

/

(api/defendpoint POST 
  "Execute a query and retrieve the results in the usual format. The query will not use the cache."
  [:as {{:keys [database] :as query} :body}]
  {database [:maybe :int]}
  (run-query-async (update-in query [:middleware :js-int-to-string?] (fnil identity true))))

----------------------------------- Downloading Query Results in Other Formats -----------------------------------

Valid export formats for downloading query results.

(def export-formats
  (mapv u/qualified-name (qp.streaming/export-formats)))

Schema for valid export formats for downloading query results.

(def ExportFormat
  (into [:enum] export-formats))
(mu/defn export-format->context :- mbql.s/Context
  "Return the `:context` that should be used when saving a QueryExecution triggered by a request to download results
  in `export-format`.
    (export-format->context :json) ;-> :json-download"
  [export-format]
  (keyword (str (u/qualified-name export-format) "-download")))

Regex for matching valid export formats (e.g., json) for queries. Inteneded for use in an endpoint definition:

(api/defendpoint-schema POST ["/:export-format", :export-format export-format-regex]

(def export-format-regex
  (re-pattern (str "(" (str/join "|" (map u/qualified-name (qp.streaming/export-formats))) ")")))
(def ^:private column-ref-regex #"^\[.+\]$")

Key function for parsing JSON visualization settings into the DB form. Converts most keys to keywords, but leaves column references as strings.

(defn- viz-setting-key-fn
   [json-key]
   (if (re-matches column-ref-regex json-key)
     json-key
     (keyword json-key)))
(api/defendpoint POST ["/:export-format", :export-format export-format-regex]
  "Execute a query and download the result data as a file in the specified format."
  [export-format :as {{:keys [query visualization_settings] :or {visualization_settings "{}"}} :params}]
  {query                  ms/JSONString
   visualization_settings ms/JSONString
   export-format          (into [:enum] export-formats)}
  (let [query        (json/parse-string query keyword)
        viz-settings (-> (json/parse-string visualization_settings viz-setting-key-fn)
                         (update :table.columns mbql.normalize/normalize)
                         mb.viz/db->norm)
        query        (-> (assoc query
                                :async? true
                                :viz-settings viz-settings)
                         (dissoc :constraints)
                         (update :middleware #(-> %
                                                  (dissoc :add-default-userland-constraints? :js-int-to-string?)
                                                  (assoc :process-viz-settings? true
                                                         :skip-results-metadata? true
                                                         :format-rows? false))))]
    (run-query-async
     query
     :export-format export-format
     :context       (export-format->context export-format)
     :qp-runner     qp/process-query-and-save-execution!)))

------------------------------------------------ Other Endpoints -------------------------------------------------

/duration

TODO - this is no longer used. Should we remove it?

(api/defendpoint POST 
  "Get historical query execution duration."
  [:as {{:keys [database], :as query} :body}]
  (api/read-check Database database)
  ;; try calculating the average for the query as it was given to us, otherwise with the default constraints if
  ;; there's no data there. If we still can't find relevant info, just default to 0
  {:average (or
             (some (comp query/average-execution-time-ms qp.util/query-hash)
                   [query
                    (assoc query :constraints (qp.constraints/default-query-constraints))])
             0)})

/native

(api/defendpoint POST 
  "Fetch a native version of an MBQL query."
  [:as {{:keys [database pretty] :as query} :body}]
  {database ms/PositiveInt
   pretty  [:maybe :boolean]}
  (binding [persisted-info/*allow-persisted-substitution* false]
    (qp.perms/check-current-user-has-adhoc-native-query-perms query)
    (let [driver (driver.u/database->driver database)
          prettify (partial driver/prettify-native-form driver)
          compiled (qp/compile-and-splice-parameters query)]
      (cond-> compiled
        (not (false? pretty)) (update :query prettify)))))

/pivot

(api/defendpoint POST 
  "Generate a pivoted dataset for an ad-hoc query"
  [:as {{:keys [database] :as query} :body}]
  {database [:maybe ms/PositiveInt]}
  (when-not database
    (throw (Exception. (str (tru "`database` is required for all queries.")))))
  (api/read-check Database database)
  (let [info {:executed-by api/*current-user-id*
              :context     :ad-hoc}]
    (qp.streaming/streaming-response [{:keys [rff context]} :api]
      (qp.pivot/run-pivot-query (assoc query
                                       :async? true
                                       :constraints (qp.constraints/default-query-constraints))
                                info
                                rff
                                context))))
(defn- parameter-field-values
  [field-ids query]
  (when-not (seq field-ids)
    (throw (ex-info (tru "Missing field-ids for parameter")
                    {:status-code 400})))
  (-> (reduce (fn [resp id]
                (let [{values :values more? :has_more_values} (api.field/search-values-from-field-id id query)]
                  (-> resp
                      (update :values concat values)
                      (update :has_more_values #(or % more?)))))
              {:has_more_values false
               :values          []}
              field-ids)
      ;; deduplicate the values returned from multiple fields
      (update :values (comp vec set))))

Fetch parameter values. Parameter should be a full parameter, field-ids is an optional vector of field ids, only consulted if :values_source_type is nil. Query is an optional string return matching field values not all.

(defn parameter-values
  [parameter field-ids query]
  (custom-values/parameter->values
    parameter query
    (fn [] (parameter-field-values field-ids query))))

/parameter/values

(api/defendpoint POST 
  "Return parameter values for cards or dashboards that are being edited."
  [:as {{:keys [parameter field_ids]} :body}]
  {parameter ms/Parameter
   field_ids [:maybe [:sequential ms/PositiveInt]]}
  (parameter-values parameter field_ids nil))

/parameter/search/:query

(api/defendpoint POST 
  "Return parameter values for cards or dashboards that are being edited. Expects a query string at `?query=foo`."
  [query :as {{:keys [parameter field_ids]} :body}]
  {parameter ms/Parameter
   field_ids [:maybe [:sequential ms/PositiveInt]]
   query     ms/NonBlankString}
  (parameter-values parameter field_ids query))
(api/define-routes)
 

/api/email endpoints

(ns metabase.api.email
  (:require
   [clojure.data :as data]
   [clojure.set :as set]
   [clojure.string :as str]
   [compojure.core :refer [DELETE POST PUT]]
   [metabase.api.common :as api]
   [metabase.api.common.validation :as validation]
   [metabase.email :as email]
   [metabase.models.setting :as setting]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]))
(set! *warn-on-reflection* true)
(def ^:private mb-to-smtp-settings
  {:email-smtp-host     :host
   :email-smtp-username :user
   :email-smtp-password :pass
   :email-smtp-port     :port
   :email-smtp-security :security
   :email-from-name     :sender-name
   :email-from-address  :sender
   :email-reply-to      :reply-to})

Convert raw error message responses from our email functions into our normal api error response structure.

(defn- humanize-error-messages
  [{::email/keys [error]}]
  (when error
    (let [conn-error  {:errors {:email-smtp-host "Wrong host or port"
                                :email-smtp-port "Wrong host or port"}}
          creds-error {:errors {:email-smtp-username "Wrong username or password"
                                :email-smtp-password "Wrong username or password"}}
          exceptions  (u/full-exception-chain error)
          message     (str/join ": " (map ex-message exceptions))
          match-error (fn match-error [regex-or-exception-class [message exceptions]]
                        (cond (instance? java.util.regex.Pattern regex-or-exception-class)
                              (re-find regex-or-exception-class message)
                              (class? regex-or-exception-class)
                              (some (partial instance? regex-or-exception-class) exceptions)))]
      (log/warn "Problem connecting to mail server:" message)
      (condp match-error [message exceptions]
        ;; bad host = "Unknown SMTP host: foobar"
        #"^Unknown SMTP host:.*$"
        conn-error
        ;; host seems valid, but host/port failed connection = "Could not connect to SMTP host: localhost, port: 123"
        #".*Could(?: not)|(?:n't) connect to (?:SMTP )?host.*"
        conn-error
        ;; seen this show up on mandrill
        #"^Invalid Addresses$"
        creds-error
        ;; seen this show up on mandrill using TLS with bad credentials
        #"^failed to connect, no password specified\?$"
        creds-error
        ;; madrill authentication failure
        #"^435 4.7.8 Error: authentication failed:.*$"
        creds-error
        javax.mail.AuthenticationFailedException
        creds-error
        ;; everything else :(
        {:message (str "Sorry, something went wrong. Please try again. Error: " message)}))))

Formats warnings when security settings are autocorrected.

(defn- humanize-email-corrections
  [corrections]
  (into
   {}
   (for [[k v] corrections]
     [k (tru "{0} was autocorrected to {1}"
             (name (mb-to-smtp-settings k))
             (u/upper-case-en v))])))

Returns a map of setting names (keywords) and env var values. If an env var is not set, the setting is not included in the result.

(defn- env-var-values-by-email-setting
  []
  (into {}
        (for [setting-name (keys mb-to-smtp-settings)
              :let         [value (setting/env-var-value setting-name)]
              :when        (some? value)]
          [setting-name value])))

/

(api/defendpoint PUT 
  "Update multiple email Settings. You must be a superuser or have `setting` permission to do this."
  [:as {settings :body}]
  {settings :map}
  (validation/check-has-application-permission :setting)
  (let [;; the frontend has access to an obfuscated version of the password. Watch for whether it sent us a new password or
        ;; the obfuscated version
        obfuscated? (and (:email-smtp-password settings) (email/email-smtp-password)
                         (= (:email-smtp-password settings) (setting/obfuscate-value (email/email-smtp-password))))
        ;; override `nil` values in the request with environment variables for testing the SMTP connection
        env-var-settings (env-var-values-by-email-setting)
        settings         (merge settings env-var-settings)
        settings         (-> (cond-> settings
                               obfuscated?
                               (assoc :email-smtp-password (email/email-smtp-password)))
                             (select-keys (keys mb-to-smtp-settings))
                             (set/rename-keys mb-to-smtp-settings))
        settings         (cond-> settings
                           (string? (:port settings))     (update :port #(Long/parseLong ^String %))
                           (string? (:security settings)) (update :security keyword))
        response         (email/test-smtp-connection settings)]
    (if-not (::email/error response)
      ;; test was good, save our settings
      (let [[_ corrections] (data/diff settings response)
            new-settings    (set/rename-keys response (set/map-invert mb-to-smtp-settings))]
        ;; don't update settings if they are set by environment variables
        (setting/set-many! (apply dissoc new-settings (keys env-var-settings)))
        (cond-> (assoc new-settings :with-corrections (-> corrections
                                                          (set/rename-keys (set/map-invert mb-to-smtp-settings))
                                                          humanize-email-corrections))
          obfuscated? (update :email-smtp-password setting/obfuscate-value)))
      ;; test failed, return response message
      {:status 400
       :body   (humanize-error-messages response)})))

/

(api/defendpoint DELETE 
  "Clear all email related settings. You must be a superuser or have `setting` permission to do this."
  []
  (validation/check-has-application-permission :setting)
  (setting/set-many! (zipmap (keys mb-to-smtp-settings) (repeat nil)))
  api/generic-204-no-content)

/test

(api/defendpoint POST 
  "Send a test email using the SMTP Settings. You must be a superuser or have `setting` permission to do this.
  Returns `{:ok true}` if we were able to send the message successfully, otherwise a standard 400 error response."
  []
  (validation/check-has-application-permission :setting)
  (let [response (email/send-message!
                   :subject      "Metabase Test Email"
                   :recipients   [(:email @api/*current-user*)]
                   :message-type :text
                   :message      "Your Metabase emails are working — hooray!")]
    (if-not (::email/error response)
      {:ok true}
      {:status 400
       :body   (humanize-error-messages response)})))
(api/define-routes)
 

Various endpoints that use JSON web tokens to fetch Cards and Dashboards. The endpoints are the same as the ones in api/public/, and differ only in the way they are authorized.

To use these endpoints:

  1. Set the embedding-secret-key Setting to a hexadecimal-encoded 32-byte sequence (i.e., a 64-character string). You can use /api/util/random_token to get a cryptographically-secure value for this.
  2. Sign/base-64 encode a JSON Web Token using the secret key and pass it as the relevant part of the URL path to the various endpoints here.

    Tokens can have the following fields:

    {:resource {:question :dashboard } :params }

(ns metabase.api.embed
  (:require
   [clojure.set :as set]
   [clojure.string :as str]
   [compojure.core :refer [GET]]
   [medley.core :as m]
   [metabase.api.card :as api.card]
   [metabase.api.common :as api]
   [metabase.api.common.validation :as validation]
   [metabase.api.dashboard :as api.dashboard]
   [metabase.api.dataset :as api.dataset]
   [metabase.api.public :as api.public]
   [metabase.driver.common.parameters.operators :as params.ops]
   [metabase.events :as events]
   [metabase.models.card :as card :refer [Card]]
   [metabase.models.dashboard :refer [Dashboard]]
   [metabase.models.params :as params]
   [metabase.pulse.parameters :as pulse-params]
   [metabase.query-processor :as qp]
   [metabase.query-processor.middleware.constraints :as qp.constraints]
   [metabase.query-processor.pivot :as qp.pivot]
   [metabase.util :as u]
   [metabase.util.embed :as embed]
   [metabase.util.i18n
    :as i18n
    :refer [tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

------------------------------------------------- Param Checking -------------------------------------------------

Check that the conditions specified by object-embedding-params are satisfied.

(defn- check-params-are-allowed
  [object-embedding-params token-params user-params]
  (let [all-params        (set/union token-params user-params)
        duplicated-params (set/intersection token-params user-params)]
    (doseq [[param status] object-embedding-params]
      (case status
        ;; disabled means a param is not allowed to be specified by either token or user
        "disabled" (api/check (not (contains? all-params param))
                              [400 (tru "You''re not allowed to specify a value for {0}." param)])
        ;; enabled means either JWT *or* user can specify the param, but not both. Param is *not* required
        "enabled"  (api/check (not (contains? duplicated-params param))
                              [400 (tru "You can''t specify a value for {0} if it''s already set in the JWT." param)])
        ;; locked means JWT must specify param
        "locked"   (api/check
                    (contains? token-params param)      [400 (tru "You must specify a value for {0} in the JWT." param)]
                    (not (contains? user-params param)) [400 (tru "You can only specify a value for {0} in the JWT." param)])))))

Make sure all the params specified are specified in object-embedding-params.

(defn- check-params-exist
  [object-embedding-params all-params]
  (let [embedding-params (set (keys object-embedding-params))]
    (doseq [k all-params]
      (api/check (contains? embedding-params k)
        [400 (format "Unknown parameter %s." k)]))))

Validate that sets of params passed as part of the JWT token and by the user (as query params, i.e. as part of the URL) are valid for the object-embedding-params. token-params and user-params should be sets of all valid param keys specified in the JWT or by the user, respectively.

(defn- check-param-sets
  [object-embedding-params token-params user-params]
  ;; TODO - maybe make this log/debug once embedding is wrapped up
  (log/debug "Validating params for embedded object:\n"
             "object embedding params:" object-embedding-params
             "token params:"            token-params
             "user params:"             user-params)
  (check-params-are-allowed object-embedding-params token-params user-params)
  (check-params-exist object-embedding-params (set/union token-params user-params)))

Is V a valid param value? (If it is a String, is it non-blank?)

(defn- valid-param?
  [v]
  (or (not (string? v))
      (not (str/blank? v))))
(mu/defn ^:private validate-and-merge-params :- [:map-of :keyword :any]
  "Validate that the `token-params` passed in the JWT and the `user-params` (passed as part of the URL) are allowed, and
  that ones that are required are specified by checking them against a Card or Dashboard's `object-embedding-params`
  (the object's value of `:embedding_params`). Throws a 400 if any of the checks fail. If all checks are successful,
  returns a *merged* parameters map."
  [object-embedding-params :- ms/EmbeddingParams
   token-params            :- [:map-of :keyword :any]
   user-params             :- [:map-of :keyword :any]]
  (check-param-sets object-embedding-params
                    (set (keys (m/filter-vals valid-param? token-params)))
                    (set (keys (m/filter-vals valid-param? user-params))))
  ;; ok, everything checks out, now return the merged params map
  (merge user-params token-params))

---------------------------------------------- Other Param Util Fns ----------------------------------------------

Remove any params from the list whose :slug is in the params-to-remove set.

(defn- remove-params-in-set
  [params params-to-remove]
  (for [param params
        :when (not (contains? params-to-remove (keyword (:slug param))))]
    param))

Gets the params in both the provided embedding-params and dashboard-or-card object that we should remove.

(defn- get-params-to-remove
  [dashboard-or-card embedding-params]
  (set (concat (for [[param status] embedding-params
                     :when          (not= status "enabled")]
                 param)
               (for [{slug :slug} (:parameters dashboard-or-card)
                     :let         [param (keyword slug)]
                     :when        (not (contains? embedding-params param))]
                 param))))

Remove the :parameters for dashboard-or-card that listed as disabled or locked in the embedding-params whitelist, or not present in the whitelist. This is done so the frontend doesn't display widgets for params the user can't set.

(mu/defn ^:private remove-locked-and-disabled-params
  [dashboard-or-card embedding-params :- ms/EmbeddingParams]
  (let [params-to-remove (get-params-to-remove dashboard-or-card embedding-params)]
    (update dashboard-or-card :parameters remove-params-in-set params-to-remove)))

Removes any parameters with slugs matching keys provided in token-params, as these should not be exposed to the user.

(defn- remove-token-parameters
  [dashboard-or-card token-params]
  (update dashboard-or-card :parameters remove-params-in-set (set (keys token-params))))

For any dashboard parameters with slugs matching keys provided in token-params, substitute their values from the token into any Markdown dashboard cards with linked variables. This needs to be done on the backend because we don't make these parameters visible at all to the frontend.

(defn- substitute-token-parameters-in-text
  [dashboard token-params]
  (let [params             (:parameters dashboard)
        dashcards      (:dashcards dashboard)
        params-with-values (reduce
                            (fn [acc param]
                             (if-let [value (get token-params (keyword (:slug param)))]
                                (conj acc (assoc param :value value))
                                acc))
                            []
                            params)]
    (assoc dashboard
           :dashcards
           (map
            (fn [card]
              (if (-> card :visualization_settings :virtual_card)
                (pulse-params/process-virtual-dashcard card params-with-values)
                card))
            dashcards))))
(mu/defn ^:private apply-slug->value :- [:maybe [:sequential
                                                 [:map
                                                  [:slug ms/NonBlankString]
                                                  [:type :keyword]
                                                  [:target :any]
                                                  [:value :any]]]]
  "Adds `value` to parameters with `slug` matching a key in `merged-slug->value` and removes parameters without a
   `value`."
  [parameters slug->value]
  (when (seq parameters)
    (for [param parameters
          :let  [slug  (keyword (:slug param))
                 value (get slug->value slug)
                 ;; operator parameters expect a sequence of values so if we get a lone value (e.g. from a single URL
                 ;; query parameter) wrap it in a sequence
                 value (if (and (some? value)
                                (params.ops/operator? (:type param)))
                         (u/one-or-many value)
                         value)]
          :when (contains? slug->value slug)]
      (assoc (select-keys param [:type :target :slug])
             :value value))))

Returns parameters for a card (HUH?)

(defn- resolve-card-parameters
   ; TODO - better docstring
  [card-or-id]
  (-> (t2/select-one [Card :dataset_query :parameters], :id (u/the-id card-or-id))
      api.public/combine-parameters-and-template-tags
      :parameters))
(mu/defn ^:private resolve-dashboard-parameters :- [:sequential api.dashboard/ParameterWithID]
  "Given a `dashboard-id` and parameters map in the format `slug->value`, return a sequence of parameters with `:id`s
  that can be passed to various functions in the `metabase.api.dashboard` namespace such as
  [[metabase.api.dashboard/run-query-for-dashcard-async]]."
  [dashboard-id :- ms/PositiveInt
   slug->value  :- :map]
  (let [parameters (t2/select-one-fn :parameters Dashboard :id dashboard-id)
        slug->id   (into {} (map (juxt :slug :id)) parameters)]
    (vec (for [[slug value] slug->value
               :let         [slug (u/qualified-name slug)]]
           {:slug  slug
            :id    (or (get slug->id slug)
                       (throw (ex-info (tru "No matching parameter with slug {0}. Found: {1}" (pr-str slug) (pr-str (keys slug->id)))
                                       {:status-code          400
                                        :slug                 slug
                                        :dashboard-parameters parameters})))
            :value value}))))
(mu/defn ^:private normalize-query-params :- [:map-of :keyword :any]
  "Take a map of `query-params` and make sure they're in the right format for the rest of our code. Our
  `wrap-keyword-params` middleware normally converts all query params keys to keywords, but only if they seem like
  ones that make sense as keywords. Some params, such as ones that start with a number, do not pass this test, and are
  not automatically converted. Thus we must do it ourselves here to make sure things are done as we'd expect.
  Also, any param values that are blank strings should be parsed as nil, representing the absence of a value."
  [query-params]
  (-> query-params
      (update-keys keyword)
      (update-vals (fn [v] (if (= v ) nil v)))))

---------------------------- Card Fns used by both /api/embed and /api/preview_embed -----------------------------

Return the info needed for embedding about Card specified in token. Additional constraints can be passed to the public-card function that fetches the Card.

(defn card-for-unsigned-token
  [unsigned-token & {:keys [embedding-params constraints]}]
  {:pre [((some-fn empty? sequential?) constraints) (even? (count constraints))]}
  (let [card-id      (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :question])
        token-params (embed/get-in-unsigned-token-or-throw unsigned-token [:params])]
    (-> (apply api.public/public-card :id card-id, constraints)
        api.public/combine-parameters-and-template-tags
        (remove-token-parameters token-params)
        (remove-locked-and-disabled-params (or embedding-params
                                               (t2/select-one-fn :embedding_params Card :id card-id))))))

Run the query associated with Card with card-id using JWT token-params, user-supplied URL query-params, an embedding-params whitelist, and additional query options. Returns StreamingResponse that should be returned as the API endpoint result.

(defn run-query-for-card-with-params-async
  {:style/indent 0}
  [& {:keys [export-format card-id embedding-params token-params query-params qp-runner constraints options]
      :or   {qp-runner qp/process-query-and-save-execution!}}]
  {:pre [(integer? card-id) (u/maybe? map? embedding-params) (map? token-params) (map? query-params)]}
  (let [merged-slug->value (validate-and-merge-params embedding-params token-params (normalize-query-params query-params))
        parameters         (apply-slug->value (resolve-card-parameters card-id) merged-slug->value)]
    (m/mapply api.public/run-query-for-card-with-id-async
              card-id export-format parameters
              :context :embedded-question,
              :constraints constraints,
              :qp-runner qp-runner,
              options)))

-------------------------- Dashboard Fns used by both /api/embed and /api/preview_embed --------------------------

(defn- remove-linked-filters-param-values [dashboard]
  (let [param-ids (set (map :id (:parameters dashboard)))
        param-ids-to-remove (set (for [{param-id :id
                                        filtering-parameters :filteringParameters} (:parameters dashboard)
                                       filtering-parameter-id filtering-parameters
                                       :when (not (contains? param-ids filtering-parameter-id))]
                                   param-id))
        linked-field-ids (set (mapcat (params/get-linked-field-ids (:dashcards dashboard)) param-ids-to-remove))]
    (update dashboard :param_values #(->> %
                                          (map (fn [[param-id param]]
                                                 {param-id (cond-> param
                                                             (contains? linked-field-ids param-id) ;; is param linked?
                                                             (assoc :values []))}))
                                          (into {})))))
(defn- remove-locked-parameters [dashboard embedding-params]
  (let [params-to-remove (get-params-to-remove dashboard embedding-params)
        param-ids-to-remove (set (for [parameter (:parameters dashboard)
                                       :when     (contains? params-to-remove (keyword (:slug parameter)))]
                                   (:id parameter)))
        linked-field-ids (set (mapcat (params/get-linked-field-ids (:dashcards dashboard)) param-ids-to-remove))
        remove-parameters (fn [dashcard]
                            (update dashcard :parameter_mappings
                                    (fn [param-mappings]
                                      (remove (fn [{:keys [parameter_id]}]
                                                (contains? param-ids-to-remove parameter_id)) param-mappings))))]
    (-> dashboard
        (update :dashcards #(map remove-parameters %))
        (update :param_fields #(apply dissoc % linked-field-ids))
        (update :param_values #(apply dissoc % linked-field-ids)))))

Return the info needed for embedding about Dashboard specified in token. Additional constraints can be passed to the public-dashboard function that fetches the Dashboard.

(defn dashboard-for-unsigned-token
  [unsigned-token & {:keys [embedding-params constraints]}]
  {:pre [((some-fn empty? sequential?) constraints) (even? (count constraints))]}
  (let [dashboard-id (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :dashboard])
        embedding-params (or embedding-params
                             (t2/select-one-fn :embedding_params Dashboard, :id dashboard-id))
        token-params (embed/get-in-unsigned-token-or-throw unsigned-token [:params])]
    (-> (apply api.public/public-dashboard :id dashboard-id, constraints)
        (substitute-token-parameters-in-text token-params)
        (remove-locked-parameters embedding-params)
        (remove-token-parameters token-params)
        (remove-locked-and-disabled-params embedding-params)
        (remove-linked-filters-param-values))))

If a certain export-format is given, return the correct embedded dashboard context.

(defn- get-embed-dashboard-context
  [export-format]
  (case export-format
    "csv"  :embedded-csv-download
    "xlsx" :embedded-xlsx-download
    "json" :embedded-json-download
    :embedded-dashboard))

Return results for running the query belonging to a DashboardCard. Returns a StreamingResponse.

(defn dashcard-results-async
  {:style/indent 0}
  [& {:keys [dashboard-id dashcard-id card-id export-format embedding-params token-params middleware
             query-params constraints qp-runner]
      :or   {constraints (qp.constraints/default-query-constraints)
             qp-runner   qp/process-query-and-save-execution!}}]
  {:pre [(integer? dashboard-id) (integer? dashcard-id) (integer? card-id) (u/maybe? map? embedding-params)
         (map? token-params) (map? query-params)]}
  (let [slug->value (validate-and-merge-params embedding-params token-params (normalize-query-params query-params))
        parameters  (resolve-dashboard-parameters dashboard-id slug->value)]
    (api.public/public-dashcard-results-async
     :dashboard-id  dashboard-id
     :card-id       card-id
     :dashcard-id   dashcard-id
     :export-format export-format
     :parameters    parameters
     :qp-runner     qp-runner
     :context       (get-embed-dashboard-context export-format)
     :constraints   constraints
     :middleware    middleware)))

------------------------------------- Other /api/embed-specific utility fns --------------------------------------

Check that embedding is enabled, that object exists, and embedding for object is enabled.

(defn- check-embedding-enabled-for-object
  ([entity id]
   (api/check (pos-int? id)
     [400 (tru "{0} id should be a positive integer." (name entity))])
   (check-embedding-enabled-for-object (t2/select-one [entity :enable_embedding] :id id)))
  ([object]
   (validation/check-embedding-enabled)
   (api/check-404 object)
   (api/check-not-archived object)
   (api/check (:enable_embedding object)
     [400 (tru "Embedding is not enabled for this object.")])))

Runs check-embedding-enabled-for-object for a given Dashboard id

(def ^:private ^{:arglists '([dashboard-id])} check-embedding-enabled-for-dashboard
  (partial check-embedding-enabled-for-object Dashboard))

Runs check-embedding-enabled-for-object for a given Card id

(def ^:private ^{:arglists '([card-id])} check-embedding-enabled-for-card
  (partial check-embedding-enabled-for-object Card))

------------------------------------------- /api/embed/card endpoints --------------------------------------------

/card/:token

(api/defendpoint GET 
  "Fetch a Card via a JSON Web Token signed with the `embedding-secret-key`.
   Token should have the following format:
     {:resource {:question <card-id>}}"
  [token]
  (let [unsigned (embed/unsign token)]
    (check-embedding-enabled-for-card (embed/get-in-unsigned-token-or-throw unsigned [:resource :question]))
    (card-for-unsigned-token unsigned, :constraints [:enable_embedding true])))

Run the query belonging to Card identified by unsigned-token. Checks that embedding is enabled both globally and for this Card. Returns core.async channel to fetch the results.

(defn ^:private run-query-for-unsigned-token-async
  [unsigned-token export-format query-params & {:keys [constraints qp-runner]
                                                :or   {constraints (qp.constraints/default-query-constraints)
                                                       qp-runner   qp/process-query-and-save-execution!}
                                                :as   options}]
  (let [card-id (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :question])]
    (check-embedding-enabled-for-card card-id)
    (run-query-for-card-with-params-async
      :export-format     export-format
      :card-id           card-id
      :token-params      (embed/get-in-unsigned-token-or-throw unsigned-token [:params])
      :embedding-params  (t2/select-one-fn :embedding_params Card :id card-id)
      :query-params      query-params
      :qp-runner         qp-runner
      :constraints       constraints
      :options           options)))

/card/:token/query

(api/defendpoint GET 
  "Fetch the results of running a Card using a JSON Web Token signed with the `embedding-secret-key`.
   Token should have the following format:
     {:resource {:question <card-id>}
      :params   <parameters>}"
  [token & query-params]
  (run-query-for-unsigned-token-async (embed/unsign token) :api query-params))
(api/defendpoint GET ["/card/:token/query/:export-format", :export-format api.dataset/export-format-regex]
  "Like `GET /api/embed/card/query`, but returns the results as a file in the specified format."
  [token export-format :as {:keys [query-params]}]
  {export-format (into [:enum] api.dataset/export-formats)}
  (run-query-for-unsigned-token-async
   (embed/unsign token)
   export-format
   (m/map-keys keyword query-params)
   :constraints nil
   :middleware {:process-viz-settings? true
                :js-int-to-string?     false
                :format-rows?          false}))

----------------------------------------- /api/embed/dashboard endpoints -----------------------------------------

/dashboard/:token

(api/defendpoint GET 
  "Fetch a Dashboard via a JSON Web Token signed with the `embedding-secret-key`.
   Token should have the following format:
     {:resource {:dashboard <dashboard-id>}}"
  [token]
  (let [unsigned (embed/unsign token)]
    (check-embedding-enabled-for-dashboard (embed/get-in-unsigned-token-or-throw unsigned [:resource :dashboard]))
    (u/prog1 (dashboard-for-unsigned-token unsigned, :constraints [:enable_embedding true])
      (events/publish-event! :event/dashboard-read {:user-id api/*current-user-id*
                                                    :object <>}))))

Fetch the results of running a Card belonging to a Dashboard using a JSON Web Token signed with the embedding-secret-key.

Token should have the following format:

{:resource {:dashboard } :params }

Additional dashboard parameters can be provided in the query string, but params in the JWT token take precedence.

Returns a StreamingResponse.

(defn- dashcard-results-for-signed-token-async
  {:style/indent 1}
  [token dashcard-id card-id export-format query-params
   & {:keys [constraints qp-runner middleware]
      :or   {constraints (qp.constraints/default-query-constraints)
             qp-runner   qp/process-query-and-save-execution!}}]
  (let [unsigned-token (embed/unsign token)
        dashboard-id   (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :dashboard])]
    (check-embedding-enabled-for-dashboard dashboard-id)
    (dashcard-results-async
      :export-format    export-format
      :dashboard-id     dashboard-id
      :dashcard-id      dashcard-id
      :card-id          card-id
      :embedding-params (t2/select-one-fn :embedding_params Dashboard :id dashboard-id)
      :token-params     (embed/get-in-unsigned-token-or-throw unsigned-token [:params])
      :query-params     query-params
      :constraints      constraints
      :qp-runner        qp-runner
      :middleware       middleware)))

/dashboard/:token/dashcard/:dashcard-id/card/:card-id

(api/defendpoint GET 
  "Fetch the results of running a Card belonging to a Dashboard using a JSON Web Token signed with the
  `embedding-secret-key`"
  [token dashcard-id card-id & query-params]
  {dashcard-id ms/PositiveInt
   card-id     ms/PositiveInt}
  (dashcard-results-for-signed-token-async token dashcard-id card-id :api query-params))

+----------------------------------------------------------------------------------------------------------------+ | FieldValues, Search, Remappings | +----------------------------------------------------------------------------------------------------------------+

-------------------------------------------------- Field Values --------------------------------------------------

/card/:token/field/:field-id/values

(api/defendpoint GET 
  "Fetch FieldValues for a Field that is referenced by an embedded Card."
  [token field-id]
  {field-id ms/PositiveInt}
  (let [unsigned-token (embed/unsign token)
        card-id        (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :question])]
    (check-embedding-enabled-for-card card-id)
    (api.public/card-and-field-id->values card-id field-id)))

/dashboard/:token/field/:field-id/values

(api/defendpoint GET 
  "Fetch FieldValues for a Field that is used as a param in an embedded Dashboard."
  [token field-id]
  {field-id ms/PositiveInt}
  (let [unsigned-token (embed/unsign token)
        dashboard-id   (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :dashboard])]
    (check-embedding-enabled-for-dashboard dashboard-id)
    (api.public/dashboard-and-field-id->values dashboard-id field-id)))

--------------------------------------------------- Searching ----------------------------------------------------

/card/:token/field/:field-id/search/:search-field-id

(api/defendpoint GET 
  "Search for values of a Field that is referenced by an embedded Card."
  [token field-id search-field-id value limit]
  {field-id        ms/PositiveInt
   search-field-id ms/PositiveInt
   value           ms/NonBlankString
   limit           [:maybe ms/PositiveInt]}
  (let [unsigned-token (embed/unsign token)
        card-id        (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :question])]
    (check-embedding-enabled-for-card card-id)
    (api.public/search-card-fields card-id field-id search-field-id value (when limit (Integer/parseInt limit)))))

/dashboard/:token/field/:field-id/search/:search-field-id

(api/defendpoint GET 
  "Search for values of a Field that is referenced by a Card in an embedded Dashboard."
  [token field-id search-field-id value limit]
  {field-id        ms/PositiveInt
   search-field-id ms/PositiveInt
   value           ms/NonBlankString
   limit           [:maybe ms/PositiveInt]}
  (let [unsigned-token (embed/unsign token)
        dashboard-id   (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :dashboard])]
    (check-embedding-enabled-for-dashboard dashboard-id)
    (api.public/search-dashboard-fields dashboard-id field-id search-field-id value (when limit
                                                                                      (Integer/parseInt limit)))))

--------------------------------------------------- Remappings ---------------------------------------------------

/card/:token/field/:field-id/remapping/:remapped-id

(api/defendpoint GET 
  "Fetch remapped Field values. This is the same as `GET /api/field/:id/remapping/:remapped-id`, but for use with
  embedded Cards."
  [token field-id remapped-id value]
  {field-id    ms/PositiveInt
   remapped-id ms/PositiveInt
   value       ms/NonBlankString}
  (let [unsigned-token (embed/unsign token)
        card-id        (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :question])]
    (check-embedding-enabled-for-card card-id)
    (api.public/card-field-remapped-values card-id field-id remapped-id value)))

/dashboard/:token/field/:field-id/remapping/:remapped-id

(api/defendpoint GET 
  "Fetch remapped Field values. This is the same as `GET /api/field/:id/remapping/:remapped-id`, but for use with
  embedded Dashboards."
  [token field-id remapped-id value]
  {field-id    ms/PositiveInt
   remapped-id ms/PositiveInt
   value       ms/NonBlankString}
  (let [unsigned-token (embed/unsign token)
        dashboard-id   (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :dashboard])]
    (check-embedding-enabled-for-dashboard dashboard-id)
    (api.public/dashboard-field-remapped-values dashboard-id field-id remapped-id value)))
(api/defendpoint GET ["/dashboard/:token/dashcard/:dashcard-id/card/:card-id/:export-format"
                                         :export-format api.dataset/export-format-regex]
  "Fetch the results of running a Card belonging to a Dashboard using a JSON Web Token signed with the
  `embedding-secret-key` return the data in one of the export formats"
  [token export-format dashcard-id card-id, :as {:keys [query-params]}]
  {dashcard-id   ms/PositiveInt
   card-id       ms/PositiveInt
   export-format (into [:enum] api.dataset/export-formats)}
  (dashcard-results-for-signed-token-async token
    dashcard-id
    card-id
    export-format
    (m/map-keys keyword query-params)
    :constraints nil
    :middleware {:process-viz-settings? true
                 :js-int-to-string?     false
                 :format-rows?          false}))

----------------------------------------------- Param values -------------------------------------------------

embedding parameters in :embedding_params and the JWT are keyed by :slug; the chain filter endpoints instead key by :id. So we need to do a little conversion back and forth below.

variables whose name includes id- e.g. id-query-params below are ones that are keyed by ID; ones whose name includes slug- are keyed by slug.

(mu/defn ^:private param-values-merged-params :- [:map-of ms/NonBlankString :any]
  [id->slug slug->id embedding-params token-params id-query-params]
  (let [slug-query-params  (into {}
                                 (for [[id v] id-query-params]
                                   [(or (get id->slug (name id))
                                        (throw (ex-info (tru "Invalid query params: could not determine slug for parameter with ID {0}"
                                                             (pr-str id))
                                                        {:id              (name id)
                                                         :id->slug        id->slug
                                                         :id-query-params id-query-params})))
                                    v]))
        slug-query-params  (normalize-query-params slug-query-params)
        merged-slug->value (validate-and-merge-params embedding-params token-params slug-query-params)]
    (into {} (for [[slug value] merged-slug->value]
               [(get slug->id (name slug)) value]))))

Search for card parameter values. Does security checks to ensure the parameter is on the card and then gets param values according to [[api.card/param-values]].

(defn card-param-values
  [{:keys [unsigned-token card param-key search-prefix]}]
  (let [slug-token-params   (embed/get-in-unsigned-token-or-throw unsigned-token [:params])
        parameters          (or (seq (:parameters card))
                                (card/template-tag-parameters card))
        id->slug            (into {} (map (juxt :id :slug) parameters))
        slug->id            (into {} (map (juxt :slug :id) parameters))
        searched-param-slug (get id->slug param-key)
        embedding-params    (:embedding_params card)]
    (try
      (when-not (= (get embedding-params (keyword searched-param-slug)) "enabled")
        (throw (ex-info (tru "Cannot search for values: {0} is not an enabled parameter."
                             (pr-str searched-param-slug))
                        {:status-code 400})))
      (when (get slug-token-params (keyword searched-param-slug))
        (throw (ex-info (tru "You can''t specify a value for {0} if it's already set in the JWT." (pr-str searched-param-slug))
                        {:status-code 400})))
      (try
        (binding [api/*current-user-permissions-set* (atom #{"/"})]
          (api.card/param-values card param-key search-prefix))
        (catch Throwable e
          (throw (ex-info (.getMessage e)
                          {:card-id       (u/the-id card)
                           :param-key     param-key
                           :search-prefix search-prefix}
                          e))))
      (catch Throwable e
        (let [e (ex-info (.getMessage e)
                         {:card-id (u/the-id card)
                          :card-params (:parametres card)
                          :allowed-param-slugs embedding-params
                          :slug->id            slug->id
                          :id->slug            id->slug
                          :param-id            param-key
                          :param-slug          searched-param-slug
                          :token-params        slug-token-params}
                         e)]
          (log/errorf e "embedded card-param-values error\n%s"
                      (u/pprint-to-str (u/all-ex-data e)))
          (throw e))))))
(defn- dashboard-param-values [token searched-param-id prefix id-query-params]
  (let [unsigned-token                       (embed/unsign token)
        dashboard-id                         (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :dashboard])
        _                                    (check-embedding-enabled-for-dashboard dashboard-id)
        slug-token-params                    (embed/get-in-unsigned-token-or-throw unsigned-token [:params])
        {parameters       :parameters
         embedding-params :embedding_params} (t2/select-one Dashboard :id dashboard-id)
        id->slug                             (into {} (map (juxt :id :slug) parameters))
        slug->id                             (into {} (map (juxt :slug :id) parameters))
        searched-param-slug                  (get id->slug searched-param-id)]
    (try
      ;; you can only search for values of a parameter if it is ENABLED and NOT PRESENT in the JWT.
      (when-not (= (get embedding-params (keyword searched-param-slug)) "enabled")
        (throw (ex-info (tru "Cannot search for values: {0} is not an enabled parameter." (pr-str searched-param-slug))
                        {:status-code 400})))
      (when (get slug-token-params (keyword searched-param-slug))
        (throw (ex-info (tru "You can''t specify a value for {0} if it's already set in the JWT." (pr-str searched-param-slug))
                        {:status-code 400})))
      ;; ok, at this point we can run the query
      (let [merged-id-params (param-values-merged-params id->slug slug->id embedding-params slug-token-params id-query-params)]
        (try
          (binding [api/*current-user-permissions-set* (atom #{"/"})]
            (api.dashboard/param-values (t2/select-one Dashboard :id dashboard-id) searched-param-id merged-id-params prefix))
          (catch Throwable e
            (throw (ex-info (.getMessage e)
                            {:merged-id-params merged-id-params}
                            e)))))
      (catch Throwable e
        (let [e (ex-info (.getMessage e)
                         {:dashboard-id        dashboard-id
                          :dashboard-params    parameters
                          :allowed-param-slugs embedding-params
                          :slug->id            slug->id
                          :id->slug            id->slug
                          :param-id            searched-param-id
                          :param-slug          searched-param-slug
                          :token-params        slug-token-params}
                         e)]
          (log/errorf e "Chain filter error\n%s" (u/pprint-to-str (u/all-ex-data e)))
          (throw e))))))

/dashboard/:token/params/:param-key/values

(api/defendpoint GET 
  "Embedded version of chain filter values endpoint."
  [token param-key :as {:keys [query-params]}]
  (dashboard-param-values token param-key nil query-params))

/dashboard/:token/params/:param-key/search/:prefix

(api/defendpoint GET 
  "Embedded version of chain filter search endpoint."
  [token param-key prefix :as {:keys [query-params]}]
  (dashboard-param-values token param-key prefix query-params))

/card/:token/params/:param-key/values

(api/defendpoint GET 
  "Embedded version of api.card filter values endpoint."
  [token param-key]
  (let [unsigned (embed/unsign token)
        card-id  (embed/get-in-unsigned-token-or-throw unsigned [:resource :question])
        card     (t2/select-one Card :id card-id)]
    (check-embedding-enabled-for-card card-id)
    (card-param-values {:unsigned-token unsigned
                        :card           card
                        :param-key      param-key})))

/card/:token/params/:param-key/search/:prefix

(api/defendpoint GET 
  "Embedded version of chain filter search endpoint."
  [token param-key prefix]
  (let [unsigned (embed/unsign token)
        card-id  (embed/get-in-unsigned-token-or-throw unsigned [:resource :question])
        card     (t2/select-one Card :id card-id)]
    (check-embedding-enabled-for-card card-id)
    (card-param-values {:unsigned-token unsigned
                        :card           card
                        :param-key      param-key
                        :search-prefix  prefix})))

/pivot/card/:token/query

(api/defendpoint GET 
  "Fetch the results of running a Card using a JSON Web Token signed with the `embedding-secret-key`.
   Token should have the following format:
     {:resource {:question <card-id>}
      :params   <parameters>}"
  [token & query-params]
  (run-query-for-unsigned-token-async (embed/unsign token) :api query-params :qp-runner qp.pivot/run-pivot-query))

/pivot/dashboard/:token/dashcard/:dashcard-id/card/:card-id

(api/defendpoint GET 
  "Fetch the results of running a Card belonging to a Dashboard using a JSON Web Token signed with the
  `embedding-secret-key`"
  [token dashcard-id card-id & query-params]
  {dashcard-id ms/PositiveInt
   card-id ms/PositiveInt}
  (dashcard-results-for-signed-token-async token dashcard-id card-id :api query-params :qp-runner qp.pivot/run-pivot-query))
(api/define-routes)
 
(ns metabase.api.field
  (:require
   [clojure.string :as str]
   [compojure.core :refer [DELETE GET POST PUT]]
   [metabase.api.common :as api]
   [metabase.db.metadata-queries :as metadata-queries]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.models.dimension :refer [Dimension]]
   [metabase.models.field :as field :refer [Field]]
   [metabase.models.field-values :as field-values :refer [FieldValues]]
   [metabase.models.interface :as mi]
   [metabase.models.params.chain-filter :as chain-filter]
   [metabase.models.params.field-values :as params.field-values]
   [metabase.models.permissions :as perms]
   [metabase.models.table :as table :refer [Table]]
   [metabase.query-processor :as qp]
   [metabase.related :as related]
   [metabase.server.middleware.offset-paging :as mw.offset-paging]
   [metabase.sync :as sync]
   [metabase.sync.concurrent :as sync.concurrent]
   [metabase.types :as types]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2])
  (:import
   (java.text NumberFormat)))
(set! *warn-on-reflection* true)

--------------------------------------------- Basic CRUD Operations ----------------------------------------------

(def ^:private default-max-field-search-limit 1000)

Schema for a valid Field visibility type.

(def ^:private FieldVisibilityType
  (into [:enum] (map name field/visibility-types)))

Does the Current User have segmented query permissions for table?

(defn- has-segmented-query-permissions?
  [table]
  (perms/set-has-full-permissions? @api/*current-user-permissions-set*
    (perms/table-sandboxed-query-path table)))

Validates that the user either has full read permissions for field or segmented permissions on the table associated with field. Throws an exception that will return a 403 if not.

(defn- throw-if-no-read-or-segmented-perms
  [field]
  (when-not (or (mi/can-read? field)
                (has-segmented-query-permissions? (field/table field)))
    (api/throw-403)))

/:id

(api/defendpoint GET 
  "Get `Field` with ID."
  [id include_editable_data_model]
  {id                          ms/PositiveInt
   include_editable_data_model ms/BooleanValue}
  (let [field                       (-> (api/check-404 (t2/select-one Field :id id))
                                        (t2/hydrate [:table :db] :has_field_values :dimensions :name_field))
        field                       (if include_editable_data_model
                                      (field/hydrate-target-with-write-perms field)
                                      (t2/hydrate field :target))]
    ;; Normal read perms = normal access.
    ;;
    ;; There's also a special case where we allow you to fetch a Field even if you don't have full read permissions for
    ;; it: if you have segmented query access to the Table it belongs to. In this case, we'll still let you fetch the
    ;; Field, since this is required to power features like Dashboard filters, but we'll treat this Field a little
    ;; differently in other endpoints such as the FieldValues fetching endpoint.
    ;;
    ;; Check for permissions and throw 403 if we don't have them...
    (if include_editable_data_model
      (api/write-check Table (:table_id field))
      (throw-if-no-read-or-segmented-perms field))
    ;; ...but if we do, return the Field <3
    field))
(defn- clear-dimension-on-fk-change! [{:keys [dimensions], :as _field}]
  (doseq [{dimension-id :id, dimension-type :type} dimensions]
    (when (and dimension-id (= :external dimension-type))
      (t2/delete! Dimension :id dimension-id))))
(defn- removed-fk-semantic-type? [old-semantic-type new-semantic-type]
  (and (not= old-semantic-type new-semantic-type)
       (isa? old-semantic-type :type/FK)
       (or (nil? new-semantic-type)
           (not (isa? new-semantic-type :type/FK)))))
(defn- internal-remapping-allowed? [base-type semantic-type]
  (and (isa? base-type :type/Integer)
       (or
        (nil? semantic-type)
        (isa? semantic-type :type/Category)
        (isa? semantic-type :type/Enum))))

Removes a related dimension if the field is moving to a type that does not support remapping

(defn- clear-dimension-on-type-change!
  [{:keys [dimensions], :as _old-field} base-type new-semantic-type]
  (doseq [{old-dim-id :id, old-dim-type :type} dimensions]
    (when (and old-dim-id
               (= :internal old-dim-type)
               (not (internal-remapping-allowed? base-type new-semantic-type)))
      (t2/delete! Dimension :id old-dim-id))))

If JSON unfolding was enabled for a JSON field, it activates previously synced nested fields from the JSON field. If JSON unfolding was disabled for that field, it inactivates the nested fields from the JSON field. Returns nil.

(defn- update-nested-fields-on-json-unfolding-change!
  [old-field new-json-unfolding]
  (when (not= new-json-unfolding (:json_unfolding old-field))
    (if new-json-unfolding
      (let [update-result (t2/update! Field
                                      :table_id (:table_id old-field)
                                      :nfc_path [:like (str "[\"" (:name old-field) "\",%]")]
                                      {:active true})]
        (when (zero? update-result)
          ;; Sync the table if no nested fields exist. This means the table hasn't previously
          ;; been synced when JSON unfolding was enabled. This assumes the JSON field is already updated to have
          ;; JSON unfolding enabled.
          (let [table (field/table old-field)]
            (sync.concurrent/submit-task (fn [] (sync/sync-table! table))))))
      (t2/update! Field
                  :table_id (:table_id old-field)
                  :nfc_path [:like (str "[\"" (:name old-field) "\",%]")]
                  {:active false})))
  nil)

/:id

(api/defendpoint PUT 
  "Update `Field` with ID."
  [id :as {{:keys [caveats description display_name fk_target_field_id points_of_interest semantic_type
                   coercion_strategy visibility_type has_field_values settings nfc_path json_unfolding]
            :as   body} :body}]
  {id                 ms/PositiveInt
   caveats            [:maybe ms/NonBlankString]
   description        [:maybe ms/NonBlankString]
   display_name       [:maybe ms/NonBlankString]
   fk_target_field_id [:maybe ms/PositiveInt]
   points_of_interest [:maybe ms/NonBlankString]
   semantic_type      [:maybe ms/FieldSemanticOrRelationTypeKeywordOrString]
   coercion_strategy  [:maybe ms/CoercionStrategyKeywordOrString]
   visibility_type    [:maybe FieldVisibilityType]
   has_field_values   [:maybe ::lib.schema.metadata/column.has-field-values]
   settings           [:maybe ms/Map]
   nfc_path           [:maybe [:sequential ms/NonBlankString]]
   json_unfolding     [:maybe :boolean]}
  (let [field             (t2/hydrate (api/write-check Field id) :dimensions)
        new-semantic-type (keyword (get body :semantic_type (:semantic_type field)))
        [effective-type coercion-strategy]
        (or (when-let [coercion_strategy (keyword coercion_strategy)]
              (let [effective (types/effective-type-for-coercion coercion_strategy)]
                ;; throw an error in an else branch?
                (when (types/is-coercible? coercion_strategy (:base_type field) effective)
                  [effective coercion_strategy])))
            [(:base_type field) nil])
        removed-fk?        (removed-fk-semantic-type? (:semantic_type field) new-semantic-type)
        fk-target-field-id (get body :fk_target_field_id (:fk_target_field_id field))]
    ;; validate that fk_target_field_id is a valid Field
    ;; TODO - we should also check that the Field is within the same database as our field
    (when fk-target-field-id
      (api/checkp (t2/exists? Field :id fk-target-field-id)
        :fk_target_field_id "Invalid target field"))
    (when (and display_name
               (not removed-fk?)
               (not= (:display_name field) display_name))
      (t2/update! Dimension :field_id id {:name display_name}))
    ;; everything checks out, now update the field
    (api/check-500
     (t2/with-transaction [_conn]
       (when removed-fk?
         (clear-dimension-on-fk-change! field))
       (clear-dimension-on-type-change! field (:base_type field) new-semantic-type)
       (t2/update! Field id
                   (u/select-keys-when (assoc body
                                              :fk_target_field_id (when-not removed-fk? fk-target-field-id)
                                              :effective_type effective-type
                                              :coercion_strategy coercion-strategy)
                                       :present #{:caveats :description :fk_target_field_id :points_of_interest :semantic_type :visibility_type
                                                  :coercion_strategy :effective_type :has_field_values :nfc_path :json_unfolding}
                                       :non-nil #{:display_name :settings}))))
    (when (some? json_unfolding)
      (update-nested-fields-on-json-unfolding-change! field json_unfolding))
    ;; return updated field. note the fingerprint on this might be out of date if the task below would replace them
    ;; but that shouldn't matter for the datamodel page
    (u/prog1 (-> (t2/select-one Field :id id)
                 (t2/hydrate :dimensions :has_field_values)
                 (field/hydrate-target-with-write-perms))
      (when (not= effective-type (:effective_type field))
        (sync.concurrent/submit-task (fn [] (sync/refingerprint-field! <>)))))))

------------------------------------------------- Field Metadata -------------------------------------------------

/:id/summary

(api/defendpoint GET 
  "Get the count and distinct count of `Field` with ID."
  [id]
  {id ms/PositiveInt}
  (let [field (api/read-check Field id)]
    [[:count     (metadata-queries/field-count field)]
     [:distincts (metadata-queries/field-distinct-count field)]]))

--------------------------------------------------- Dimensions ---------------------------------------------------

/:id/dimension

(api/defendpoint POST 
  "Sets the dimension for the given field at ID"
  [id :as {{dimension-type :type, dimension-name :name, human_readable_field_id :human_readable_field_id} :body}]
  {id                      ms/PositiveInt
   dimension-type          [:enum "internal" "external"]
   dimension-name          ms/NonBlankString
   human_readable_field_id [:maybe ms/PositiveInt]}
  (api/write-check Field id)
  (api/check (or (= dimension-type "internal")
                 (and (= dimension-type "external")
                      human_readable_field_id))
             [400 "Foreign key based remappings require a human readable field id"])
  (if-let [dimension (t2/select-one Dimension :field_id id)]
    (t2/update! Dimension (u/the-id dimension)
                {:type                    dimension-type
                 :name                    dimension-name
                 :human_readable_field_id human_readable_field_id})
    (t2/insert! Dimension
                {:field_id                id
                 :type                    dimension-type
                 :name                    dimension-name
                 :human_readable_field_id human_readable_field_id}))
  (t2/select-one Dimension :field_id id))

/:id/dimension

(api/defendpoint DELETE 
  "Remove the dimension associated to field at ID"
  [id]
  {id ms/PositiveInt}
  (api/write-check Field id)
  (t2/delete! Dimension :field_id id)
  api/generic-204-no-content)

-------------------------------------------------- FieldValues ---------------------------------------------------

(def ^:private empty-field-values
  {:values []})
(declare search-values)
(mu/defn field->values :- ms/FieldValuesResult
  "Fetch FieldValues, if they exist, for a `field` and return them in an appropriate format for public/embedded
  use-cases."
  [{has-field-values-type :has_field_values, field-id :id, has_more_values :has_more_values, :as field}]
  ;; TODO: explain why using remapped fields is restricted to `has_field_values=list`
  (if-let [remapped-field-id (when (= has-field-values-type :list)
                               (chain-filter/remapped-field-id field-id))]
    {:values          (search-values (api/check-404 field)
                                     (api/check-404 (t2/select-one Field :id remapped-field-id)))
     :field_id        field-id
     :has_more_values (boolean has_more_values)}
    (params.field-values/get-or-create-field-values-for-current-user! (api/check-404 field))))
(mu/defn search-values-from-field-id :- ms/FieldValuesResult
  "Search for values of a field given by `field-id` that contain `query`."
  [field-id query]
  (let [field        (api/read-check (t2/select-one Field :id field-id))
        search-field (or (some->> (chain-filter/remapped-field-id field-id)
                                  (t2/select-one Field :id))
                         field)]
    {:values          (search-values field search-field query)
     ;; assume there are more if doing a search, otherwise there are no more values
     :has_more_values (not (str/blank? query))
     :field_id        field-id}))

/:id/values

(api/defendpoint GET 
  "If a Field's value of `has_field_values` is `:list`, return a list of all the distinct values of the Field (or
  remapped Field), and (if defined by a User) a map of human-readable remapped values. If `has_field_values` is not
  `:list`, checks whether we should create FieldValues for this Field; if so, creates and returns them."
  [id]
  {id ms/PositiveInt}
  (let [field (api/read-check (t2/select-one Field :id id))]
    (field->values field)))

/field%2C:field-name%2C:options/values

match things like GET /field%2Ccreated_at%2options (this is how things like [field,created_at,{:base-type,:type/Datetime}] look when URL-encoded)

(api/defendpoint GET 
  "Implementation of the field values endpoint for fields in the Saved Questions 'virtual' DB. This endpoint is just a
  convenience to simplify the frontend code. It just returns the standard 'empty' field values response."
  ;; we don't actually care what field-name or field-type are, so they're ignored
  [_ _]
  empty-field-values)

Human readable values are optional, but if present they must be present for each field value. Throws if invalid, returns a boolean indicating whether human readable values were found.

(defn- validate-human-readable-pairs
  [value-pairs]
  (let [human-readable-missing? #(= ::not-found (get % 1 ::not-found))
        has-human-readable-values? (not-any? human-readable-missing? value-pairs)]
    (api/check (or has-human-readable-values?
                   (every? human-readable-missing? value-pairs))
      [400 "If remapped values are specified, they must be specified for all field values"])
    has-human-readable-values?))
(defn- update-field-values! [field-value-id value-pairs]
  (let [human-readable-values? (validate-human-readable-pairs value-pairs)]
    (api/check-500 (pos? (t2/update! FieldValues field-value-id
                                     {:values (map first value-pairs)
                                      :human_readable_values (when human-readable-values?
                                                               (map second value-pairs))})))))
(defn- create-field-values!
  [field-or-id value-pairs]
  (let [human-readable-values? (validate-human-readable-pairs value-pairs)]
    (t2/insert! FieldValues
                :type :full
                :field_id (u/the-id field-or-id)
                :values (map first value-pairs)
                :human_readable_values (when human-readable-values?
                                         (map second value-pairs)))))

/:id/values

(api/defendpoint POST 
  "Update the fields values and human-readable values for a `Field` whose semantic type is
  `category`/`city`/`state`/`country` or whose base type is `type/Boolean`. The human-readable values are optional."
  [id :as {{value-pairs :values} :body}]
  {id          ms/PositiveInt
   value-pairs [:sequential [:or [:tuple :any] [:tuple :any ms/NonBlankString]]]}
  (let [field (api/write-check Field id)]
    (api/check (field-values/field-should-have-field-values? field)
      [400 (str "You can only update the human readable values of a mapped values of a Field whose value of "
                "`has_field_values` is `list` or whose 'base_type' is 'type/Boolean'.")])
    (if-let [field-value-id (t2/select-one-pk FieldValues, :field_id id :type :full)]
      (update-field-values! field-value-id value-pairs)
      (create-field-values! field value-pairs)))
  {:status :success})

/:id/rescan_values

(api/defendpoint POST 
  "Manually trigger an update for the FieldValues for this Field. Only applies to Fields that are eligible for
   FieldValues."
  [id]
  {id ms/PositiveInt}
  (let [field (api/write-check (t2/select-one Field :id id))]
    ;; Override *current-user-permissions-set* so that permission checks pass during sync. If a user has DB detail perms
    ;; but no data perms, they should stll be able to trigger a sync of field values. This is fine because we don't
    ;; return any actual field values from this API. (#21764)
    (binding [api/*current-user-permissions-set* (atom #{"/"})]
      (field-values/create-or-update-full-field-values! field)))
  {:status :success})

/:id/discard_values

(api/defendpoint POST 
  "Discard the FieldValues belonging to this Field. Only applies to fields that have FieldValues. If this Field's
   Database is set up to automatically sync FieldValues, they will be recreated during the next cycle."
  [id]
  {id ms/PositiveInt}
  (field-values/clear-field-values-for-field! (api/write-check (t2/select-one Field :id id)))
  {:status :success})

--------------------------------------------------- Searching ----------------------------------------------------

(defn- table-id [field]
  (u/the-id (:table_id field)))
(defn- db-id [field]
  (u/the-id (t2/select-one-fn :db_id Table :id (table-id field))))

Automatically follow the target IDs in an FK field until we reach the PK it points to, and return that. For non-FK Fields, returns them as-is. For example, with the Sample Database:

(follow-fks <PEOPLE.ID Field>) ;-> <PEOPLE.ID Field> (follow-fks <REVIEWS.REVIEWER Field>) ;-> <PEOPLE.ID Field>

This is used below to seamlessly handle either PK or FK Fields without having to think about which is which in the search-values and remapped-value functions.

(defn- follow-fks
  [{semantic-type :semantic_type, fk-target-field-id :fk_target_field_id, :as field}]
  (if (and (isa? semantic-type :type/FK)
           fk-target-field-id)
    (t2/select-one Field :id fk-target-field-id)
    field))

Generate the MBQL query used to power FieldValues search in [[search-values]] below. The actual query generated differs slightly based on whether the two Fields are the same Field.

Note: the generated MBQL query assume that both field and search-field are from the same table.

(defn- search-values-query
  [field search-field value limit]
  {:database (db-id field)
   :type     :query
   :query    {:source-table (table-id field)
              :filter       (when (some? value)
                              [:contains [:field (u/the-id search-field) nil] value {:case-sensitive false}])
              ;; if both fields are the same then make sure not to refer to it twice in the `:breakout` clause.
              ;; Otherwise this will break certain drivers like BigQuery that don't support duplicate
              ;; identifiers/aliases
              :breakout     (if (= (u/the-id field) (u/the-id search-field))
                              [[:field (u/the-id field) nil]]
                              [[:field (u/the-id field) nil]
                               [:field (u/the-id search-field) nil]])
              :limit        limit}})
(mu/defn search-values :- [:maybe ms/FieldValuesList]
  "Search for values of `search-field` that contain `value` (up to `limit`, if specified), and return pairs like
      [<value-of-field> <matching-value-of-search-field>].
   If `search-field` and `field` are the same, simply return 1-tuples like
      [<matching-value-of-field>].
   For example, with the Sample Database, you could search for the first three IDs & names of People whose name
  contains `Ma` as follows:
      (search-values <PEOPLE.ID Field> <PEOPLE.NAME Field> \"Ma\" 3)
      ;; -> ((14 \"Marilyne Mohr\")
             (36 \"Margot Farrell\")
             (48 \"Maryam Douglas\"))"
  ([field search-field]
   (search-values field search-field nil nil))
  ([field search-field value]
   (search-values field search-field value nil))
  ([field
    search-field
    value        :- [:maybe ms/NonBlankString]
    maybe-limit  :- [:maybe ms/PositiveInt]]
   (try
    (let [field        (follow-fks field)
          search-field (follow-fks search-field)
          limit        (or maybe-limit default-max-field-search-limit)
          results      (qp/process-query (search-values-query field search-field value limit))]
      (get-in results [:data :rows]))
    (catch Throwable e
      (log/error e (trs "Error searching field values"))
      nil))))

/:id/search/:search-id

(api/defendpoint GET 
  "Search for values of a Field with `search-id` that start with `value`. See docstring for
  `metabase.api.field/search-values` for a more detailed explanation."
  [id search-id value]
  {id        ms/PositiveInt
   search-id ms/PositiveInt
   value     ms/NonBlankString}
  (let [field        (api/check-404 (t2/select-one Field :id id))
        search-field (api/check-404 (t2/select-one Field :id search-id))]
    (throw-if-no-read-or-segmented-perms field)
    (throw-if-no-read-or-segmented-perms search-field)
    (search-values field search-field value mw.offset-paging/*limit*)))

Search for one specific remapping where the value of field exactly matches value. Returns a pair like

[<value-of-field> <value-of-remapped-field>]

if a match is found.

For example, with the Sample Database, you could find the name of the Person with ID 20 as follows:

(remapped-value <PEOPLE.ID Field> <PEOPLE.NAME Field> 20)
;; -> [20 "Peter Watsica"]
(defn remapped-value
  [field remapped-field value]
  (try
    (let [field   (follow-fks field)
          results (qp/process-query
                   {:database (db-id field)
                    :type     :query
                    :query    {:source-table (table-id field)
                               :filter       [:= [:field (u/the-id field) nil] value]
                               :fields       [[:field (u/the-id field) nil]
                                              [:field (u/the-id remapped-field) nil]]
                               :limit        1}})]
      ;; return first row if it exists
      (first (get-in results [:data :rows])))
    ;; as with fn above this error can usually be safely ignored which is why log level is log/debug
    (catch Throwable e
      (log/debug e (trs "Error searching for remapping"))
      nil)))

Parse a value passed as a URL query param in a way appropriate for the field it belongs to. E.g. for text Fields the value doesn't need to be parsed; for numeric Fields we should parse it as a number.

(defn parse-query-param-value-for-field
  [field ^String value]
  (if (isa? (:base_type field) :type/Number)
    (.parse (NumberFormat/getInstance) value)
    value))

/:id/remapping/:remapped-id

(api/defendpoint GET 
  "Fetch remapped Field values."
  [id remapped-id value]
  {id          ms/PositiveInt
   remapped-id ms/PositiveInt
   value       ms/NonBlankString}
  (let [field          (api/read-check Field id)
        remapped-field (api/read-check Field remapped-id)
        value          (parse-query-param-value-for-field field value)]
    (remapped-value field remapped-field value)))

/:id/related

(api/defendpoint GET 
  "Return related entities."
  [id]
  {id ms/PositiveInt}
  (-> (t2/select-one Field :id id) api/read-check related/related))
(api/define-routes)
 
(ns metabase.api.geojson
  (:require
   [clj-http.client :as http]
   [clojure.java.io :as io]
   [compojure.core :refer [GET]]
   [malli.core :as mc]
   [metabase.api.common :as api]
   [metabase.api.common.validation :as validation]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.util.i18n :refer [deferred-tru tru]]
   [metabase.util.malli.schema :as ms]
   [ring.util.codec :as codec]
   [ring.util.response :as response])
  (:import
   (java.io BufferedReader)
   (java.net InetAddress URL)
   (org.apache.commons.io.input ReaderInputStream)))
(set! *warn-on-reflection* true)
(defsetting custom-geojson-enabled
  (deferred-tru "Whether or not the use of custom GeoJSON is enabled.")
  :visibility :admin
  :type       :boolean
  :setter     :none
  :default    true
  :audit      :getter)
(def ^:private CustomGeoJSON
  [:map-of :keyword [:map {:closed true}
                     [:name                         ms/NonBlankString]
                     [:url                          ms/NonBlankString]
                     [:region_key                   [:maybe :string]]
                     [:region_name                  [:maybe :string]]
                     [:builtin     {:optional true} :boolean]]])
(def ^:private CustomGeoJSONValidator (mc/validator CustomGeoJSON))
(def ^:private builtin-geojson
  {:us_states       {:name        "United States"
                     :url         "app/assets/geojson/us-states.json"
                     :region_key  "STATE"
                     :region_name "NAME"
                     :builtin     true}
   :world_countries {:name        "World"
                     :url         "app/assets/geojson/world.json"
                     :region_key  "ISO_A2"
                     :region_name "NAME"
                     :builtin     true}})
(defn- invalid-location-msg []
  (str (tru "Invalid GeoJSON file location: must either start with http:// or https:// or be a relative path to a file on the classpath.")
       " "
       (tru "URLs referring to hosts that supply internal hosting metadata are prohibited.")))
(def ^:private invalid-hosts
  #{"metadata.google.internal"}) ; internal metadata for GCP
(defn- valid-host?
  [^URL url]
  (let [host (.getHost url)
        host->url (fn [host] (URL. (str "http://" host)))
        base-url  (host->url (.getHost url))]
    (and (not-any? (fn [invalid-url] (.equals ^URL base-url invalid-url))
                   (map host->url invalid-hosts))
         (not (.isLinkLocalAddress (InetAddress/getByName host))))))
(defn- valid-protocol?
  [^URL url]
  (#{"http" "https"} (.getProtocol url)))
(defn- valid-url?
  [url-string]
  (try
    (let [url (URL. url-string)]
      (and (valid-protocol? url)
           (valid-host? url)))
    (catch Throwable e
      (throw (ex-info (invalid-location-msg) {:status-code 400, :url url-string} e)))))
(defn- valid-geojson-url?
  [url]
  (or (io/resource url)
      (valid-url? url)))
(defn- valid-geojson-urls?
  [geojson]
  (every? (fn [[_ {:keys [url]}]] (valid-geojson-url? url))
          geojson))

Throws a 400 if the supplied geojson is poorly structured or has an illegal URL/path

(defn- validate-geojson
  [geojson]
  (when-not (CustomGeoJSONValidator geojson)
    (throw (ex-info (tru "Invalid custom GeoJSON") {:status-code 400})))
  (or (valid-geojson-urls? geojson)
      (throw (ex-info (invalid-location-msg) {:status-code 400}))))
(defsetting custom-geojson
  (deferred-tru "JSON containing information about custom GeoJSON files for use in map visualizations instead of the default US State or World GeoJSON.")
  :type    :json
  :default {}
  :getter  (fn [] (merge (setting/get-value-of-type :json :custom-geojson) builtin-geojson))
  :setter  (fn [new-value]
             ;; remove the built-in keys you can't override them and we don't want those to be subject to validation.
             (let [new-value (not-empty (reduce dissoc new-value (keys builtin-geojson)))]
               (when new-value
                 (validate-geojson new-value))
               (setting/set-value-of-type! :json :custom-geojson new-value)))
  :visibility :public
  :audit      :raw-value)
(def ^:private connection-timeout-ms 8000)

Reads the provided URL and responds with the contents as a stream.

(defn- read-url-and-respond
  [url respond]
  (with-open [^BufferedReader reader (if-let [resource (io/resource url)]
                                       (io/reader resource)
                                       (:body (http/get url {:as                 :reader
                                                             :redirect-strategy  :none
                                                             :socket-timeout     connection-timeout-ms
                                                             :connection-timeout connection-timeout-ms})))
              is                     (ReaderInputStream. reader)]
    (respond (-> (response/response is)
                 (response/content-type "application/json")))))

/:key

(api/defendpoint-async GET 
  "Fetch a custom GeoJSON file as defined in the `custom-geojson` setting. (This just acts as a simple proxy for the
  file specified for `key`)."
  [{{:keys [key]} :params} respond raise]
  {key ms/NonBlankString}
  (when-not (or (custom-geojson-enabled) (builtin-geojson (keyword key)))
    (raise (ex-info (tru "Custom GeoJSON is not enabled") {:status-code 400})))
  (if-let [url (get-in (custom-geojson) [(keyword key) :url])]
    (try
      (read-url-and-respond url respond)
      (catch Throwable _e
        (raise (ex-info (tru "GeoJSON URL failed to load") {:status-code 400}))))
    (raise (ex-info (tru "Invalid custom GeoJSON key: {0}" key) {:status-code 400}))))

/

(api/defendpoint-async GET 
  "Load a custom GeoJSON file based on a URL or file path provided as a query parameter.
  This behaves similarly to /api/geojson/:key but doesn't require the custom map to be saved to the DB first."
  [{{:keys [url]} :params} respond raise]
  {url ms/NonBlankString}
  (validation/check-has-application-permission :setting)
  (when-not (custom-geojson-enabled)
    (raise (ex-info (tru "Custom GeoJSON is not enabled") {:status-code 400})))
  (let [decoded-url (codec/url-decode url)]
    (try
      (when-not (valid-geojson-url? decoded-url)
        (throw (ex-info (invalid-location-msg) {:status-code 400})))
      (try
        (read-url-and-respond decoded-url respond)
        (catch Throwable _
          (throw (ex-info (tru "GeoJSON URL failed to load") {:status-code 400}))))
      (catch Throwable e
        (raise e)))))
(api/define-routes)
 

/api/google endpoints

(ns metabase.api.google
  (:require
   [compojure.core :refer [PUT]]
   [metabase.api.common :as api]
   [metabase.integrations.google :as google]
   [metabase.models.setting :as setting]
   [toucan2.core :as t2]))

/settings

(api/defendpoint PUT 
  "Update Google Sign-In related settings. You must be a superuser to do this."
  [:as {{:keys [google-auth-client-id google-auth-enabled google-auth-auto-create-accounts-domain]} :body}]
  {google-auth-client-id                   [:maybe :string]
   google-auth-enabled                     [:maybe :boolean]
   google-auth-auto-create-accounts-domain [:maybe :string]}
  (api/check-superuser)
  ;; Set google-auth-enabled in a separate step because it requires the client ID to be set first
  (t2/with-transaction [_conn]
   (setting/set-many! {:google-auth-client-id                   google-auth-client-id
                       :google-auth-auto-create-accounts-domain google-auth-auto-create-accounts-domain})
   (google/google-auth-enabled! google-auth-enabled)))
(api/define-routes)
 

/api/ldap endpoints

(ns metabase.api.ldap
  (:require
   [clojure.set :as set]
   [compojure.core :refer [PUT]]
   [metabase.api.common :as api]
   [metabase.integrations.ldap :as ldap]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.util.i18n :refer [deferred-tru tru]]
   [metabase.util.log :as log]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

Convert raw error message responses from our LDAP tests into our normal api error response structure.

(defn- humanize-error-messages
  [{:keys [status message]}]
  (when (not= :SUCCESS status)
    (log/warn "Problem connecting to LDAP server:" message)
    (let [conn-error     {:errors {:ldap-host "Wrong host or port"
                                   :ldap-port "Wrong host or port"}}
          security-error {:errors {:ldap-port     "Wrong port or security setting"
                                   :ldap-security "Wrong port or security setting"}}
          bind-dn-error  {:errors {:ldap-bind-dn "Wrong bind DN"}}
          creds-error    {:errors {:ldap-bind-dn  "Wrong bind DN or password"
                                   :ldap-password "Wrong bind DN or password"}}]
      (condp re-matches message
        #".*UnknownHostException.*"
        conn-error
        #".*ConnectException.*"
        conn-error
        #".*SocketException.*"
        security-error
        #".*SSLException.*"
        security-error
        #"^For input string.*"
        {:errors {:ldap-host "Invalid hostname, do not add the 'ldap://' or 'ldaps://' prefix"}}
        #".*password was incorrect.*"
        {:errors {:ldap-password "Password was incorrect"}}
        #"^Unable to bind as user.*"
        bind-dn-error
        #"^Unable to parse bind DN.*"
        {:errors {:ldap-bind-dn "Invalid bind DN"}}
        #".*AcceptSecurityContext error, data 525,.*"
        bind-dn-error
        #".*AcceptSecurityContext error, data 52e,.*"
        creds-error
        #".*AcceptSecurityContext error, data 532,.*"
        {:errors {:ldap-password "Password is expired"}}
        #".*AcceptSecurityContext error, data 533,.*"
        {:errors {:ldap-bind-dn "Account is disabled"}}
        #".*AcceptSecurityContext error, data 701,.*"
        {:errors {:ldap-bind-dn "Account is expired"}}
        #"^User search base does not exist .*"
        {:errors {:ldap-user-base "User search base does not exist or is unreadable"}}
        #"^Group search base does not exist .*"
        {:errors {:ldap-group-base "Group search base does not exist or is unreadable"}}
        ;; everything else :(
        #"(?s).*"
        {:message message}))))
(defsetting ldap-enabled
  (deferred-tru "Is LDAP currently enabled?")
  :type       :boolean
  :visibility :public
  :setter     (fn [new-value]
                (let [new-value (boolean new-value)]
                  (when new-value
                    ;; Test the LDAP settings before enabling
                    (let [result (ldap/test-current-ldap-details)]
                      (when-not (= :SUCCESS (:status result))
                        (throw (ex-info (tru "Unable to connect to LDAP server with current settings")
                                        (humanize-error-messages result))))))
                  (setting/set-value-of-type! :boolean :ldap-enabled new-value)))
  :default    false
  :audit      :getter)

Do not update password if new-password is an obfuscated value of the current password.

(defn- update-password-if-needed
  [new-password]
  (let [current-password (setting/get :ldap-password)]
    (if (= (setting/obfuscate-value current-password) new-password)
      current-password
      new-password)))

/settings

(api/defendpoint PUT 
  "Update LDAP related settings. You must be a superuser to do this."
  [:as {settings :body}]
  {settings :map}
  (api/check-superuser)
  (let [ldap-settings (-> settings
                          (select-keys (keys ldap/mb-settings->ldap-details))
                          (assoc :ldap-port (when-let [^String ldap-port (not-empty (str (:ldap-port settings)))]
                                              (Long/parseLong ldap-port)))
                          (update :ldap-password update-password-if-needed))
        ldap-details  (set/rename-keys ldap-settings ldap/mb-settings->ldap-details)
        results       (ldap/test-ldap-connection ldap-details)]
    (if (= :SUCCESS (:status results))
      (t2/with-transaction [_conn]
       (setting/set-many! ldap-settings)
       (setting/set-value-of-type! :boolean :ldap-enabled (boolean (:ldap-enabled settings))))
      ;; test failed, return result message
      {:status 500
       :body   (humanize-error-messages results)})))
(api/define-routes)
 
(ns metabase.api.login-history
  (:require
   [compojure.core :refer [GET]]
   [metabase.api.common :as api]
   [metabase.models.login-history :as login-history :refer [LoginHistory]]
   [metabase.util :as u]
   [toucan2.core :as t2]))

Return complete login history (sorted by most-recent -> least-recent) for user-or-id

(defn login-history
  [user-or-id]
  ;; TODO -- should this only return history in some window, e.g. last 3 months? I think for auditing purposes it's
  ;; nice to be able to see every log in that's every happened with an account. Maybe we should page this, or page the
  ;; API endpoint?
  (login-history/human-friendly-infos
   (t2/select [LoginHistory :timestamp :session_id :device_description :ip_address]
              :user_id (u/the-id user-or-id)
              {:order-by [[:timestamp :desc]]})))

/current

(api/defendpoint GET 
  "Fetch recent logins for the current user."
  []
  (login-history api/*current-user-id*))
(api/define-routes)
 

These Metabot endpoints are for an experimental feature.

(ns metabase.api.metabot
  (:require
   [clojure.string :as str]
   [compojure.core :refer [POST]]
   [metabase.api.common :as api]
   [metabase.metabot :as metabot]
   [metabase.metabot.feedback :as metabot-feedback]
   [metabase.metabot.util :as metabot-util]
   [metabase.models :refer [Card Database]]
   [metabase.util.log :as log]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

Do a preliminary check to ensure metabot will work. Throw an exception if not.

(defn- check-database-support
  [database-id]
  (when-not (metabot-util/supported? database-id)
    (throw
     (let [message "Metabot is not supported for this database type."]
       (ex-info
        message
        {:status-code 400
         :message     message})))))

An http-friendly version of infer-sql that throws a useful error if it fails to produce sql.

(defn- infer-sql-or-throw
  [context question]
  (or
   (metabot/infer-sql context)
   (throw
    (let [message (format
                   "Query '%s' didn't produce any SQL. Perhaps try a more detailed query."
                   question)]
      (ex-info
       message
       {:status-code 400
        :message     message})))))

Given a calling context and resulting dataset, add a more interesting visual to the card.

(defn- add-viz-to-dataset
  [context {:keys [bot-sql] :as dataset}]
  (let [context (assoc context :sql bot-sql :prompt_task :infer_viz)
        {:keys [template prompt_template_version]} (metabot/infer-viz context)]
    (cond-> (update dataset :card merge template)
      prompt_template_version
      (update :prompt_template_versions conj prompt_template_version))))

/model/:model-id

(api/defendpoint POST 
  "Ask Metabot to generate a SQL query given a prompt about a given model."
  [model-id :as {{:keys [question]} :body}]
  {model-id ms/PositiveInt
   question ms/NonBlankString}
  (log/infof
   "Metabot '/api/metabot/model/%s' being called with prompt: '%s'"
   model-id
   question)
  (let [model   (api/check-404 (t2/select-one Card :id model-id :dataset true))
        _       (check-database-support (:database_id model))
        context {:model       (metabot-util/denormalize-model model)
                 :user_prompt question
                 :prompt_task :infer_sql}
        dataset (infer-sql-or-throw context question)]
    (add-viz-to-dataset context dataset)))

/database/:database-id

(api/defendpoint POST 
  "Ask Metabot to generate a native question given a prompt about a given database."
  [database-id :as {{:keys [question]} :body}]
  {database-id ms/PositiveInt
   question    ms/NonBlankString}
  (log/infof
   "Metabot '/api/metabot/database/%s' being called with prompt: '%s'"
   database-id
   question)
  (let [{:as database} (api/check-404 (t2/select-one Database :id database-id))
        _       (check-database-support (:id database))
        context {:database    (metabot-util/denormalize-database database)
                 :user_prompt question
                 :prompt_task :infer_model}]
    (if-some [model (metabot/infer-model context)]
      (let [context (merge context {:model model :prompt_task :infer_sql})
            dataset (infer-sql-or-throw context question)]
        (add-viz-to-dataset context dataset))
      (throw
       (let [message (format
                      (str/join
                       " "
                       ["Query '%s' didn't find a good match to your data."
                        "Perhaps try a query that mentions the model name or columns more specifically."])
                      question)]
         (ex-info
          message
          {:status-code 400
           :message     message}))))))

/database/:database-id/query

(api/defendpoint POST 
  "Ask Metabot to generate a SQL query given a prompt about a given database."
  [database-id :as {{:keys [question]} :body}]
  {database-id ms/PositiveInt
   question    ms/NonBlankString}
  (log/infof
   "Metabot '/api/metabot/database/%s/query' being called with prompt: '%s'"
   database-id
   question)
  (let [{:as database} (api/check-404 (t2/select-one Database :id database-id))
        _       (check-database-support (:id database))
        context {:database    (metabot-util/denormalize-database database)
                 :user_prompt question
                 :prompt_task :infer_native_sql}]
    (metabot/infer-native-sql-query context)))

/feedback

(api/defendpoint POST 
  "Record feedback on metabot results."
  [:as {feedback :body}]
  (if-some [stored-feedback (metabot-feedback/submit-feedback feedback)]
    {:feedback stored-feedback
     :message  "Thanks for your feedback"}
    (throw
     (let [message "There was a problem submitting your feedback."]
       (ex-info
        message
        {:status-code 500
         :message     message})))))
(api/define-routes)
 

/api/metric endpoints.

(ns metabase.api.metric
  (:require
   [clojure.data :as data]
   [compojure.core :refer [DELETE GET POST PUT]]
   [metabase.api.common :as api]
   [metabase.events :as events]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.models :refer [Metric  MetricImportantField Table]]
   [metabase.models.interface :as mi]
   [metabase.models.revision :as revision]
   [metabase.related :as related]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

/

(api/defendpoint POST 
  "Create a new `Metric`."
  [:as {{:keys [name description table_id definition], :as body} :body}]
  {name        ms/NonBlankString
   table_id    ms/PositiveInt
   definition  :map
   description [:maybe :string]}
  ;; TODO - why can't set the other properties like `show_in_getting_started` when you create a Metric?
  (api/create-check Metric body)
  (let [metric (api/check-500
                (first (t2/insert-returning-instances! Metric
                                                       :table_id    table_id
                                                       :creator_id  api/*current-user-id*
                                                       :name        name
                                                       :description description
                                                       :definition  definition)))]
    (events/publish-event! :event/metric-create {:object metric :user-id api/*current-user-id*})
    (t2/hydrate metric :creator)))
(mu/defn ^:private hydrated-metric [id :- ms/PositiveInt]
  (-> (api/read-check (t2/select-one Metric :id id))
      (t2/hydrate :creator)))

/:id

(api/defendpoint GET 
  "Fetch `Metric` with ID."
  [id]
  {id ms/PositiveInt}
  (hydrated-metric id))

Add :database_id fields to metrics by looking them up from their :table_id.

(defn- add-db-ids
  [metrics]
  (when (seq metrics)
    (let [table-id->db-id (t2/select-pk->fn :db_id Table, :id [:in (set (map :table_id metrics))])]
      (for [metric metrics]
        (assoc metric :database_id (table-id->db-id (:table_id metric)))))))

/

(api/defendpoint GET 
  "Fetch *all* `Metrics`."
  []
  (as-> (t2/select Metric, :archived false, {:order-by [:%lower.name]}) metrics
    (t2/hydrate metrics :creator :definition_description)
    (add-db-ids metrics)
    (filter mi/can-read? metrics)
    metrics))

Check whether current user has write permissions, then update Metric with values in body. Publishes appropriate event and returns updated/hydrated Metric.

(defn- write-check-and-update-metric!
  [id {:keys [revision_message] :as body}]
  (let [existing   (api/write-check Metric id)
        clean-body (u/select-keys-when body
                     :present #{:description :caveats :how_is_this_calculated :points_of_interest}
                     :non-nil #{:archived :definition :name :show_in_getting_started})
        new-def    (->> clean-body :definition (mbql.normalize/normalize-fragment []))
        new-body   (merge
                     (dissoc clean-body :revision_message)
                     (when new-def {:definition new-def}))
        changes    (when-not (= new-body existing)
                     new-body)
        archive?   (:archived changes)]
    (when changes
      (t2/update! Metric id changes))
    (u/prog1 (hydrated-metric id)
      (events/publish-event! (if archive? :event/metric-delete :event/metric-update)
                             {:object <>  :user-id api/*current-user-id* :revision-message revision_message}))))

/:id

(api/defendpoint PUT 
  "Update a `Metric` with ID."
  [id :as {{:keys [name definition revision_message archived caveats description how_is_this_calculated
                   points_of_interest show_in_getting_started]
            :as   body} :body}]
  {id                      ms/PositiveInt
   name                    [:maybe ms/NonBlankString]
   definition              [:maybe :map]
   revision_message        ms/NonBlankString
   archived                [:maybe :boolean]
   caveats                 [:maybe :string]
   description             [:maybe :string]
   how_is_this_calculated  [:maybe :string]
   points_of_interest      [:maybe :string]
   show_in_getting_started [:maybe :boolean]}
  (write-check-and-update-metric! id body))

/:id/important_fields

(api/defendpoint PUT 
  "Update the important `Fields` for a `Metric` with ID.
   (This is used for the Getting Started guide)."
  [id :as {{:keys [important_field_ids]} :body}]
  {id                  ms/PositiveInt
   important_field_ids [:sequential ms/PositiveInt]}
  (api/check-superuser)
  (api/write-check Metric id)
  (api/check (<= (count important_field_ids) 3)
    [400 "A Metric can have a maximum of 3 important fields."])
  (let [[fields-to-remove fields-to-add] (data/diff (set (t2/select-fn-set :field_id 'MetricImportantField :metric_id id))
                                                    (set important_field_ids))]
    ;; delete old fields as needed
    (when (seq fields-to-remove)
      (t2/delete! (t2/table-name MetricImportantField) {:metric_id id, :field_id [:in fields-to-remove]}))
    ;; add new fields as needed
    (t2/insert! 'MetricImportantField (for [field-id fields-to-add]
                                        {:metric_id id, :field_id field-id}))
    {:success true}))

/:id

(api/defendpoint DELETE 
  "Archive a Metric. (DEPRECATED -- Just pass updated value of `:archived` to the `PUT` endpoint instead.)"
  [id revision_message]
  {id               ms/PositiveInt
   revision_message ms/NonBlankString}
  (log/warn
   (trs "DELETE /api/metric/:id is deprecated. Instead, change its `archived` value via PUT /api/metric/:id."))
  (write-check-and-update-metric! id {:archived true, :revision_message revision_message})
  api/generic-204-no-content)

/:id/revisions

(api/defendpoint GET 
  "Fetch `Revisions` for `Metric` with ID."
  [id]
  {id ms/PositiveInt}
  (api/read-check Metric id)
  (revision/revisions+details Metric id))

/:id/revert

(api/defendpoint POST 
  "Revert a `Metric` to a prior `Revision`."
  [id :as {{:keys [revision_id]} :body}]
  {id          ms/PositiveInt
   revision_id ms/PositiveInt}
  (api/write-check Metric id)
  (revision/revert!
   {:entity      Metric
    :id          id
    :user-id     api/*current-user-id*
    :revision-id revision_id}))

/:id/related

(api/defendpoint GET 
  "Return related entities."
  [id]
  {id ms/PositiveInt}
  (-> (t2/select-one Metric :id id) api/read-check related/related))
(api/define-routes)
 
(ns metabase.api.model-index
  (:require
   [compojure.core :refer [POST]]
   [metabase.analytics.snowplow :as snowplow]
   [metabase.api.common :as api]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.models.card :refer [Card]]
   [metabase.models.model-index :as model-index :refer [ModelIndex]]
   [metabase.task.index-values :as task.index-values]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

Ensure that the ref exists and is of type required for indexing.

(defn- ensure-type
  [t ref metadata]
  (if-let [field (some (fn [f] (when ((comp #{(mbql.normalize/normalize-field-ref ref)} :field_ref) f)
                                 f))
                       metadata)]
    (let [type-slot (case t
                      :type/PK                   :semantic_type
                      (:type/Integer :type/Text) :effective_type)]
      (when-not (isa? (type-slot field) t)
        (throw (ex-info (tru "Field is not of {0} `{1}`" type-slot t)
                        {:status-code   400
                         :expected-type t
                         :type          (:effective_type field)
                         :field         (:name field)}))))
    (throw (ex-info (tru "Could not identify field by ref {0}" ref)
                    {:status-code 400
                     :ref         ref
                     :fields      metadata}))))

/

(api/defendpoint POST 
  [:as {{:keys [model_id pk_ref value_ref] :as _model-index} :body}]
  {model_id  ms/PositiveInt
   pk_ref    any?
   value_ref any?}
  (let [model    (api/write-check Card model_id)
        metadata (:result_metadata model)]
    (when-not (seq metadata)
      (throw (ex-info (tru "Model has no metadata. Cannot index")
                      {:model-id model_id})))
    (ensure-type :type/PK pk_ref metadata)
    (ensure-type :type/Integer pk_ref metadata)
    (ensure-type :type/Text value_ref metadata)
    ;; todo: do we care if there's already an index on that model?
    (let [model-index (model-index/create {:model-id   model_id
                                           :pk-ref     pk_ref
                                           :value-ref  value_ref
                                           :creator-id api/*current-user-id*})]
      (snowplow/track-event! ::snowplow/index-model-entities-enabled api/*current-user-id* {:model-id model_id})
      (task.index-values/add-indexing-job model-index)
      (model-index/add-values! model-index)
      (t2/select-one ModelIndex :id (:id model-index)))))

/

(api/defendpoint GET 
  [model_id]
  {model_id ms/PositiveInt}
  (let [model (api/read-check Card model_id)]
    (when-not (:dataset model)
      (throw (ex-info (tru "Question {0} is not a model" model_id)
                      {:model_id model_id
                       :status-code 400})))
    (t2/select ModelIndex :model_id model_id)))

/:id

(api/defendpoint GET 
  [id]
  {id ms/PositiveInt}
  (let [model-index (api/check-404 (t2/select-one ModelIndex :id id))
        model       (api/read-check Card (:model_id model-index))]
    (when-not (:dataset model)
      (throw (ex-info (tru "Question {0} is not a model" id)
                      {:model_id id
                       :status-code 400})))
    model-index))

/:id

(api/defendpoint DELETE 
  [id]
  {id ms/PositiveInt}
  (api/let-404 [model-index (t2/select-one ModelIndex :id id)]
    (api/write-check Card (:model_id model-index))
    (t2/delete! ModelIndex id)))
(api/define-routes)
 

Native query snippet (/api/native-query-snippet) endpoints.

(ns metabase.api.native-query-snippet
  (:require
   [clojure.data :as data]
   [compojure.core :refer [GET POST PUT]]
   [metabase.api.common :as api]
   [metabase.models.interface :as mi]
   [metabase.models.native-query-snippet
    :as native-query-snippet
    :refer [NativeQuerySnippet]]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)
(mu/defn ^:private hydrated-native-query-snippet :- [:maybe (mi/InstanceOf NativeQuerySnippet)]
  [id :- ms/PositiveInt]
  (-> (api/read-check (t2/select-one NativeQuerySnippet :id id))
      (t2/hydrate :creator)))

/

(api/defendpoint GET 
  "Fetch all snippets"
  [archived]
  {archived [:maybe ms/BooleanString]}
  (let [snippets (t2/select NativeQuerySnippet
                            :archived (Boolean/parseBoolean archived)
                            {:order-by [[:%lower.name :asc]]})]
    (t2/hydrate (filter mi/can-read? snippets) :creator)))

/:id

(api/defendpoint GET 
  "Fetch native query snippet with ID."
  [id]
  {id ms/PositiveInt}
  (hydrated-native-query-snippet id))
(defn- check-snippet-name-is-unique [snippet-name]
  (when (t2/exists? NativeQuerySnippet :name snippet-name)
    (throw (ex-info (tru "A snippet with that name already exists. Please pick a different name.")
                    {:status-code 400}))))

/

(api/defendpoint POST 
  "Create a new `NativeQuerySnippet`."
  [:as {{:keys [content description name collection_id]} :body}]
  {content       :string
   description   [:maybe :string]
   name          native-query-snippet/NativeQuerySnippetName
   collection_id [:maybe ms/PositiveInt]}
  (check-snippet-name-is-unique name)
  (let [snippet {:content       content
                 :creator_id    api/*current-user-id*
                 :description   description
                 :name          name
                 :collection_id collection_id}]
    (api/create-check NativeQuerySnippet snippet)
    (api/check-500 (first (t2/insert-returning-instances! NativeQuerySnippet snippet)))))

Check whether current user has write permissions, then update NativeQuerySnippet with values in body. Returns updated/hydrated NativeQuerySnippet

(defn- check-perms-and-update-snippet!
  [id body]
  (let [snippet     (t2/select-one NativeQuerySnippet :id id)
        body-fields (u/select-keys-when body
                      :present #{:description :collection_id}
                      :non-nil #{:archived :content :name})
        [changes]   (data/diff body-fields snippet)]
    (when (seq changes)
      (api/update-check snippet changes)
      (when-let [new-name (:name changes)]
        (check-snippet-name-is-unique new-name))
      (t2/update! NativeQuerySnippet id changes))
    (hydrated-native-query-snippet id)))

/:id

(api/defendpoint PUT 
  "Update an existing `NativeQuerySnippet`."
  [id :as {{:keys [archived content description name collection_id] :as body} :body}]
  {id            ms/PositiveInt
   archived      [:maybe :boolean]
   content       [:maybe :string]
   description   [:maybe :string]
   name          [:maybe native-query-snippet/NativeQuerySnippetName]
   collection_id [:maybe ms/PositiveInt]}
  (check-perms-and-update-snippet! id body))
(api/define-routes)
 

/api/notify/* endpoints which receive inbound etl server notifications.

(ns metabase.api.notify
  (:require
   [compojure.core :refer [POST]]
   [metabase.api.common :as api]
   [metabase.driver :as driver]
   [metabase.driver.util :as driver.u]
   [metabase.models.database :refer [Database]]
   [metabase.models.table :refer [Table]]
   [metabase.sync :as sync]
   [metabase.sync.sync-metadata :as sync-metadata]
   [metabase.sync.sync-metadata.tables :as sync-tables]
   [metabase.sync.util :as sync-util]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

/db/:id

(api/defendpoint POST 
  "Notification about a potential schema change to one of our `Databases`.
  Caller can optionally specify a `:table_id` or `:table_name` in the body to limit updates to a single
  `Table`. Optional Parameter `:scan` can be `\"full\"` or `\"schema\"` for a full sync or a schema sync, available
  regardless if a `:table_id` or `:table_name` is passed.
  This endpoint is secured by an API key that needs to be passed as a `X-METABASE-APIKEY` header which needs to be defined in
  the `MB_API_KEY` [environment variable](https://www.metabase.com/docs/latest/configuring-metabase/environment-variables.html#mb_api_key)"
  [id :as {{:keys [table_id table_name scan synchronous?]} :body}]
  {id         ms/PositiveInt
   table_id   [:maybe ms/PositiveInt]
   table_name [:maybe ms/NonBlankString]
   scan       [:maybe [:enum "full" "schema"]]}
  (let [schema?       (when scan (#{"schema" :schema} scan))
        table-sync-fn (if schema? sync-metadata/sync-table-metadata! sync/sync-table!)
        db-sync-fn    (if schema? sync-metadata/sync-db-metadata! sync/sync-database!)]
    (api/let-404 [database (t2/select-one Database :id id)]
      (cond-> (cond
                table_id   (api/let-404 [table (t2/select-one Table :db_id id, :id (int table_id))]
                             (future (table-sync-fn table)))
                table_name (api/let-404 [table (t2/select-one Table :db_id id, :name table_name)]
                             (future (table-sync-fn table)))
                :else      (future (db-sync-fn database)))
        synchronous? deref)))
  {:success true})
(defn- without-stacktrace [^Throwable throwable]
  (doto throwable
    (.setStackTrace (make-array StackTraceElement 0))))

/db/:id/new-table

(api/defendpoint POST 
  "Sync a new table without running a full database sync. Requires `schema_name` and `table_name`. Will throw an error
  if the table already exists in Metabase or cannot be found."
  [id :as {{:keys [schema_name table_name]} :body}]
  {id          ms/PositiveInt
   schema_name ms/NonBlankString
   table_name  ms/NonBlankString}
  (api/let-404 [database (t2/select-one Database :id id)]
    (if-not (t2/select-one Table :db_id id :name table_name :schema schema_name)
      (let [driver (driver.u/database->driver database)
            {db-tables :tables} (driver/describe-database driver database)]
        (if-let [table (some (fn [table-in-db]
                               (when (= (dissoc table-in-db :description)
                                        {:schema schema_name :name table_name})
                                 table-in-db))
                             db-tables)]
          (let [created (sync-tables/create-or-reactivate-table! database table)]
            (doto created
              sync/sync-table!
              sync-util/set-initial-table-sync-complete!))
          (throw (without-stacktrace
                  (ex-info (trs "Unable to identify table ''{0}.{1}''"
                                schema_name table_name)
                           {:status-code 404
                            :schema_name schema_name
                            :table_name  table_name})))))
      (throw (without-stacktrace
              (ex-info (trs "Table ''{0}.{1}'' already exists"
                            schema_name table_name)
                       {:status-code 400
                        :schema_name schema_name
                        :table_name  table_name}))))))
(api/define-routes)
 

Convert the permission graph's naive json conversion into the correct types.

The strategy here is to use s/conform to tag every value that needs to be converted with the conversion strategy, then postwalk to actually perform the conversion.

(ns metabase.api.permission-graph
  (:require
   [clojure.spec.alpha :as s]
   [clojure.spec.gen.alpha :as gen]
   [clojure.walk :as walk]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]))
(set! *warn-on-reflection* true)

convert values from the naively converted json to what we REALLY WANT

(defmulti ^:private convert
  first)
(defmethod convert :kw->int [[_ k]] (Integer/parseInt (name k)))
(defmethod convert :str->kw [[_ s]] (keyword s))

Convert a keyword to string without excluding the namespace. e.g: :schema/name => "schema/name". Primarily used for schema-name since schema are allowed to have "/" and calling (name s) returning a substring after "/".

(defmethod convert :kw->str [[_ s]] (u/qualified-name s))
(defmethod convert :nil->none [[_ _]] :none)
(defmethod convert :identity [[_ x]] x)
(defmethod convert :global-execute [[_ x]] x)
(defmethod convert :db-exeute [[_ x]] x)

--------------------------------------------------- Common ----------------------------------------------------

(defn- kw-int->int-decoder [kw-int]
  (if (int? kw-int)
    kw-int
    (parse-long (name kw-int))))

Integer malli schema that knows how to decode itself from the :123 sort of shape used in perm-graphs

(def DecodableKwInt
  [:int {:decode/perm-graph kw-int->int-decoder}])
(def ^:private Id DecodableKwInt)
(def ^:private GroupId DecodableKwInt)

ids come in as keywordized numbers

(s/def ::id (s/with-gen (s/or :kw->int (s/and keyword? #(re-find #"^\d+$" (name %))))
              #(gen/fmap (comp keyword str) (s/gen pos-int?))))

native permissions

(def ^:private Native
  [:maybe [:enum :write :none :full :limited]])

------------------------------------------------ Data Permissions ------------------------------------------------

(def ^:private TablePerms
  [:or
   [:enum :all :segmented :none :full :limited]
   [:map
    [:read {:optional true} [:enum :all :none]]
    [:query {:optional true} [:enum :all :none :segmented]]]])
(def ^:private SchemaPerms
  [:or
   [:keyword {:title "schema name"}]
   [:map-of Id TablePerms]])
(def ^:private SchemaGraph
  [:map-of
   [:string {:decode/perm-graph name}]
   SchemaPerms])
(def ^:private Schemas
  [:or
   [:enum :all :segmented :none :block :full :limited :impersonated]
   SchemaGraph])
(def ^:private DataPerms
  [:map
   [:native {:optional true} Native]
   [:schemas {:optional true} Schemas]])

data perms that care about how native and schemas keys related to one another. If you have write access for native queries, you must have data access to all schemas.

(def StrictDataPerms
  [:and
   DataPerms
   [:fn {:error/fn (fn [_ _] (trs "Invalid DB permissions: If you have write access for native queries, you must have data access to all schemas."))}
    (fn [{:keys [native schemas]}]
      (not (and (= native :write) schemas (not (#{:all :impersonated} schemas)))))]])
(def ^:private DbGraph
  [:schema {:registry {"DataPerms" DataPerms}}
   [:map-of
    Id
    [:map
     [:data {:optional true} "DataPerms"]
     [:query {:optional true} "DataPerms"]
     [:download {:optional true} "DataPerms"]
     [:data-model {:optional true} "DataPerms"]
     ;; We use :yes and :no instead of booleans for consistency with the application perms graph, and
     ;; consistency with the language used on the frontend.
     [:details {:optional true} [:enum :yes :no]]
     [:execute {:optional true} [:enum :all :none]]]]])

like db-graph, but if you have write access for native queries, you must have data access to all schemas.

(def StrictDbGraph
  [:schema {:registry {"StrictDataPerms" StrictDataPerms}}
   [:map-of
    Id
    [:map
     [:data {:optional true} "StrictDataPerms"]
     [:query {:optional true} "StrictDataPerms"]
     [:download {:optional true} "StrictDataPerms"]
     [:data-model {:optional true} "StrictDataPerms"]
     ;; We use :yes and :no instead of booleans for consistency with the application perms graph, and
     ;; consistency with the language used on the frontend.
     [:details {:optional true} [:enum :yes :no]]
     [:execute {:optional true} [:enum :all :none]]]]])

Used to transform, and verify data permissions graph

(def DataPermissionsGraph
  [:map [:groups [:map-of GroupId [:maybe DbGraph]]]])

Top level strict data graph schema

(def StrictData
  [:map
   [:groups [:map-of GroupId [:maybe StrictDbGraph]]]
   [:revision int?]])

--------------------------------------------- Execution Permissions ----------------------------------------------

(s/def ::execute (s/or :str->kw #{"all" "none"}))
(s/def ::execute-graph
  (s/or :global-execute ::execute
        :db-exeute      (s/map-of ::id ::execute
                                  :conform-keys true)))
(s/def :metabase.api.permission-graph.execution/groups
  (s/map-of ::id
            ::execute-graph
            :conform-keys true))
(s/def ::execution-permissions-graph
  (s/keys :req-un [:metabase.api.permission-graph.execution/groups]))

The permissions graph is received as JSON. That JSON is naively converted. This performs a further conversion to convert graph keys and values to the types we want to work with.

(defn converted-json->graph
  [spec kwj]
  (->> (s/conform spec kwj)
       (walk/postwalk (fn [x]
                        (if (and (vector? x) (get-method convert (first x)))
                          (convert x)
                          x)))))
 

/api/permissions endpoints.

(ns metabase.api.permissions
  (:require
   [clojure.spec.alpha :as s]
   [compojure.core :refer [DELETE GET POST PUT]]
   [honey.sql.helpers :as sql.helpers]
   [malli.core :as mc]
   [malli.transform :as mtx]
   [metabase.api.common :as api]
   [metabase.api.common.validation :as validation]
   [metabase.api.permission-graph :as api.permission-graph]
   [metabase.db.query :as mdb.query]
   [metabase.models :refer [PermissionsGroupMembership User]]
   [metabase.models.interface :as mi]
   [metabase.models.permissions :as perms]
   [metabase.models.permissions-group
    :as perms-group
    :refer [PermissionsGroup]]
   [metabase.models.permissions-revision :as perms-revision]
   [metabase.public-settings.premium-features
    :as premium-features
    :refer [defenterprise]]
   [metabase.server.middleware.offset-paging :as mw.offset-paging]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

+----------------------------------------------------------------------------------------------------------------+ | PERMISSIONS GRAPH ENDPOINTS | +----------------------------------------------------------------------------------------------------------------+

--------------------------------------------------- Endpoints ----------------------------------------------------

/graph

(api/defendpoint GET 
  "Fetch a graph of all v1 Permissions (excludes v2 query and data permissions)."
  []
  (api/check-superuser)
  (perms/data-perms-graph))

/graph/db/:db-id

(api/defendpoint GET 
  "Fetch a graph of all v1 Permissions for db-id `db-id` (excludes v2 query and data permissions)."
  [db-id]
  {db-id ms/PositiveInt}
  (api/check-superuser)
  (perms/data-graph-for-db db-id))

/graph/group/:group-id

(api/defendpoint GET 
  "Fetch a graph of all v1 Permissions for group-id `group-id` (excludes v2 query and data permissions)."
  [group-id]
  {group-id ms/PositiveInt}
  (api/check-superuser)
  (perms/data-graph-for-group group-id))

/graph-v2

(api/defendpoint GET 
  "Fetch a graph of all v2 Permissions (excludes v1 data permissions)."
  []
  (api/check-superuser)
  (perms/data-perms-graph-v2))

OSS implementation of upsert-sandboxes!. Errors since this is an enterprise feature.

(defenterprise upsert-sandboxes!
  metabase-enterprise.sandbox.models.group-table-access-policy
  [_sandboxes]
 (throw (premium-features/ee-feature-error (tru "Sandboxes"))))

OSS implementation of insert-impersonations!. Errors since this is an enterprise feature.

(defenterprise insert-impersonations!
  metabase-enterprise.advanced-permissions.models.connection-impersonation
  [_impersonations]
  (throw (premium-features/ee-feature-error (tru "Connection impersonation"))))

/graph

(api/defendpoint PUT 
  "Do a batch update of Permissions by passing in a modified graph. This should return the same graph, in the same
  format, that you got from `GET /api/permissions/graph`, with any changes made in the wherever necessary. This
  modified graph must correspond to the `PermissionsGraph` schema. If successful, this endpoint returns the updated
  permissions graph; use this as a base for any further modifications.
  Revisions to the permissions graph are tracked. If you fetch the permissions graph and some other third-party
  modifies it before you can submit you revisions, the endpoint will instead make no changes and return a
  409 (Conflict) response. In this case, you should fetch the updated graph and make desired changes to that.
  The optional `sandboxes` key contains a list of sandboxes that should be created or modified in conjunction with
  this permissions graph update. Since data sandboxing is an Enterprise Edition-only feature, a 402 (Payment Required)
  response will be returned if this key is present and the server is not running the Enterprise Edition, and/or the
  `:sandboxes` feature flag is not present.
  If the skip-graph query param is truthy, then the graph will not be returned."
  [:as {body :body
        {skip-graph :skip-graph} :params}]
  {body :map
   skip-graph [:maybe :boolean]}
  (api/check-superuser)
  (let [graph (mc/decode api.permission-graph/DataPermissionsGraph
                         body
                         (mtx/transformer
                          mtx/string-transformer
                          (mtx/transformer {:name :perm-graph})))]
    (when-not (mc/validate api.permission-graph/DataPermissionsGraph graph)
      (let [explained (mu/explain api.permission-graph/DataPermissionsGraph graph)]
        (throw (ex-info (tru "Cannot parse permissions graph because it is invalid: {0}" (pr-str explained))
                        {:status-code 400}))))
    (t2/with-transaction [_conn]
      (perms/update-data-perms-graph! (dissoc graph :sandboxes :impersonations))
      (let [sandbox-updates        (:sandboxes graph)
            sandboxes              (when sandbox-updates
                                     (upsert-sandboxes! sandbox-updates))
            impersonation-updates  (:impersonations graph)
            impersonations         (when impersonation-updates
                                     (insert-impersonations! impersonation-updates))]
        (merge {:revision (perms-revision/latest-id)}
               (when-not skip-graph {:groups (:groups (perms/data-perms-graph))})
               (when sandboxes {:sandboxes sandboxes})
               (when impersonations {:impersonations impersonations}))))))

+----------------------------------------------------------------------------------------------------------------+ | PERMISSIONS GROUP ENDPOINTS | +----------------------------------------------------------------------------------------------------------------+

Return a map of PermissionsGroup ID -> number of members in the group. (This doesn't include entries for empty groups.)

(defn- group-id->num-members
  []
  (let [results (mdb.query/query
                 {:select    [[:pgm.group_id :group_id] [[:count :pgm.id] :members]]
                  :from      [[:permissions_group_membership :pgm]]
                  :left-join [[:core_user :user] [:= :pgm.user_id :user.id]]
                  :where     [:= :user.is_active true]
                  :group-by  [:pgm.group_id]})]
    (zipmap
     (map :group_id results)
     (map :members results))))

Return a sequence of ordered PermissionsGroups.

(defn- ordered-groups
  [limit offset query]
  (t2/select PermissionsGroup
             (cond-> {:order-by [:%lower.name]}
               (some? limit)  (sql.helpers/limit  limit)
               (some? offset) (sql.helpers/offset offset)
               (some? query)  (sql.helpers/where query))))
(mi/define-batched-hydration-method add-member-counts
  :member_count
  "Efficiently add `:member_count` to PermissionGroups."
  [groups]
  (let [group-id->num-members (group-id->num-members)]
    (for [group groups]
      (assoc group :member_count (get group-id->num-members (u/the-id group) 0)))))

/group

(api/defendpoint GET 
  "Fetch all `PermissionsGroups`, including a count of the number of `:members` in that group.
  This API requires superuser or group manager of more than one group.
  Group manager is only available if `advanced-permissions` is enabled and returns only groups that user
  is manager of."
  []
  (try
    (validation/check-group-manager)
    (catch clojure.lang.ExceptionInfo _e
      (validation/check-has-application-permission :setting)))
  (let [query (when (and (not api/*is-superuser?*)
                         (premium-features/enable-advanced-permissions?)
                         api/*is-group-manager?*)
                [:in :id {:select [:group_id]
                          :from   [:permissions_group_membership]
                          :where  [:and
                                   [:= :user_id api/*current-user-id*]
                                   [:= :is_group_manager true]]}])]
    (-> (ordered-groups mw.offset-paging/*limit* mw.offset-paging/*offset* query)
        (t2/hydrate :member_count))))

/group/:id

(api/defendpoint GET 
  "Fetch the details for a certain permissions group."
  [id]
  {id ms/PositiveInt}
  (validation/check-group-manager id)
  (api/check-404
   (-> (t2/select-one PermissionsGroup :id id)
       (t2/hydrate :members))))

/group

(api/defendpoint POST 
  "Create a new `PermissionsGroup`."
  [:as {{:keys [name]} :body}]
  {name ms/NonBlankString}
  (api/check-superuser)
  (first (t2/insert-returning-instances! PermissionsGroup
                                         :name name)))

/group/:group-id

(api/defendpoint PUT 
  "Update the name of a `PermissionsGroup`."
  [group-id :as {{:keys [name]} :body}]
  {group-id ms/PositiveInt
   name     ms/NonBlankString}
  (validation/check-manager-of-group group-id)
  (api/check-404 (t2/exists? PermissionsGroup :id group-id))
  (t2/update! PermissionsGroup group-id
              {:name name})
  ;; return the updated group
  (t2/select-one PermissionsGroup :id group-id))

/group/:group-id

(api/defendpoint DELETE 
  "Delete a specific `PermissionsGroup`."
  [group-id]
  {group-id ms/PositiveInt}
  (validation/check-manager-of-group group-id)
  (t2/delete! PermissionsGroup :id group-id)
  api/generic-204-no-content)

------------------------------------------- Group Membership Endpoints -------------------------------------------

/membership

(api/defendpoint GET 
  "Fetch a map describing the group memberships of various users.
   This map's format is:
    {<user-id> [{:membership_id    <id>
                 :group_id         <id>
                 :is_group_manager boolean}]}"
  []
  (validation/check-group-manager)
  (group-by :user_id (t2/select [PermissionsGroupMembership [:id :membership_id] :group_id :user_id :is_group_manager]
                                (cond-> {}
                                  (and (not api/*is-superuser?*)
                                       api/*is-group-manager?*)
                                  (sql.helpers/where
                                   [:in :group_id {:select [:group_id]
                                                   :from   [:permissions_group_membership]
                                                   :where  [:and
                                                            [:= :user_id api/*current-user-id*]
                                                            [:= :is_group_manager true]]}])))))

/membership

(api/defendpoint POST 
  "Add a `User` to a `PermissionsGroup`. Returns updated list of members belonging to the group."
  [:as {{:keys [group_id user_id is_group_manager]} :body}]
  {group_id         ms/PositiveInt
   user_id          ms/PositiveInt
   is_group_manager [:maybe :boolean]}
  (let [is_group_manager (boolean is_group_manager)]
    (validation/check-manager-of-group group_id)
    (when is_group_manager
      ;; enable `is_group_manager` require advanced-permissions enabled
      (validation/check-advanced-permissions-enabled :group-manager)
      (api/check
       (t2/exists? User :id user_id :is_superuser false)
       [400 (tru "Admin cant be a group manager.")]))
    (t2/insert! PermissionsGroupMembership
                :group_id         group_id
                :user_id          user_id
                :is_group_manager is_group_manager)
    ;; TODO - it's a bit silly to return the entire list of members for the group, just return the newly created one and
    ;; let the frontend add it as appropriate
    (perms-group/members {:id group_id})))

/membership/:id

(api/defendpoint PUT 
  "Update a Permission Group membership. Returns the updated record."
  [id :as {{:keys [is_group_manager]} :body}]
  {id ms/PositiveInt
   is_group_manager :boolean}
  ;; currently this API is only used to update the `is_group_manager` flag and it requires advanced-permissions
  (validation/check-advanced-permissions-enabled :group-manager)
  ;; Make sure only Super user or Group Managers can call this
  (validation/check-group-manager)
  (let [old (t2/select-one PermissionsGroupMembership :id id)]
    (api/check-404 old)
    (validation/check-manager-of-group (:group_id old))
    (api/check
     (t2/exists? User :id (:user_id old) :is_superuser false)
     [400 (tru "Admin cant be a group manager.")])
    (t2/update! PermissionsGroupMembership (:id old)
                {:is_group_manager is_group_manager})
    (t2/select-one PermissionsGroupMembership :id (:id old))))

/membership/:group-id/clear

(api/defendpoint PUT 
  "Remove all members from a `PermissionsGroup`. Returns a 400 (Bad Request) if the group ID is for the admin group."
  [group-id]
  {group-id ms/PositiveInt}
  (validation/check-manager-of-group group-id)
  (api/check-404 (t2/exists? PermissionsGroup :id group-id))
  (api/check-400 (not= group-id (u/the-id (perms-group/admin))))
  (t2/delete! PermissionsGroupMembership :group_id group-id)
  api/generic-204-no-content)

/membership/:id

(api/defendpoint DELETE 
  "Remove a User from a PermissionsGroup (delete their membership)."
  [id]
  {id ms/PositiveInt}
  (let [membership (t2/select-one PermissionsGroupMembership :id id)]
    (api/check-404 membership)
    (validation/check-manager-of-group (:group_id membership))
    (t2/delete! PermissionsGroupMembership :id id)
    api/generic-204-no-content))

------------------------------------------- Execution Endpoints -------------------------------------------

/execution/graph

(api/defendpoint GET 
  "Fetch a graph of execution permissions."
  []
  (api/check-superuser)
  (perms/execution-perms-graph))

/execution/graph

(api/defendpoint PUT 
  "Do a batch update of execution permissions by passing in a modified graph. The modified graph of the same
  form as returned by the corresponding GET endpoint.
  Revisions to the permissions graph are tracked. If you fetch the permissions graph and some other third-party
  modifies it before you can submit you revisions, the endpoint will instead make no changes and return a
  409 (Conflict) response. In this case, you should fetch the updated graph and make desired changes to that."
  [:as {body :body}]
  {body [:map]}
  (api/check-superuser)
  ;; TODO remove api.permission-graph/converted-json->graph call
  (let [graph (api.permission-graph/converted-json->graph ::api.permission-graph/execution-permissions-graph body)]
    (when (= graph :clojure.spec.alpha/invalid)
      (throw (ex-info (tru "Invalid execution permission graph: {0}"
                           (s/explain-str ::api.permission-graph/execution-permissions-graph body))
                      {:status-code 400
                       :error       (s/explain-data ::api.permission-graph/execution-permissions-graph body)})))
    (perms/update-execution-perms-graph! graph))
  (perms/execution-perms-graph))
(api/define-routes)
 
(ns metabase.api.persist
  (:require
   [clojure.string :as str]
   [compojure.core :refer [GET POST]]
   [honey.sql.helpers :as sql.helpers]
   [medley.core :as m]
   [metabase.api.common :as api]
   [metabase.api.common.validation :as validation]
   [metabase.driver.ddl.interface :as ddl.i]
   [metabase.models.database :refer [Database]]
   [metabase.models.interface :as mi]
   [metabase.models.persisted-info
    :as persisted-info
    :refer [PersistedInfo]]
   [metabase.public-settings :as public-settings]
   [metabase.server.middleware.offset-paging :as mw.offset-paging]
   [metabase.task.persist-refresh :as task.persist-refresh]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

Returns a list of persisted info, annotated with databasename, cardname, and schema_name.

(defn- fetch-persisted-info
  [{:keys [persisted-info-id card-id db-ids]} limit offset]
  (let [site-uuid-str    (public-settings/site-uuid)
        db-id->fire-time (task.persist-refresh/job-info-by-db-id)
        query            (cond-> {:select    [:p.id :p.database_id :p.definition
                                              :p.active :p.state :p.error
                                              :p.refresh_begin :p.refresh_end
                                              :p.table_name :p.creator_id
                                              :p.card_id [:c.name :card_name]
                                              [:c.archived :card_archived]
                                              [:c.dataset :card_dataset]
                                              [:db.name :database_name]
                                              [:col.id :collection_id] [:col.name :collection_name]
                                              [:col.authority_level :collection_authority_level]]
                                  :from      [[:persisted_info :p]]
                                  :left-join [[:metabase_database :db] [:= :db.id :p.database_id]
                                              [:report_card :c]        [:= :c.id :p.card_id]
                                              [:collection :col]       [:= :c.collection_id :col.id]]
                                  :order-by  [[:p.refresh_begin :desc]]}
                           persisted-info-id (sql.helpers/where [:= :p.id persisted-info-id])
                           (seq db-ids)      (sql.helpers/where [:in :p.database_id db-ids])
                           card-id           (sql.helpers/where [:= :p.card_id card-id])
                           limit             (sql.helpers/limit limit)
                           offset            (sql.helpers/offset offset))]
    (as-> (t2/select PersistedInfo query) results
      (t2/hydrate results :creator)
      (map (fn [{:keys [database_id] :as pi}]
             (assoc pi
                    :schema_name (ddl.i/schema-name {:id database_id} site-uuid-str)
                    :next-fire-time (get-in db-id->fire-time [database_id :next-fire-time])))
           results))))

/

(api/defendpoint GET 
  "List the entries of [[PersistedInfo]] in order to show a status page."
  []
  (validation/check-has-application-permission :monitoring)
  (let [db-ids (t2/select-fn-set :database_id PersistedInfo)
        writable-db-ids (when (seq db-ids)
                          (->> (t2/select Database :id [:in db-ids])
                               (filter mi/can-write?)
                               (map :id)
                               set))
        persisted-infos (fetch-persisted-info {:db-ids writable-db-ids} mw.offset-paging/*limit* mw.offset-paging/*offset*)]
    {:data   persisted-infos
     :total  (if (seq writable-db-ids)
               (t2/count PersistedInfo :database_id [:in writable-db-ids])
               0)
     :limit  mw.offset-paging/*limit*
     :offset mw.offset-paging/*offset*}))

/:persisted-info-id

(api/defendpoint GET 
  "Fetch a particular [[PersistedInfo]] by id."
  [persisted-info-id]
  {persisted-info-id [:maybe ms/PositiveInt]}
  (api/let-404 [persisted-info (first (fetch-persisted-info {:persisted-info-id persisted-info-id} nil nil))]
    (api/write-check (t2/select-one Database :id (:database_id persisted-info)))
    persisted-info))

/card/:card-id

(api/defendpoint GET 
  "Fetch a particular [[PersistedInfo]] by card-id."
  [card-id]
  {card-id [:maybe ms/PositiveInt]}
  (api/let-404 [persisted-info (first (fetch-persisted-info {:card-id card-id} nil nil))]
    (api/write-check (t2/select-one Database :id (:database_id persisted-info)))
    persisted-info))

Schema representing valid cron schedule for refreshing persisted models.

(def ^:private CronSchedule
  (mu/with-api-error-message
    [:and
     ms/NonBlankString
     [:fn {:error/message (deferred-tru "String representing a cron schedule")} #(= 7 (count (str/split % #" ")))]]
    (deferred-tru "Value must be a string representing a cron schedule of format <seconds> <minutes> <hours> <day of month> <month> <day of week> <year>")))

/set-refresh-schedule

(api/defendpoint POST 
  "Set the cron schedule to refresh persisted models.
   Shape should be JSON like {cron: \"0 30 1/8 * * ? *\"}."
  [:as {{:keys [cron], :as _body} :body}]
  {cron CronSchedule}
  (validation/check-has-application-permission :setting)
  (when cron
    (when-not (and (string? cron)
                   (org.quartz.CronExpression/isValidExpression cron)
                   (str/ends-with? cron "*"))
      (throw (ex-info (tru "Must be a valid cron string not specifying a year")
                      {:status-code 400})))
    (public-settings/persisted-model-refresh-cron-schedule! cron))
  (task.persist-refresh/reschedule-refresh!)
  api/generic-204-no-content)

/enable

(api/defendpoint POST 
  "Enable global setting to allow databases to persist models."
  []
  (validation/check-has-application-permission :setting)
  (log/info (tru "Enabling model persistence"))
  (public-settings/persisted-models-enabled! true)
  (task.persist-refresh/enable-persisting!)
  api/generic-204-no-content)

Disables persistence. - update all [[PersistedInfo]] rows to be inactive and deletable - remove :persist-models-enabled from relevant [[Database]] settings - schedule a task to [[metabase.driver.ddl.interface/unpersist]] each table

(defn- disable-persisting
  []
  (let [id->db      (m/index-by :id (t2/select Database))
        enabled-dbs (filter (comp :persist-models-enabled :settings) (vals id->db))]
    (log/info (tru "Disabling model persistence"))
    (doseq [db enabled-dbs]
      (t2/update! Database (u/the-id db)
                  {:settings (not-empty (dissoc (:settings db) :persist-models-enabled))}))
    (task.persist-refresh/disable-persisting!)))

/disable

(api/defendpoint POST 
  "Disable global setting to allow databases to persist models. This will remove all tasks to refresh tables, remove
  that option from databases which might have it enabled, and delete all cached tables."
  []
  (validation/check-has-application-permission :setting)
  (when (public-settings/persisted-models-enabled)
    (try (public-settings/persisted-models-enabled! false)
         (disable-persisting)
         (catch Exception e
           ;; re-enable so can continue to attempt to clean up
           (public-settings/persisted-models-enabled! true)
           (throw e))))
  api/generic-204-no-content)
(api/define-routes)
 
(ns metabase.api.premium-features
  (:require
   [compojure.core :refer [GET]]
   [metabase.api.common :as api]
   [metabase.public-settings.premium-features :as premium-features]))

/token/status

(api/defendpoint GET 
  "Fetch info about the current Premium-Features premium features token including whether it is `valid`, a `trial` token, its
  `features`, when it is `valid-thru`, and the `status` of the account."
  []
  (premium-features/fetch-token-status (api/check-404 (premium-features/premium-embedding-token))))
(api/define-routes api/+check-superuser)
 

Endpoints for previewing how Cards and Dashboards will look when embedding them. These endpoints are basically identical in functionality to the ones in /api/embed, but:

  1. Require admin access
  2. Ignore the values of :enabled_embedding for Cards/Dashboards
  3. Ignore the :embed_params whitelist for Card/Dashboards, instead using a field called :_embedding_params in the JWT token itself.

    Refer to the documentation for those endpoints for further details.

(ns metabase.api.preview-embed
  (:require
   [compojure.core :refer [GET]]
   [metabase.api.common :as api]
   [metabase.api.common.validation :as validation]
   [metabase.api.embed :as api.embed]
   [metabase.query-processor.pivot :as qp.pivot]
   [metabase.util.embed :as embed]
   [metabase.util.malli.schema :as ms]))
(defn- check-and-unsign [token]
  (api/check-superuser)
  (validation/check-embedding-enabled)
  (embed/unsign token))

/card/:token

(api/defendpoint GET 
  "Fetch a Card you're considering embedding by passing a JWT `token`."
  [token]
  {token ms/NonBlankString}
  (let [unsigned-token (check-and-unsign token)]
    (api.embed/card-for-unsigned-token unsigned-token
      :embedding-params (embed/get-in-unsigned-token-or-throw unsigned-token [:_embedding_params]))))

Embedding previews need to be limited in size to avoid performance issues (#20938).

(def ^:private max-results
  2000)

/card/:token/query

(api/defendpoint GET 
  "Fetch the query results for a Card you're considering embedding by passing a JWT `token`."
  [token & query-params]
  {token ms/NonBlankString}
  (let [unsigned-token (check-and-unsign token)
        card-id        (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :question])]
    (api.embed/run-query-for-card-with-params-async
      :export-format    :api
      :card-id          card-id
      :token-params     (embed/get-in-unsigned-token-or-throw unsigned-token [:params])
      :embedding-params (embed/get-in-unsigned-token-or-throw unsigned-token [:_embedding_params])
      :constraints      {:max-results max-results}
      :query-params     query-params)))

/dashboard/:token

(api/defendpoint GET 
  "Fetch a Dashboard you're considering embedding by passing a JWT `token`. "
  [token]
  {token ms/NonBlankString}
  (let [unsigned-token (check-and-unsign token)]
    (api.embed/dashboard-for-unsigned-token unsigned-token
      :embedding-params (embed/get-in-unsigned-token-or-throw unsigned-token [:_embedding_params]))))

/dashboard/:token/dashcard/:dashcard-id/card/:card-id

(api/defendpoint GET 
  "Fetch the results of running a Card belonging to a Dashboard you're considering embedding with JWT `token`."
  [token dashcard-id card-id & query-params]
  {token       ms/NonBlankString
   dashcard-id ms/PositiveInt
   card-id     ms/PositiveInt}
  (let [unsigned-token   (check-and-unsign token)
        dashboard-id     (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :dashboard])
        embedding-params (embed/get-in-unsigned-token-or-throw unsigned-token [:_embedding_params])
        token-params     (embed/get-in-unsigned-token-or-throw unsigned-token [:params])]
    (api.embed/dashcard-results-async
      :export-format    :api
      :dashboard-id     dashboard-id
      :dashcard-id      dashcard-id
      :card-id          card-id
      :embedding-params embedding-params
      :token-params     token-params
      :query-params     query-params)))

/pivot/card/:token/query

(api/defendpoint GET 
  "Fetch the query results for a Card you're considering embedding by passing a JWT `token`."
  [token & query-params]
  {token ms/NonBlankString}
  (let [unsigned-token (check-and-unsign token)
        card-id        (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :question])]
    (api.embed/run-query-for-card-with-params-async
      :export-format    :api
      :card-id          card-id
      :token-params     (embed/get-in-unsigned-token-or-throw unsigned-token [:params])
      :embedding-params (embed/get-in-unsigned-token-or-throw unsigned-token [:_embedding_params])
      :query-params     query-params
      :qp-runner        qp.pivot/run-pivot-query)))

/pivot/dashboard/:token/dashcard/:dashcard-id/card/:card-id

(api/defendpoint GET 
  "Fetch the results of running a Card belonging to a Dashboard you're considering embedding with JWT `token`."
  [token dashcard-id card-id & query-params]
  {token       ms/NonBlankString
   dashcard-id ms/PositiveInt
   card-id     ms/PositiveInt}
  (let [unsigned-token   (check-and-unsign token)
        dashboard-id     (embed/get-in-unsigned-token-or-throw unsigned-token [:resource :dashboard])
        embedding-params (embed/get-in-unsigned-token-or-throw unsigned-token [:_embedding_params])
        token-params     (embed/get-in-unsigned-token-or-throw unsigned-token [:params])]
    (api.embed/dashcard-results-async
      :export-format    :api
      :dashboard-id     dashboard-id
      :dashcard-id      dashcard-id
      :card-id          card-id
      :embedding-params embedding-params
      :token-params     token-params
      :query-params     query-params
      :qp-runner        qp.pivot/run-pivot-query)))
(api/define-routes)
 

Metabase API endpoints for viewing publicly-accessible Cards and Dashboards.

(ns metabase.api.public
  (:require
   [cheshire.core :as json]
   [clojure.core.async :as a]
   [compojure.core :refer [GET]]
   [medley.core :as m]
   [metabase.actions :as actions]
   [metabase.actions.execution :as actions.execution]
   [metabase.analytics.snowplow :as snowplow]
   [metabase.api.card :as api.card]
   [metabase.api.common :as api]
   [metabase.api.common.validation :as validation]
   [metabase.api.dashboard :as api.dashboard]
   [metabase.api.dataset :as api.dataset]
   [metabase.api.field :as api.field]
   [metabase.async.util :as async.u]
   [metabase.db.util :as mdb.u]
   [metabase.events :as events]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.action :as action]
   [metabase.models.card :as card :refer [Card]]
   [metabase.models.dashboard :refer [Dashboard]]
   [metabase.models.dimension :refer [Dimension]]
   [metabase.models.field :refer [Field]]
   [metabase.models.interface :as mi]
   [metabase.models.params :as params]
   [metabase.query-processor :as qp]
   [metabase.query-processor.card :as qp.card]
   [metabase.query-processor.dashboard :as qp.dashboard]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.middleware.constraints :as qp.constraints]
   [metabase.query-processor.pivot :as qp.pivot]
   [metabase.query-processor.streaming :as qp.streaming]
   [metabase.server.middleware.session :as mw.session]
   [metabase.util :as u]
   [metabase.util.embed :as embed]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli.schema :as ms]
   [schema.core :as s]
   [throttle.core :as throttle]
   [toucan2.core :as t2])
  (:import
   (clojure.lang ExceptionInfo)))
(set! *warn-on-reflection* true)
(def ^:private ^:const ^Integer default-embed-max-height 800)
(def ^:private ^:const ^Integer default-embed-max-width 1024)

-------------------------------------------------- Public Cards --------------------------------------------------

Update card.parameters to include parameters from template-tags.

On native queries parameters exists in 2 forms: - parameters - dataset_query.native.template-tags

In most cases, these 2 are sync, meaning, if you have a template-tag, there will be a parameter. However, since card.parameters is a recently added feature, there may be instances where a template-tag is not present in the parameters. This function ensures that all template-tags are converted to parameters and added to card.parameters.

(defn combine-parameters-and-template-tags
  [{:keys [parameters] :as card}]
  (let [template-tag-parameters     (card/template-tag-parameters card)
        id->template-tags-parameter (m/index-by :id template-tag-parameters)
        id->parameter               (m/index-by :id parameters)]
    (assoc card :parameters (vals (reduce-kv (fn [acc id parameter]
                                               ;; order importance: we want the info from `template-tag` to be merged last
                                               (update acc id #(merge % parameter)))
                                             id->parameter
                                             id->template-tags-parameter)))))

Remove everyting from public card that shouldn't be visible to the general public.

(defn- remove-card-non-public-columns
  [card]
  (mi/instance
   Card
   (u/select-nested-keys card [:id :name :description :display :visualization_settings :parameters
                               [:dataset_query :type [:native :template-tags]]])))

Return a public Card matching key-value conditions, removing all columns that should not be visible to the general public. Throws a 404 if the Card doesn't exist.

(defn public-card
  [& conditions]
  (binding [params/*ignore-current-user-perms-and-return-all-field-values* true]
    (-> (api/check-404 (apply t2/select-one [Card :id :dataset_query :description :display :name :parameters :visualization_settings]
                              :archived false, conditions))
        remove-card-non-public-columns
        combine-parameters-and-template-tags
        (t2/hydrate :param_values :param_fields))))
(defn- card-with-uuid [uuid] (public-card :public_uuid uuid))

/card/:uuid

(api/defendpoint GET 
  "Fetch a publicly-accessible Card an return query results as well as `:card` information. Does not require auth
   credentials. Public sharing must be enabled."
  [uuid]
  {uuid ms/UUIDString}
  (validation/check-public-sharing-enabled)
  (card-with-uuid uuid))

Transform results to be suitable for a public endpoint

(defmulti ^:private transform-results
  {:arglists '([results])}
  :status)
(defmethod transform-results :default
  [x]
  x)
(defmethod transform-results :completed
  [results]
  (u/select-nested-keys
   results
   [[:data :cols :rows :rows_truncated :insights :requested_timezone :results_timezone]
    [:json_query :parameters]
    :status]))
(defmethod transform-results :failed
  [{error-type :error_type, :as results}]
  ;; if the query failed instead, unless the error type is specified and is EXPLICITLY allowed to be shown for embeds,
  ;; instead of returning anything about the query just return a generic error message
  (merge
   (select-keys results [:status :error :error_type])
   (when-not (qp.error-type/show-in-embeds? error-type)
     {:error (tru "An error occurred while running the query.")})))

Reducer function for public data

(defn public-reducedf
  [orig-reducedf]
  (fn [final-metadata context]
    (orig-reducedf (transform-results final-metadata) context)))

Create the :run function used for [[run-query-for-card-with-id-async]] and [[public-dashcard-results-async]].

(defn- run-query-for-card-with-id-async-run-fn
  [qp-runner export-format]
  (fn [query info]
    (qp.streaming/streaming-response [{:keys [rff], {:keys [reducedf], :as context} :context}
                                      export-format
                                      (u/slugify (:card-name info))]
      (let [context  (assoc context :reducedf (public-reducedf reducedf))
            in-chan  (mw.session/as-admin
                       (qp-runner query info rff context))
            out-chan (a/promise-chan (map transform-results))]
        (async.u/promise-pipe in-chan out-chan)
        out-chan))))

Run the query belonging to Card with card-id with parameters and other query options (e.g. :constraints). Returns a StreamingResponse object that should be returned as the result of an API endpoint.

(defn run-query-for-card-with-id-async
  [card-id export-format parameters & {:keys [qp-runner]
                                       :or   {qp-runner qp/process-query-and-save-execution!}
                                       :as   options}]
  {:pre [(integer? card-id)]}
  ;; run this query with full superuser perms
  ;;
  ;; we actually need to bind the current user perms here twice, once so `card-api` will have the full perms when it
  ;; tries to do the `read-check`, and a second time for when the query is ran (async) so the QP middleware will have
  ;; the correct perms
  (mw.session/as-admin
   (m/mapply qp.card/run-query-for-card-async card-id export-format
             :parameters parameters
             :context    :public-question
             :run        (run-query-for-card-with-id-async-run-fn qp-runner export-format)
             options)))

Run query for a public Card with UUID. If public sharing is not enabled, this throws an exception. Returns a StreamingResponse object that should be returned as the result of an API endpoint.

(s/defn ^:private run-query-for-card-with-public-uuid-async
  [uuid export-format parameters & options]
  (validation/check-public-sharing-enabled)
  (let [card-id (api/check-404 (t2/select-one-pk Card :public_uuid uuid, :archived false))]
    (apply run-query-for-card-with-id-async card-id export-format parameters options)))

/card/:uuid/query

(api/defendpoint GET 
  "Fetch a publicly-accessible Card an return query results as well as `:card` information. Does not require auth
   credentials. Public sharing must be enabled."
  [uuid parameters]
  {uuid       ms/UUIDString
   parameters [:maybe ms/JSONString]}
  (run-query-for-card-with-public-uuid-async uuid :api (json/parse-string parameters keyword)))

/card/:uuid/query/:export-format

(api/defendpoint GET 
  "Fetch a publicly-accessible Card and return query results in the specified format. Does not require auth
  credentials. Public sharing must be enabled."
  [uuid export-format :as {{:keys [parameters]} :params}]
  {uuid          ms/UUIDString
   export-format api.dataset/ExportFormat
   parameters    [:maybe ms/JSONString]}
  (run-query-for-card-with-public-uuid-async
   uuid
   export-format
   (json/parse-string parameters keyword)
   :constraints nil
   :middleware {:process-viz-settings? true
                :js-int-to-string?     false
                :format-rows?          false}))

----------------------------------------------- Public Dashboards ------------------------------------------------

The only keys for an action that should be visible to the general public.

(def ^:private action-public-keys
  #{:name
    :id
    :database_id ;; needed to check if the database has actions enabled on the frontend
    :visualization_settings
    :parameters})

Returns a public version of action, removing all data that should not be visible to the general public.

(defn- public-action
  [action]
  (let [hidden-parameter-ids (->> (get-in action [:visualization_settings :fields])
                                  vals
                                  (keep (fn [x]
                                          (when (true? (:hidden x))
                                            (:id x))))
                                  set)]
    (-> action
        (update :parameters (fn [parameters]
                              (remove #(contains? hidden-parameter-ids (:id %)) parameters)))
        (update-in [:visualization_settings :fields] (fn [fields]
                                                       (m/remove-keys hidden-parameter-ids fields)))
        (select-keys action-public-keys))))

Return a public Dashboard matching key-value conditions, removing all columns that should not be visible to the general public. Throws a 404 if the Dashboard doesn't exist.

(defn public-dashboard
  [& conditions]
  {:pre [(even? (count conditions))]}
  (binding [params/*ignore-current-user-perms-and-return-all-field-values* true]
    (-> (api/check-404 (apply t2/select-one [Dashboard :name :description :id :parameters :auto_apply_filters], :archived false, conditions))
        (t2/hydrate [:dashcards :card :series :dashcard/action] :tabs :param_values :param_fields)
        api.dashboard/add-query-average-durations
        (update :dashcards (fn [dashcards]
                             (for [dashcard dashcards]
                               (-> (select-keys dashcard [:id :card :card_id :dashboard_id :series :col :row :size_x :dashboard_tab_id
                                                          :size_y :parameter_mappings :visualization_settings :action])
                                   (update :card remove-card-non-public-columns)
                                   (update :series (fn [series]
                                                     (for [series series]
                                                       (remove-card-non-public-columns series))))
                                   (m/update-existing :action public-action))))))))
(defn- dashboard-with-uuid [uuid] (public-dashboard :public_uuid uuid))

/dashboard/:uuid

(api/defendpoint GET 
  "Fetch a publicly-accessible Dashboard. Does not require auth credentials. Public sharing must be enabled."
  [uuid]
  {uuid ms/UUIDString}
  (validation/check-public-sharing-enabled)
  (u/prog1 (dashboard-with-uuid uuid)
           (events/publish-event! :event/dashboard-read {:user-id api/*current-user-id*
                                                         :object  <>})))

Return the results of running a query for Card with card-id belonging to Dashboard with dashboard-id via dashcard-id. card-id, dashboard-id, and dashcard-id are all required; other parameters are optional:

  • parameters - MBQL query parameters, either already parsed or as a serialized JSON string
  • export-format - :api (default format with metadata), :json (results only), :csv, or :xslx. Default: :api
  • qp-runner - QP function to run the query with. Default [[qp/process-query-and-save-execution!]]

Throws a 404 immediately if the Card isn't part of the Dashboard. Returns a StreamingResponse.

TODO -- this should probably have a name like run-query-for-dashcard... so it matches up with [[run-query-for-card-with-id-async]]

(defn public-dashcard-results-async
  {:arglists '([& {:keys [dashboard-id card-id dashcard-id export-format parameters] :as options}])}
  [& {:keys [export-format parameters qp-runner]
      :or   {qp-runner     qp/process-query-and-save-execution!
             export-format :api}
      :as   options}]
  (let [options (merge
                 {:context     :public-dashboard
                  :constraints (qp.constraints/default-query-constraints)}
                 options
                 {:parameters    (cond-> parameters
                                   (string? parameters) (json/parse-string keyword))
                  :export-format export-format
                  :qp-runner     qp-runner
                  :run           (run-query-for-card-with-id-async-run-fn qp-runner export-format)})]
    ;; Run this query with full superuser perms. We don't want the various perms checks failing because there are no
    ;; current user perms; if this Dashcard is public you're by definition allowed to run it without a perms check
    ;; anyway
    (mw.session/as-admin
     (m/mapply qp.dashboard/run-query-for-dashcard-async options))))

/dashboard/:uuid/dashcard/:dashcard-id/card/:card-id

(api/defendpoint GET 
  "Fetch the results for a Card in a publicly-accessible Dashboard. Does not require auth credentials. Public
   sharing must be enabled."
  [uuid card-id dashcard-id parameters]
  {uuid        ms/UUIDString
   dashcard-id ms/PositiveInt
   card-id     ms/PositiveInt
   parameters  [:maybe ms/JSONString]}
  (validation/check-public-sharing-enabled)
  (let [dashboard-id (api/check-404 (t2/select-one-pk Dashboard :public_uuid uuid, :archived false))]
    (public-dashcard-results-async
     :dashboard-id  dashboard-id
     :card-id       card-id
     :dashcard-id   dashcard-id
     :export-format :api
     :parameters    parameters)))

/dashboard/:uuid/dashcard/:dashcard-id/execute

(api/defendpoint GET 
  "Fetches the values for filling in execution parameters. Pass PK parameters and values to select."
  [uuid dashcard-id parameters]
  {uuid        ms/UUIDString
   dashcard-id ms/PositiveInt
   parameters  ms/JSONString}
  (validation/check-public-sharing-enabled)
  (api/check-404 (t2/select-one-pk Dashboard :public_uuid uuid :archived false))
  (actions.execution/fetch-values
   (api/check-404 (action/dashcard->action dashcard-id))
   (json/parse-string parameters)))
(def ^:private dashcard-execution-throttle (throttle/make-throttler :dashcard-id :attempts-threshold 5000))

/dashboard/:uuid/dashcard/:dashcard-id/execute

(api/defendpoint POST 
  "Execute the associated Action in the context of a `Dashboard` and `DashboardCard` that includes it.
   `parameters` should be the mapped dashboard parameters with values."
  [uuid dashcard-id :as {{:keys [parameters], :as _body} :body}]
  {uuid        ms/UUIDString
   dashcard-id ms/PositiveInt
   parameters  [:maybe [:map-of :keyword :any]]}
  (let [throttle-message (try
                           (throttle/check dashcard-execution-throttle dashcard-id)
                           nil
                           (catch ExceptionInfo e
                             (get-in (ex-data e) [:errors :dashcard-id])))
        throttle-time (when throttle-message
                        (second (re-find #"You must wait ([0-9]+) seconds" throttle-message)))]
    (if throttle-message
      (cond-> {:status 429
               :body throttle-message}
        throttle-time (assoc :headers {"Retry-After" throttle-time}))
      (do
        (validation/check-public-sharing-enabled)
        (let [dashboard-id (api/check-404 (t2/select-one-pk Dashboard :public_uuid uuid, :archived false))]
          ;; Run this query with full superuser perms. We don't want the various perms checks
          ;; failing because there are no current user perms; if this Dashcard is public
          ;; you're by definition allowed to run it without a perms check anyway
          (binding [api/*current-user-permissions-set* (delay #{"/"})]
            ;; Undo middleware string->keyword coercion
            (actions.execution/execute-dashcard! dashboard-id dashcard-id (update-keys parameters name))))))))

/oembed

(api/defendpoint GET 
  "oEmbed endpoint used to retreive embed code and metadata for a (public) Metabase URL."
  [url format maxheight maxwidth]
  ;; the format param is not used by the API, but is required as part of the oEmbed spec: http://oembed.com/#section2
  ;; just return an error if `format` is specified and it's anything other than `json`.
  {url       ms/NonBlankString
   format    [:maybe [:enum "json"]]
   maxheight [:maybe ms/IntString]
   maxwidth  [:maybe ms/IntString]}
  (let [height (if maxheight (Integer/parseInt maxheight) default-embed-max-height)
        width  (if maxwidth  (Integer/parseInt maxwidth)  default-embed-max-width)]
    {:version "1.0"
     :type    "rich"
     :width   width
     :height  height
     :html    (embed/iframe url width height)}))

----------------------------------------------- Public Action ------------------------------------------------

/action/:uuid

(api/defendpoint GET 
  "Fetch a publicly-accessible Action. Does not require auth credentials. Public sharing must be enabled."
  [uuid]
  {uuid ms/UUIDString}
  (validation/check-public-sharing-enabled)
  (let [action (api/check-404 (action/select-action :public_uuid uuid :archived false))]
    (actions/check-actions-enabled! action)
    (public-action action)))

+----------------------------------------------------------------------------------------------------------------+ | FieldValues, Search, Remappings | +----------------------------------------------------------------------------------------------------------------+

-------------------------------------------------- Field Values --------------------------------------------------

Get the IDs of all Fields referenced by an MBQL query (not including any parameters).

(defn- query->referenced-field-ids
  [query]
  (mbql.u/match (:query query) [:field id _] id))

Return a set of all Field IDs referenced by card, in both the MBQL query itself and in its parameters ('template tags').

(defn- card->referenced-field-ids
  [card]
  (set (concat (query->referenced-field-ids (:dataset_query card))
               (params/card->template-tag-field-ids card))))

Check to make sure the query for Card with card-id references Field with field-id. Otherwise, or if the Card cannot be found, throw an Exception.

(defn- check-field-is-referenced-by-card
  [field-id card-id]
  (let [card                 (api/check-404 (t2/select-one [Card :dataset_query] :id card-id))
        referenced-field-ids (card->referenced-field-ids card)]
    (api/check-404 (contains? referenced-field-ids field-id))))

Check whether a search Field is allowed to be used in conjunction with another Field. A search Field is allowed if any of the following conditions is true:

  • search-field-id and field-id are both the same Field
  • search-field-id is equal to the other Field's Dimension's human-readable-field-id
  • field is a :type/PK Field and search field is a :type/Name Field belonging to the same Table.

If none of these conditions are met, you are not allowed to use the search field in combination with the other field, and an 400 exception will be thrown.

(defn- check-search-field-is-allowed
  [field-id search-field-id]
  {:pre [(integer? field-id) (integer? search-field-id)]}
  (api/check-400
   (or (= field-id search-field-id)
       (t2/exists? Dimension :field_id field-id, :human_readable_field_id search-field-id)
       ;; just do a couple small queries to figure this out, we could write a fancy query to join Field against itself
       ;; and do this in one but the extra code complexity isn't worth it IMO
       (when-let [table-id (t2/select-one-fn :table_id Field :id field-id, :semantic_type (mdb.u/isa :type/PK))]
         (t2/exists? Field :id search-field-id, :table_id table-id, :semantic_type (mdb.u/isa :type/Name))))))

Check that field-id belongs to a Field that is used as a parameter in a Dashboard with dashboard-id, or throw a 404 Exception.

(defn- check-field-is-referenced-by-dashboard
  [field-id dashboard-id]
  (let [dashboard       (-> (t2/select-one Dashboard :id dashboard-id)
                            api/check-404
                            (t2/hydrate [:dashcards :card]))
        param-field-ids (params/dashcards->param-field-ids (:dashcards dashboard))]
    (api/check-404 (contains? param-field-ids field-id))))

Return the FieldValues for a Field with field-id that is referenced by Card with card-id.

(defn card-and-field-id->values
  [card-id field-id]
  (check-field-is-referenced-by-card field-id card-id)
  (api.field/field->values (t2/select-one Field :id field-id)))

/card/:uuid/field/:field-id/values

(api/defendpoint GET 
  "Fetch FieldValues for a Field that is referenced by a public Card."
  [uuid field-id]
  {uuid     ms/UUIDString
   field-id ms/PositiveInt}
  (validation/check-public-sharing-enabled)
  (let [card-id (t2/select-one-pk Card :public_uuid uuid, :archived false)]
    (card-and-field-id->values card-id field-id)))

Return the FieldValues for a Field with field-id that is referenced by Card with card-id which itself is present in Dashboard with dashboard-id.

(defn dashboard-and-field-id->values
  [dashboard-id field-id]
  (check-field-is-referenced-by-dashboard field-id dashboard-id)
  (api.field/field->values (t2/select-one Field :id field-id)))

/dashboard/:uuid/field/:field-id/values

(api/defendpoint GET 
  "Fetch FieldValues for a Field that is referenced by a Card in a public Dashboard."
  [uuid field-id]
  {uuid     ms/UUIDString
   field-id ms/PositiveInt}
  (validation/check-public-sharing-enabled)
  (let [dashboard-id (api/check-404 (t2/select-one-pk Dashboard :public_uuid uuid, :archived false))]
    (dashboard-and-field-id->values dashboard-id field-id)))

--------------------------------------------------- Searching ----------------------------------------------------

Wrapper for metabase.api.field/search-values for use with public/embedded Cards. See that functions documentation for a more detailed explanation of exactly what this does.

(defn search-card-fields
  [card-id field-id search-id value limit]
  (check-field-is-referenced-by-card field-id card-id)
  (check-search-field-is-allowed field-id search-id)
  (api.field/search-values (t2/select-one Field :id field-id) (t2/select-one Field :id search-id) value limit))

Wrapper for metabase.api.field/search-values for use with public/embedded Dashboards. See that functions documentation for a more detailed explanation of exactly what this does.

(defn search-dashboard-fields
  [dashboard-id field-id search-id value limit]
  (check-field-is-referenced-by-dashboard field-id dashboard-id)
  (check-search-field-is-allowed field-id search-id)
  (api.field/search-values (t2/select-one Field :id field-id) (t2/select-one Field :id search-id) value limit))

/card/:uuid/field/:field-id/search/:search-field-id

(api/defendpoint GET 
  "Search for values of a Field that is referenced by a public Card."
  [uuid field-id search-field-id value limit]
  {uuid            ms/UUIDString
   field-id        ms/PositiveInt
   search-field-id ms/PositiveInt
   value           ms/NonBlankString
   limit           [:maybe ms/PositiveInt]}
  (validation/check-public-sharing-enabled)
  (let [card-id (t2/select-one-pk Card :public_uuid uuid, :archived false)]
    (search-card-fields card-id field-id search-field-id value limit)))

/dashboard/:uuid/field/:field-id/search/:search-field-id

(api/defendpoint GET 
  "Search for values of a Field that is referenced by a Card in a public Dashboard."
  [uuid field-id search-field-id value limit]
  {uuid            ms/UUIDString
   field-id        ms/PositiveInt
   search-field-id ms/PositiveInt
   value           ms/NonBlankString
   limit           [:maybe ms/PositiveInt]}
  (validation/check-public-sharing-enabled)
  (let [dashboard-id (api/check-404 (t2/select-one-pk Dashboard :public_uuid uuid, :archived false))]
    (search-dashboard-fields dashboard-id field-id search-field-id value limit)))

--------------------------------------------------- Remappings ---------------------------------------------------

(defn- field-remapped-values [field-id remapped-field-id, ^String value-str]
  (let [field          (api/check-404 (t2/select-one Field :id field-id))
        remapped-field (api/check-404 (t2/select-one Field :id remapped-field-id))]
    (check-search-field-is-allowed field-id remapped-field-id)
    (api.field/remapped-value field remapped-field (api.field/parse-query-param-value-for-field field value-str))))

Return the reampped Field values for a Field referenced by a Card. This explanation is almost useless, so see the one in metabase.api.field/remapped-value if you would actually like to understand what is going on here.

(defn card-field-remapped-values
  [card-id field-id remapped-field-id, ^String value-str]
  (check-field-is-referenced-by-card field-id card-id)
  (field-remapped-values field-id remapped-field-id value-str))

Return the reampped Field values for a Field referenced by a Dashboard. This explanation is almost useless, so see the one in metabase.api.field/remapped-value if you would actually like to understand what is going on here.

(defn dashboard-field-remapped-values
  [dashboard-id field-id remapped-field-id, ^String value-str]
  (check-field-is-referenced-by-dashboard field-id dashboard-id)
  (field-remapped-values field-id remapped-field-id value-str))

/card/:uuid/field/:field-id/remapping/:remapped-id

(api/defendpoint GET 
  "Fetch remapped Field values. This is the same as `GET /api/field/:id/remapping/:remapped-id`, but for use with public
  Cards."
  [uuid field-id remapped-id value]
  {uuid        ms/UUIDString
   field-id    ms/PositiveInt
   remapped-id ms/PositiveInt
   value       ms/NonBlankString}
  (validation/check-public-sharing-enabled)
  (let [card-id (api/check-404 (t2/select-one-pk Card :public_uuid uuid, :archived false))]
    (card-field-remapped-values card-id field-id remapped-id value)))

/dashboard/:uuid/field/:field-id/remapping/:remapped-id

(api/defendpoint GET 
  "Fetch remapped Field values. This is the same as `GET /api/field/:id/remapping/:remapped-id`, but for use with public
  Dashboards."
  [uuid field-id remapped-id value]
  {uuid        ms/UUIDString
   field-id    ms/PositiveInt
   remapped-id ms/PositiveInt
   value       ms/NonBlankString}
  (validation/check-public-sharing-enabled)
  (let [dashboard-id (t2/select-one-pk Dashboard :public_uuid uuid, :archived false)]
    (dashboard-field-remapped-values dashboard-id field-id remapped-id value)))

------------------------------------------------ Param Values -------------------------------------------------

/card/:uuid/params/:param-key/values

(api/defendpoint GET 
  "Fetch values for a parameter on a public card."
  [uuid param-key]
  {uuid      ms/UUIDString
   param-key ms/NonBlankString}
  (validation/check-public-sharing-enabled)
  (let [card (t2/select-one Card :public_uuid uuid, :archived false)]
    (mw.session/as-admin
     (api.card/param-values card param-key))))

/card/:uuid/params/:param-key/search/:query

(api/defendpoint GET 
  "Fetch values for a parameter on a public card containing `query`."
  [uuid param-key query]
  {uuid      ms/UUIDString
   param-key ms/NonBlankString
   query     ms/NonBlankString}
  (validation/check-public-sharing-enabled)
  (let [card (t2/select-one Card :public_uuid uuid, :archived false)]
    (mw.session/as-admin
     (api.card/param-values card param-key query))))

/dashboard/:uuid/params/:param-key/values

(api/defendpoint GET 
  "Fetch filter values for dashboard parameter `param-key`."
  [uuid param-key :as {constraint-param-key->value :query-params}]
  {uuid      ms/UUIDString
   param-key ms/NonBlankString}
  (let [dashboard (dashboard-with-uuid uuid)]
    (mw.session/as-admin
     (api.dashboard/param-values dashboard param-key constraint-param-key->value))))

/dashboard/:uuid/params/:param-key/search/:query

(api/defendpoint GET 
  "Fetch filter values for dashboard parameter `param-key`, containing specified `query`."
  [uuid param-key query :as {constraint-param-key->value :query-params}]
  {uuid      ms/UUIDString
   param-key ms/NonBlankString
   query     ms/NonBlankString}
  (let [dashboard (dashboard-with-uuid uuid)]
    (mw.session/as-admin
     (api.dashboard/param-values dashboard param-key constraint-param-key->value query))))

----------------------------------------------------- Pivot Tables -----------------------------------------------

/pivot/card/:uuid/query

TODO -- why do these endpoints START with /pivot/ whereas the version in Dash

(api/defendpoint GET 
  "Fetch a publicly-accessible Card an return query results as well as `:card` information. Does not require auth
   credentials. Public sharing must be enabled."
  [uuid parameters]
  {uuid       ms/UUIDString
   parameters [:maybe ms/JSONString]}
  (run-query-for-card-with-public-uuid-async uuid :api (json/parse-string parameters keyword) :qp-runner qp.pivot/run-pivot-query))

/pivot/dashboard/:uuid/dashcard/:dashcard-id/card/:card-id

(api/defendpoint GET 
  "Fetch the results for a Card in a publicly-accessible Dashboard. Does not require auth credentials. Public
  sharing must be enabled."
  [uuid card-id dashcard-id parameters]
  {uuid        ms/UUIDString
   card-id     ms/PositiveInt
   dashcard-id ms/PositiveInt
   parameters  [:maybe ms/JSONString]}
  (validation/check-public-sharing-enabled)
  (let [dashboard-id (api/check-404 (t2/select-one-pk Dashboard :public_uuid uuid, :archived false))]
    (public-dashcard-results-async
     :dashboard-id  dashboard-id
     :card-id       card-id
     :dashcard-id   dashcard-id
     :export-format :api
     :parameters    parameters :qp-runner qp.pivot/run-pivot-query)))

Rate limit at 1 action per second on a per action basis. The goal of rate limiting should be to prevent very obvious abuse, but it should be relatively lax so we don't annoy legitimate users.

(def ^:private action-execution-throttle
  (throttle/make-throttler :action-uuid :attempts-threshold 1 :initial-delay-ms 1000 :delay-exponent 1))

/action/:uuid/execute

(api/defendpoint POST 
  "Execute the Action.
   `parameters` should be the mapped dashboard parameters with values."
  [uuid :as {{:keys [parameters], :as _body} :body}]
  {uuid       ms/UUIDString
   parameters [:maybe [:map-of :keyword any?]]}
  (let [throttle-message (try
                           (throttle/check action-execution-throttle uuid)
                           nil
                           (catch ExceptionInfo e
                             (get-in (ex-data e) [:errors :action-uuid])))
        throttle-time (when throttle-message
                        (second (re-find #"You must wait ([0-9]+) seconds" throttle-message)))]
    (if throttle-message
      (cond-> {:status 429
               :body   throttle-message}
        throttle-time (assoc :headers {"Retry-After" throttle-time}))
      (do
        (validation/check-public-sharing-enabled)
        ;; Run this query with full superuser perms. We don't want the various perms checks
        ;; failing because there are no current user perms; if this Dashcard is public
        ;; you're by definition allowed to run it without a perms check anyway
        (binding [api/*current-user-permissions-set* (delay #{"/"})]
          (let [action (api/check-404 (action/select-action :public_uuid uuid :archived false))]
            (snowplow/track-event! ::snowplow/action-executed api/*current-user-id* {:source    :public_form
                                                                                     :type      (:type action)
                                                                                     :action_id (:id action)})
            ;; Undo middleware string->keyword coercion
            (actions.execution/execute-action! action (update-keys parameters name))))))))

----------------------------------------- Route Definitions & Complaints -----------------------------------------

TODO - why don't we just make these routes have a bit of middleware that includes the validation/check-public-sharing-enabled check in each of them? That way we don't need to remember to include the line in every single endpoint definition here? Wouldn't that be 100x better?!

TODO - also a smart person would probably just parse the UUIDs automatically in middleware as appropriate for /dashboard vs /card

(api/define-routes)
 

/api/pulse endpoints.

(ns metabase.api.pulse
  (:require
   [clojure.set :refer [difference]]
   [compojure.core :refer [GET POST PUT]]
   [hiccup.core :refer [html]]
   [hiccup.page :refer [html5]]
   [metabase.api.alert :as api.alert]
   [metabase.api.common :as api]
   [metabase.api.common.validation :as validation]
   [metabase.config :as config]
   [metabase.email :as email]
   [metabase.events :as events]
   [metabase.integrations.slack :as slack]
   [metabase.models.card :refer [Card]]
   [metabase.models.collection :as collection]
   [metabase.models.dashboard :refer [Dashboard]]
   [metabase.models.interface :as mi]
   [metabase.models.pulse :as pulse :refer [Pulse]]
   [metabase.models.pulse-channel
    :as pulse-channel
    :refer [channel-types PulseChannel]]
   [metabase.models.pulse-channel-recipient :refer [PulseChannelRecipient]]
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.pulse]
   [metabase.pulse.preview :as preview]
   [metabase.pulse.render :as render]
   [metabase.query-processor :as qp]
   [metabase.query-processor.middleware.permissions :as qp.perms]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli.schema :as ms]
   [metabase.util.urls :as urls]
   [toucan2.core :as t2])
  (:import
   (java.io ByteArrayInputStream)))
(set! *warn-on-reflection* true)
(when config/ee-available?
  (classloader/require 'metabase-enterprise.sandbox.api.util
                       'metabase-enterprise.advanced-permissions.common))

If the current user is sandboxed, remove all Metabase users from the pulses recipient lists that are not the user themselves. Recipients that are plain email addresses are preserved.

(defn- maybe-filter-pulses-recipients
  [pulses]
  (if (premium-features/sandboxed-or-impersonated-user?)
    (for [pulse pulses]
      (assoc pulse :channels
             (for [channel (:channels pulse)]
               (assoc channel :recipients
                      (filter (fn [recipient] (or (not (:id recipient))
                                                  (= (:id recipient) api/*current-user-id*)))
                              (:recipients channel))))))
    pulses))
(defn- maybe-filter-pulse-recipients
  [pulse]
  (first (maybe-filter-pulses-recipients [pulse])))

If the current user does not have collection read permissions for the pulse, but can still read the pulse due to being the creator or a recipient, we return it with some metadata removed.

(defn- maybe-strip-sensitive-metadata
  [pulse]
  (if (mi/current-user-has-full-permissions? :read pulse)
    pulse
    (-> (dissoc pulse :cards)
        (update :channels
                (fn [channels]
                  (map #(dissoc % :recipients) channels))))))

/

(api/defendpoint GET 
  "Fetch all dashboard subscriptions. By default, returns only subscriptions for which the current user has write
  permissions. For admins, this is all subscriptions; for non-admins, it is only subscriptions that they created.
  If `dashboard_id` is specified, restricts results to subscriptions for that dashboard.
  If `created_or_receive` is `true`, it specifically returns all subscriptions for which the current user
  created *or* is a known recipient of. Note that this is a superset of the default items returned for non-admins,
  and a subset of the default items returned for admins. This is used to power the /account/notifications page.
  This may include subscriptions which the current user does not have collection permissions for, in which case
  some sensitive metadata (the list of cards and recipients) is stripped out."
  [archived dashboard_id creator_or_recipient]
  {archived             [:maybe ms/BooleanString]
   dashboard_id         [:maybe ms/PositiveInt]
   creator_or_recipient [:maybe ms/BooleanString]}
  (let [creator-or-recipient (Boolean/parseBoolean creator_or_recipient)
        archived?            (Boolean/parseBoolean archived)
        pulses               (->> (pulse/retrieve-pulses {:archived?    archived?
                                                          :dashboard-id dashboard_id
                                                          :user-id      (when creator-or-recipient api/*current-user-id*)})
                                  (filter (if creator-or-recipient mi/can-read? mi/can-write?))
                                  maybe-filter-pulses-recipients)
        pulses               (if creator-or-recipient
                               (map maybe-strip-sensitive-metadata pulses)
                               pulses)]
    (t2/hydrate pulses :can_write)))

Users can only create a pulse for cards they have access to.

(defn check-card-read-permissions
  [cards]
  (doseq [card cards
          :let [card-id (u/the-id card)]]
    (assert (integer? card-id))
    (api/read-check Card card-id)))

/

(api/defendpoint POST 
  "Create a new `Pulse`."
  [:as {{:keys [name cards channels skip_if_empty collection_id collection_position dashboard_id parameters]} :body}]
  {name                ms/NonBlankString
   cards               [:+ pulse/CoercibleToCardRef]
   channels            [:+ :map]
   skip_if_empty       [:maybe :boolean]
   collection_id       [:maybe ms/PositiveInt]
   collection_position [:maybe ms/PositiveInt]
   dashboard_id        [:maybe ms/PositiveInt]
   parameters          [:maybe [:sequential :map]]}
  (validation/check-has-application-permission :subscription false)
  ;; make sure we are allowed to *read* all the Cards we want to put in this Pulse
  (check-card-read-permissions cards)
  ;; if we're trying to create this Pulse inside a Collection, and it is not a dashboard subscription,
  ;; make sure we have write permissions for that collection
  (when-not dashboard_id
    (collection/check-write-perms-for-collection collection_id))
  ;; prohibit creating dashboard subs if the the user doesn't have at least read access for the dashboard
  (when dashboard_id
    (api/read-check Dashboard dashboard_id))
  (let [pulse-data {:name                name
                    :creator_id          api/*current-user-id*
                    :skip_if_empty       skip_if_empty
                    :collection_id       collection_id
                    :collection_position collection_position
                    :dashboard_id        dashboard_id
                    :parameters          parameters}]
    (t2/with-transaction [_conn]
     ;; Adding a new pulse at `collection_position` could cause other pulses in this collection to change position,
     ;; check that and fix it if needed
     (api/maybe-reconcile-collection-position! pulse-data)
     ;; ok, now create the Pulse
     (let [pulse (api/check-500
                  (pulse/create-pulse! (map pulse/card->ref cards) channels pulse-data))]
       (events/publish-event! :event/pulse-create {:object pulse :user-id api/*current-user-id*})
       pulse))))

/:id

(api/defendpoint GET 
  "Fetch `Pulse` with ID. If the user is a recipient of the Pulse but does not have read permissions for its collection,
  we still return it but with some sensitive metadata removed."
  [id]
  {id ms/PositiveInt}
  (api/let-404 [pulse (pulse/retrieve-pulse id)]
   (api/check-403 (mi/can-read? pulse))
   (-> pulse
       maybe-filter-pulse-recipients
       maybe-strip-sensitive-metadata
       (t2/hydrate :can_write))))

Sandboxed users and users using connection impersonation can't read the full recipient list for a pulse, so we need to merge in existing recipients before writing the pulse updates to avoid them being deleted unintentionally. We only merge in recipients that are Metabase users, not raw email addresses, which these users can still view and modify.

(defn- maybe-add-recipients
  [pulse-updates pulse-before-update]
  (if (premium-features/sandboxed-or-impersonated-user?)
    (let [recipients-to-add (filter
                             (fn [{id :id}] (and id (not= id api/*current-user-id*)))
                             (:recipients (api.alert/email-channel pulse-before-update)))]
      (assoc pulse-updates :channels
             (for [channel (:channels pulse-updates)]
               (if (= "email" (:channel_type channel))
                 (assoc channel :recipients
                        (concat (:recipients channel) recipients-to-add))
                 channel))))
    pulse-updates))

/:id

(api/defendpoint PUT 
  "Update a Pulse with `id`."
  [id :as {{:keys [name cards channels skip_if_empty collection_id archived parameters], :as pulse-updates} :body}]
  {id            ms/PositiveInt
   name          [:maybe ms/NonBlankString]
   cards         [:maybe [:+ pulse/CoercibleToCardRef]]
   channels      [:maybe [:+ :map]]
   skip_if_empty [:maybe :boolean]
   collection_id [:maybe ms/PositiveInt]
   archived      [:maybe :boolean]
   parameters    [:maybe [:sequential ms/Map]]}
  ;; do various perms checks
  (try
   (validation/check-has-application-permission :monitoring)
   (catch clojure.lang.ExceptionInfo _e
     (validation/check-has-application-permission :subscription false)))
  (let [pulse-before-update (api/write-check (pulse/retrieve-pulse id))]
    (check-card-read-permissions cards)
    (collection/check-allowed-to-change-collection pulse-before-update pulse-updates)
    ;; if advanced-permissions is enabled, only superuser or non-admin with subscription permission can
    ;; update pulse's recipients
    (when (premium-features/enable-advanced-permissions?)
      (let [to-add-recipients (difference (set (map :id (:recipients (api.alert/email-channel pulse-updates))))
                                          (set (map :id (:recipients (api.alert/email-channel pulse-before-update)))))
            current-user-has-application-permissions?
            (and (premium-features/enable-advanced-permissions?)
                 (resolve 'metabase-enterprise.advanced-permissions.common/current-user-has-application-permissions?))
            has-subscription-perms?
            (and current-user-has-application-permissions?
                 (current-user-has-application-permissions? :subscription))]
        (api/check (or api/*is-superuser?*
                       has-subscription-perms?
                       (empty? to-add-recipients))
                   [403 (tru "Non-admin users without subscription permissions are not allowed to add recipients")])))
    (let [pulse-updates (maybe-add-recipients pulse-updates pulse-before-update)]
      (t2/with-transaction [_conn]
       ;; If the collection or position changed with this update, we might need to fixup the old and/or new collection,
       ;; depending on what changed.
       (api/maybe-reconcile-collection-position! pulse-before-update pulse-updates)
       ;; ok, now update the Pulse
       (pulse/update-pulse!
        (assoc (select-keys pulse-updates [:name :cards :channels :skip_if_empty :collection_id :collection_position
                                           :archived :parameters])
               :id id)))))
  ;; return updated Pulse
  (pulse/retrieve-pulse id))

/form_input

(api/defendpoint GET 
  "Provides relevant configuration information and user choices for creating/updating Pulses."
  []
  (validation/check-has-application-permission :subscription false)
  (let [chan-types (-> channel-types
                       (assoc-in [:slack :configured] (slack/slack-configured?))
                       (assoc-in [:email :configured] (email/email-configured?)))]
    {:channels (cond
                 (premium-features/sandboxed-or-impersonated-user?)
                 (dissoc chan-types :slack)
                 ;; no Slack integration, so we are g2g
                 (not (get-in chan-types [:slack :configured]))
                 chan-types
                 ;; if we have Slack enabled return cached channels and users
                 :else
                 (try
                   (future (slack/refresh-channels-and-usernames-when-needed!))
                   (assoc-in chan-types
                             [:slack :fields 0 :options]
                             (->> (slack/slack-cached-channels-and-usernames)
                                  :channels
                                  (map :display-name)))
                   (catch Throwable e
                     (assoc-in chan-types [:slack :error] (.getMessage e)))))}))
(defn- pulse-card-query-results
  {:arglists '([card])}
  [{query :dataset_query, card-id :id}]
  (binding [qp.perms/*card-id* card-id]
    (qp/process-query-and-save-execution!
     (assoc query
            :async? false
            :middleware {:process-viz-settings? true
                         :js-int-to-string?     false})
     {:executed-by api/*current-user-id*
      :context     :pulse
      :card-id     card-id})))

/preview_card/:id

(api/defendpoint GET 
  "Get HTML rendering of a Card with `id`."
  [id]
  {id ms/PositiveInt}
  (let [card   (api/read-check Card id)
        result (pulse-card-query-results card)]
    {:status 200
     :body   (html5
              [:html
               [:body {:style "margin: 0;"}
                (binding [render/*include-title*   true
                          render/*include-buttons* true]
                  (render/render-pulse-card-for-display (metabase.pulse/defaulted-timezone card) card result))]])}))

/preview_dashboard/:id

(api/defendpoint GET 
  "Get HTML rendering of a Dashboard with `id`.
  This endpoint relies on a custom middleware defined in `metabase.pulse.preview/style-tag-nonce-middleware` to
  allow the style tag to render properly, given our Content Security Policy setup. This middleware is attached to these
  routes at the bottom of this namespace using `metabase.api.common/define-routes`."
  [id]
  {id ms/PositiveInt}
  (api/read-check :model/Dashboard id)
  {:status  200
   :headers {"Content-Type" "text/html"}
   :body    (preview/style-tag-from-inline-styles
             (html5
                 [:body [:h2 (format "Backend Artifacts Preview for Dashboard %s" id)]
                  (preview/render-dashboard-to-html id)]))})

/previewcardinfo/:id

(api/defendpoint GET 
  "Get JSON object containing HTML rendering of a Card with `id` and other information."
  [id]
  {id ms/PositiveInt}
  (let [card      (api/read-check Card id)
        result    (pulse-card-query-results card)
        data      (:data result)
        card-type (render/detect-pulse-chart-type card nil data)
        card-html (html (binding [render/*include-title* true]
                          (render/render-pulse-card-for-display (metabase.pulse/defaulted-timezone card) card result)))]
    {:id              id
     :pulse_card_type card-type
     :pulse_card_html card-html
     :pulse_card_name (:name card)
     :pulse_card_url  (urls/card-url (:id card))
     :row_count       (:row_count result)
     :col_count       (count (:cols (:data result)))}))
(def ^:private preview-card-width 400)

/previewcardpng/:id

(api/defendpoint GET 
  "Get PNG rendering of a Card with `id`."
  [id]
  {id ms/PositiveInt}
  (let [card   (api/read-check Card id)
        result (pulse-card-query-results card)
        ba     (binding [render/*include-title* true]
                 (render/render-pulse-card-to-png (metabase.pulse/defaulted-timezone card) card result preview-card-width))]
    {:status 200, :headers {"Content-Type" "image/png"}, :body (ByteArrayInputStream. ba)}))

/test

(api/defendpoint POST 
  "Test send an unsaved pulse."
  [:as {{:keys [name cards channels skip_if_empty collection_id collection_position dashboard_id] :as body} :body}]
  {name                ms/NonBlankString
   cards               [:+ pulse/CoercibleToCardRef]
   channels            [:+ :map]
   skip_if_empty       [:maybe :boolean]
   collection_id       [:maybe ms/PositiveInt]
   collection_position [:maybe ms/PositiveInt]
   dashboard_id        [:maybe ms/PositiveInt]}
  (check-card-read-permissions cards)
  ;; make sure any email addresses that are specified are allowed before sending the test Pulse.
  (doseq [channel channels]
    (pulse-channel/validate-email-domains channel))
  (metabase.pulse/send-pulse! (assoc body :creator_id api/*current-user-id*))
  {:ok true})

/:id/subscription

(api/defendpoint DELETE 
  "For users to unsubscribe themselves from a pulse subscription."
  [id]
  {id ms/PositiveInt}
  (api/let-404 [pulse-id (t2/select-one-pk Pulse :id id)
                pc-id    (t2/select-one-pk PulseChannel :pulse_id pulse-id :channel_type "email")
                pcr-id   (t2/select-one-pk PulseChannelRecipient :pulse_channel_id pc-id :user_id api/*current-user-id*)]
    (t2/delete! PulseChannelRecipient :id pcr-id))
  api/generic-204-no-content)
(def ^:private style-nonce-middleware
  (partial preview/style-tag-nonce-middleware "/api/pulse/preview_dashboard"))
(api/define-routes style-nonce-middleware)
 
(ns metabase.api.revision
  (:require
   [compojure.core :refer [GET POST]]
   [metabase.api.card :as api.card]
   [metabase.api.common :as api]
   [metabase.models.card :refer [Card]]
   [metabase.models.dashboard :refer [Dashboard]]
   [metabase.models.revision :as revision :refer [Revision]]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

Schema for a valid revisionable entity name.

(def ^:private Entity
  [:enum "card" "dashboard"])
(defn- model-and-instance [entity-name id]
  (case entity-name
    "card"      [Card (t2/select-one Card :id id)]
    "dashboard" [Dashboard (t2/select-one Dashboard :id id)]))

/

(api/defendpoint GET 
  "Get revisions of an object."
  [entity id]
  {id     ms/PositiveInt
   entity Entity}
  (let [[model instance] (model-and-instance entity id)]
   (when (api/read-check instance)
     (revision/revisions+details model id))))

/revert

(api/defendpoint POST 
  "Revert an object to a prior revision."
  [:as {{:keys [entity id revision_id]} :body}]
  {id          ms/PositiveInt
   entity      Entity
   revision_id ms/PositiveInt}
  (let [[model instance] (model-and-instance entity id)
        _                (api/write-check instance)
        revision         (api/check-404 (t2/select-one Revision :model (name model), :model_id id, :id revision_id))]
    ;; if reverting a Card, make sure we have *data* permissions to run the query we're reverting to
    (when (= model Card)
      (api.card/check-data-permissions-for-query (get-in revision [:object :dataset_query])))
    ;; ok, we're g2g
    (revision/revert!
     {:entity      model
      :id          id
      :user-id     api/*current-user-id*
      :revision-id revision_id})))
(api/define-routes)
 
(ns metabase.api.routes
  (:require
   [compojure.core :refer [context defroutes]]
   [compojure.route :as route]
   [metabase.api.action :as api.action]
   [metabase.api.activity :as api.activity]
   [metabase.api.alert :as api.alert]
   [metabase.api.api-key :as api.api-key]
   [metabase.api.automagic-dashboards :as api.magic]
   [metabase.api.bookmark :as api.bookmark]
   [metabase.api.card :as api.card]
   [metabase.api.collection :as api.collection]
   [metabase.api.dashboard :as api.dashboard]
   [metabase.api.database :as api.database]
   [metabase.api.dataset :as api.dataset]
   [metabase.api.email :as api.email]
   [metabase.api.embed :as api.embed]
   [metabase.api.field :as api.field]
   [metabase.api.geojson :as api.geojson]
   [metabase.api.google :as api.google]
   [metabase.api.ldap :as api.ldap]
   [metabase.api.login-history :as api.login-history]
   [metabase.api.metabot :as api.metabot]
   [metabase.api.metric :as api.metric]
   [metabase.api.model-index :as api.model-index]
   [metabase.api.native-query-snippet :as api.native-query-snippet]
   [metabase.api.notify :as api.notify]
   [metabase.api.permissions :as api.permissions]
   [metabase.api.persist :as api.persist]
   [metabase.api.premium-features :as api.premium-features]
   [metabase.api.preview-embed :as api.preview-embed]
   [metabase.api.public :as api.public]
   [metabase.api.pulse :as api.pulse]
   [metabase.api.revision :as api.revision]
   [metabase.api.routes.common
    :refer [+static-apikey +auth +message-only-exceptions +public-exceptions]]
   [metabase.api.search :as api.search]
   [metabase.api.segment :as api.segment]
   [metabase.api.session :as api.session]
   [metabase.api.setting :as api.setting]
   [metabase.api.setup :as api.setup]
   [metabase.api.slack :as api.slack]
   [metabase.api.table :as api.table]
   [metabase.api.task :as api.task]
   [metabase.api.testing :as api.testing]
   [metabase.api.tiles :as api.tiles]
   [metabase.api.timeline :as api.timeline]
   [metabase.api.timeline-event :as api.timeline-event]
   [metabase.api.transform :as api.transform]
   [metabase.api.user :as api.user]
   [metabase.api.util :as api.util]
   [metabase.config :as config]
   [metabase.plugins.classloader :as classloader]
   [metabase.util.i18n :refer [deferred-tru]]))
(when config/ee-available?
  (classloader/require 'metabase-enterprise.api.routes))

EE routes defined in [[metabase-enterprise.api.routes/routes]] always get the first chance to handle a request, if they exist. If they don't exist, this handler returns nil which means Compojure will try the next handler.

(def ^:private ^{:arglists '([request respond raise])} ee-routes
  ;; resolve the var for every request so we pick up any changes to it in interactive development
  (if-let [ee-handler-var (resolve 'metabase-enterprise.api.routes/routes)]
    (fn [request respond raise]
      ((var-get ee-handler-var) request respond raise))
    (fn [_request respond _raise]
      (respond nil))))

Ring routes for API endpoints.

(defroutes  routes
  ee-routes
  (context "/action"               [] (+auth api.action/routes))
  (context "/activity"             [] (+auth api.activity/routes))
  (context "/alert"                [] (+auth api.alert/routes))
  (context "/automagic-dashboards" [] (+auth api.magic/routes))
  (context "/card"                 [] (+auth api.card/routes))
  (context "/bookmark"             [] (+auth api.bookmark/routes))
  (context "/collection"           [] (+auth api.collection/routes))
  (context "/dashboard"            [] (+auth api.dashboard/routes))
  (context "/database"             [] (+auth api.database/routes))
  (context "/dataset"              [] (+auth api.dataset/routes))
  (context "/email"                [] (+auth api.email/routes))
  (context "/embed"                [] (+message-only-exceptions api.embed/routes))
  (context "/field"                [] (+auth api.field/routes))
  (context "/geojson"              [] api.geojson/routes)
  (context "/google"               [] (+auth api.google/routes))
  (context "/ldap"                 [] (+auth api.ldap/routes))
  (context "/login-history"        [] (+auth api.login-history/routes))
  (context "/premium-features"     [] (+auth api.premium-features/routes))
  (context "/metabot"              [] (+auth api.metabot/routes))
  (context "/metric"               [] (+auth api.metric/routes))
  (context "/model-index"          [] (+auth api.model-index/routes))
  (context "/native-query-snippet" [] (+auth api.native-query-snippet/routes))
  (context "/notify"               [] (+static-apikey api.notify/routes))
  (context "/permissions"          [] (+auth api.permissions/routes))
  (context "/persist"              [] (+auth api.persist/routes))
  (context "/preview_embed"        [] (+auth api.preview-embed/routes))
  (context "/public"               [] (+public-exceptions api.public/routes))
  (context "/pulse"                [] (+auth api.pulse/routes))
  (context "/revision"             [] (+auth api.revision/routes))
  (context "/search"               [] (+auth api.search/routes))
  (context "/segment"              [] (+auth api.segment/routes))
  (context "/session"              [] api.session/routes)
  (context "/setting"              [] (+auth api.setting/routes))
  (context "/setup"                [] api.setup/routes)
  (context "/slack"                [] (+auth api.slack/routes))
  (context "/table"                [] (+auth api.table/routes))
  (context "/task"                 [] (+auth api.task/routes))
  (context "/testing"              [] (if (or (not config/is-prod?)
                                              (config/config-bool :mb-enable-test-endpoints))
                                        api.testing/routes
                                        (fn [_ respond _] (respond nil))))
  (context "/tiles"                [] (+auth api.tiles/routes))
  (context "/timeline"             [] (+auth api.timeline/routes))
  (context "/timeline-event"       [] (+auth api.timeline-event/routes))
  (context "/transform"            [] (+auth api.transform/routes))
  (context "/user"                 [] (+auth api.user/routes))
  (context "/api-key"              [] (+auth api.api-key/routes))
  (context "/util"                 [] api.util/routes)
  (route/not-found (constantly {:status 404, :body (deferred-tru "API endpoint does not exist.")})))
 

Shared helpers used by [[metabase.api.routes/routes]] as well as premium-only routes like [[metabase-enterprise.sandbox.api.routes/routes]].

(ns metabase.api.routes.common
  (:require
   [metabase.server.middleware.auth :as mw.auth]
   [metabase.server.middleware.exceptions :as mw.exceptions]))

Wrap routes so any Exception except 404 thrown is just returned as a generic 400, to prevent details from leaking in public endpoints.

(def +public-exceptions
  #'mw.exceptions/public-exceptions)

Wrap routes so any Exception thrown is just returned as a 400 with only the message from the original Exception (i.e., remove the original stacktrace), to prevent details from leaking in public endpoints.

(def +message-only-exceptions
  #'mw.exceptions/message-only-exceptions)

Wrap routes so they may only be accessed with a correct API key header.

(def +static-apikey
  #'mw.auth/enforce-static-api-key)

Wrap routes so they may only be accessed with proper authentication credentials.

(def +auth
  #'mw.auth/enforce-authentication)
 
(ns metabase.api.search
  (:require
   [cheshire.core :as json]
   [compojure.core :refer [GET]]
   [honey.sql.helpers :as sql.helpers]
   [medley.core :as m]
   [metabase.analytics.snowplow :as snowplow]
   [metabase.api.common :as api]
   [metabase.db :as mdb]
   [metabase.db.query :as mdb.query]
   [metabase.models.collection :as collection]
   [metabase.models.interface :as mi]
   [metabase.models.permissions :as perms]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.search.config :as search.config :refer [SearchableModel SearchContext]]
   [metabase.search.filter :as search.filter]
   [metabase.search.scoring :as scoring]
   [metabase.search.util :as search.util]
   [metabase.server.middleware.offset-paging :as mw.offset-paging]
   [metabase.util :as u]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.i18n :refer [deferred-tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]
   [toucan2.instance :as t2.instance]
   [toucan2.realize :as t2.realize]))
(set! *warn-on-reflection* true)
(def ^:private HoneySQLColumn
  [:or
   :keyword
   [:tuple :any :keyword]])

+----------------------------------------------------------------------------------------------------------------+ | Shared Query Logic | +----------------------------------------------------------------------------------------------------------------+

(mu/defn ^:private ->column-alias :- keyword?
  "Returns the column name. If the column is aliased, i.e. [`:original_name` `:aliased_name`], return the aliased
  column name"
  [column-or-aliased :- HoneySQLColumn]
  (if (sequential? column-or-aliased)
    (second column-or-aliased)
    column-or-aliased))
(mu/defn ^:private canonical-columns :- [:sequential HoneySQLColumn]
  "Returns a seq of canonicalized list of columns for the search query with the given `model` Will return column names
  prefixed with the `model` name so that it can be used in criteria. Projects a `nil` for columns the `model` doesn't
  have and doesn't modify aliases."
  [model :- SearchableModel, col-alias->honeysql-clause :- [:map-of :keyword HoneySQLColumn]]
  (for [[search-col col-type] search.config/all-search-columns
        :let                  [maybe-aliased-col (get col-alias->honeysql-clause search-col)]]
    (cond
      (= search-col :model)
      [(h2x/literal model) :model]
      ;; This is an aliased column, no need to include the table alias
      (sequential? maybe-aliased-col)
      maybe-aliased-col
      ;; This is a column reference, need to add the table alias to the column
      maybe-aliased-col
      (search.config/column-with-model-alias model maybe-aliased-col)
      ;; This entity is missing the column, project a null for that column value. For Postgres and H2, cast it to the
      ;; correct type, e.g.
      ;;
      ;;    SELECT cast(NULL AS integer)
      ;;
      ;; For MySQL, this is not needed.
      :else
      [(when-not (= (mdb/db-type) :mysql)
         [:cast nil col-type])
       search-col])))
(mu/defn ^:private select-clause-for-model :- [:sequential HoneySQLColumn]
  "The search query uses a `union-all` which requires that there be the same number of columns in each of the segments
  of the query. This function will take the columns for `model` and will inject constant `nil` values for any column
  missing from `entity-columns` but found in `search.config/all-search-columns`."
  [model :- SearchableModel]
  (let [entity-columns                (search.config/columns-for-model model)
        column-alias->honeysql-clause (m/index-by ->column-alias entity-columns)
        cols-or-nils                  (canonical-columns model column-alias->honeysql-clause)]
    cols-or-nils))
(mu/defn ^:private from-clause-for-model :- [:tuple [:tuple :keyword :keyword]]
  [model :- SearchableModel]
  (let [{:keys [db-model alias]} (get search.config/model-to-db-model model)]
    [[(t2/table-name db-model) alias]]))
(mu/defn ^:private base-query-for-model :- [:map {:closed true}
                                            [:select :any]
                                            [:from :any]
                                            [:where :any]
                                            [:join {:optional true} :any]
                                            [:left-join {:optional true} :any]]
  "Create a HoneySQL query map with `:select`, `:from`, and `:where` clauses for `model`, suitable for the `UNION ALL`
  used in search."
  [model :- SearchableModel context :- SearchContext]
  (-> {:select (select-clause-for-model model)
       :from   (from-clause-for-model model)}
      (search.filter/build-filters model context)))

Add a WHERE clause to the query to only return Collections the Current User has access to; join against Collection so we can return its :name.

(mu/defn add-collection-join-and-where-clauses
  [honeysql-query                                :- ms/Map
   collection-id-column                          :- keyword?
   {:keys [current-user-perms
           filter-items-in-personal-collection]} :- SearchContext]
  (let [visible-collections      (collection/permissions-set->visible-collection-ids current-user-perms)
        collection-filter-clause (collection/visible-collection-ids->honeysql-filter-clause
                                  collection-id-column
                                  visible-collections)]
    (cond-> honeysql-query
      true
      (sql.helpers/where collection-filter-clause (perms/audit-namespace-clause :collection.namespace nil))
      ;; add a JOIN against Collection *unless* the source table is already Collection
      (not= collection-id-column :collection.id)
      (sql.helpers/left-join [:collection :collection]
                             [:= collection-id-column :collection.id])
      (some? filter-items-in-personal-collection)
      (sql.helpers/where
       (case filter-items-in-personal-collection
         "only"
         (concat [:or]
                 ;; sub personal collections
                 (for [id (t2/select-pks-set :model/Collection :personal_owner_id [:not= nil])]
                   [:like :collection.location (format "/%d/%%" id)])
                 ;; top level personal collections
                 [[:and
                   [:= :collection.location "/"]
                   [:not= :collection.personal_owner_id nil]]])
         "exclude"
         (conj [:or]
               (into
                [:and [:= :collection.personal_owner_id nil]]
                (for [id (t2/select-pks-set :model/Collection :personal_owner_id [:not= nil])]
                  [:not-like :collection.location (format "/%d/%%" id)]))
               [:= collection-id-column nil]))))))

Add a WHERE clause to only return tables with the given DB id. Used in data picker for joins because we can't join across DB's.

(mu/defn ^:private add-table-db-id-clause
  [query :- ms/Map id :- [:maybe ms/PositiveInt]]
  (if (some? id)
    (sql.helpers/where query [:= id :db_id])
    query))

Add a WHERE clause to only return cards with the given DB id. Used in data picker for joins because we can't join across DB's.

(mu/defn ^:private add-card-db-id-clause
  [query :- ms/Map id :- [:maybe ms/PositiveInt]]
  (if (some? id)
    (sql.helpers/where query [:= id :database_id])
    query))
(mu/defn ^:private replace-select :- :map
  "Replace a select from query that has alias is `target-alias` with [`with` `target-alias`] column, throw an error if
  can't find the target select.
  This works with the assumption that `query` contains a list of select from [[select-clause-for-model]],
  and some of them are dummy column casted to the correct type.
  This function then will replace the dummy column with alias is `target-alias` with the `with` column."
  [query        :- :map
   target-alias :- :keyword
   with         :- :keyword]
  (let [selects     (:select query)
        idx         (first (keep-indexed (fn [index item]
                                           (when (and (coll? item)
                                                      (= (last item) target-alias))
                                             index))
                                         selects))
        with-select [with target-alias]]
    (if (some? idx)
      (assoc query :select (m/replace-nth idx with-select selects))
      (throw (ex-info "Failed to replace selector" {:status-code  400
                                                    :target-alias target-alias
                                                    :with         with})))))
(mu/defn ^:private with-last-editing-info :- :map
  [query :- :map
   model :- [:enum "card" "dataset" "dashboard" "metric"]]
  (-> query
      (replace-select :last_editor_id :r.user_id)
      (replace-select :last_edited_at :r.timestamp)
      (sql.helpers/left-join [:revision :r]
                             [:and [:= :r.model_id (search.config/column-with-model-alias model :id)]
                              [:= :r.most_recent true]
                              [:= :r.model (search.config/search-model->revision-model model)]])))
(mu/defn ^:private with-moderated-status :- :map
  [query :- :map
   model :- [:enum "card" "dataset"]]
  (-> query
      (replace-select :moderated_status :mr.status)
      (sql.helpers/left-join [:moderation_review :mr]
                             [:and
                              [:= :mr.moderated_item_type "card"]
                              [:= :mr.moderated_item_id (search.config/column-with-model-alias model :id)]
                              [:= :mr.most_recent true]])))

+----------------------------------------------------------------------------------------------------------------+ | Search Queries for each Toucan Model | +----------------------------------------------------------------------------------------------------------------+

(defmulti ^:private search-query-for-model
  {:arglists '([model search-context])}
  (fn [model _] model))
(mu/defn ^:private shared-card-impl
  [model      :- [:enum "card" "dataset"]
   search-ctx :- SearchContext]
  (-> (base-query-for-model "card" search-ctx)
      (update :where (fn [where] [:and [:= :card.dataset (= "dataset" model)] where]))
      (sql.helpers/left-join [:card_bookmark :bookmark]
                             [:and
                              [:= :bookmark.card_id :card.id]
                              [:= :bookmark.user_id api/*current-user-id*]])
      (add-collection-join-and-where-clauses :card.collection_id search-ctx)
      (add-card-db-id-clause (:table-db-id search-ctx))
      (with-last-editing-info model)
      (with-moderated-status model)))
(defmethod search-query-for-model "action"
  [model search-ctx]
  (-> (base-query-for-model model search-ctx)
      (sql.helpers/left-join [:report_card :model]
                             [:= :model.id :action.model_id])
      (sql.helpers/left-join :query_action
                             [:= :query_action.action_id :action.id])
      (add-collection-join-and-where-clauses :model.collection_id search-ctx)))
(defmethod search-query-for-model "card"
  [_model search-ctx]
  (shared-card-impl "card" search-ctx))
(defmethod search-query-for-model "dataset"
  [_model search-ctx]
  (-> (shared-card-impl "dataset" search-ctx)
      (update :select (fn [columns]
                        (cons [(h2x/literal "dataset") :model] (rest columns))))))
(defmethod search-query-for-model "collection"
  [_model search-ctx]
  (-> (base-query-for-model "collection" search-ctx)
      (sql.helpers/left-join [:collection_bookmark :bookmark]
                             [:and
                              [:= :bookmark.collection_id :collection.id]
                              [:= :bookmark.user_id api/*current-user-id*]])
      (add-collection-join-and-where-clauses :collection.id search-ctx)))
(defmethod search-query-for-model "database"
  [model search-ctx]
  (base-query-for-model model search-ctx))
(defmethod search-query-for-model "dashboard"
  [model search-ctx]
  (-> (base-query-for-model model search-ctx)
      (sql.helpers/left-join [:dashboard_bookmark :bookmark]
                             [:and
                              [:= :bookmark.dashboard_id :dashboard.id]
                              [:= :bookmark.user_id api/*current-user-id*]])
      (add-collection-join-and-where-clauses :dashboard.collection_id search-ctx)
      (with-last-editing-info model)))
(defmethod search-query-for-model "metric"
  [model search-ctx]
  (-> (base-query-for-model model search-ctx)
      (sql.helpers/left-join [:metabase_table :table] [:= :metric.table_id :table.id])
      (with-last-editing-info model)))
(defn- add-model-index-permissions-clause
  [query current-user-perms]
  (let [has-perm-clause (fn [path] [:in path current-user-perms])]
    (if (contains? current-user-perms "/")
      query
      ;; Select indexed rows if user has /db/:id/ OR (/db/:id/native/ AND /db/:id/schema/) - aka full access to the database
      ;; in at least one group. (Access to only a subset of tables isn't enough, since models can be based on native
      ;; queries.)
      ;; AND
      ;; User has /collection/:id/ or /collection/:id/read/ for the collection the model is in.
      (let [data-perm-clause
            [:or
             (has-perm-clause (h2x/concat (h2x/literal "/db/") :model.database_id (h2x/literal "/")))
             [:and
              (has-perm-clause (h2x/concat (h2x/literal "/db/") :model.database_id (h2x/literal "/native/")))
              (has-perm-clause (h2x/concat (h2x/literal "/db/") :model.database_id (h2x/literal "/schema/")))]]
            has-root-access?
            (or (contains? current-user-perms "/collection/root/")
                (contains? current-user-perms "/collection/root/read/"))
            collection-perm-clause
            [:or
             (when has-root-access? [:= :model.collection_id nil])
             [:and
              [:not= :model.collection_id nil]
              [:or
               (has-perm-clause (h2x/concat (h2x/literal "/collection/") :model.collection_id (h2x/literal "/")))
               (has-perm-clause (h2x/concat (h2x/literal "/collection/") :model.collection_id (h2x/literal "/read/")))]]]]
        (sql.helpers/where
         query
         [:and data-perm-clause collection-perm-clause])))))
(defmethod search-query-for-model "indexed-entity"
  [model {:keys [current-user-perms] :as search-ctx}]
  (-> (base-query-for-model model search-ctx)
      (sql.helpers/left-join [:model_index :model-index]
                             [:= :model-index.id :model-index-value.model_index_id])
      (sql.helpers/left-join [:report_card :model] [:= :model-index.model_id :model.id])
      (sql.helpers/left-join [:collection :collection] [:= :model.collection_id :collection.id])
      (add-model-index-permissions-clause current-user-perms)))
(defmethod search-query-for-model "segment"
  [model search-ctx]
  (-> (base-query-for-model model search-ctx)
      (sql.helpers/left-join [:metabase_table :table] [:= :segment.table_id :table.id])))
(defmethod search-query-for-model "table"
  [model {:keys [current-user-perms table-db-id], :as search-ctx}]
  (when (seq current-user-perms)
    (let [base-query (base-query-for-model model search-ctx)]
      (add-table-db-id-clause
       (if (contains? current-user-perms "/")
         base-query
         (let [data-perms (filter #(re-find #"^/db/*" %) current-user-perms)]
           {:select (:select base-query)
            :from   [[(merge
                       base-query
                       {:select [:id :schema :db_id :name :description :display_name :created_at :updated_at :initial_sync_status
                                 [(h2x/concat (h2x/literal "/db/")
                                              :db_id
                                              (h2x/literal "/schema/")
                                              [:case
                                               [:not= :schema nil] :schema
                                               :else               (h2x/literal "")]
                                              (h2x/literal "/table/") :id
                                              (h2x/literal "/read/"))
                                  :path]]})
                      :table]]
            :where  (if (seq data-perms)
                      (into [:or] (for [path data-perms]
                                    [:like :path (str path "%")]))
                      [:inline [:= 0 1]])}))
       table-db-id))))

CASE expression that lets the results be ordered by whether they're an exact (non-fuzzy) match or not

(defn order-clause
  [query]
  (let [match             (search.util/wildcard-match (search.util/normalize query))
        columns-to-search (->> search.config/all-search-columns
                               (filter (fn [[_k v]] (= v :text)))
                               (map first)
                               (remove #{:collection_authority_level :moderated_status
                                         :initial_sync_status :pk_ref}))
        case-clauses      (as-> columns-to-search <>
                            (map (fn [col] [:like [:lower col] match]) <>)
                            (interleave <> (repeat [:inline 0]))
                            (concat <> [:else [:inline 1]]))]
    [(into [:case] case-clauses)]))
(defmulti ^:private check-permissions-for-model
  {:arglists '([archived? search-result])}
  (fn [_ search-result] ((comp keyword :model) search-result)))
(defmethod check-permissions-for-model :default
  [archived? instance]
  (if archived?
    (mi/can-write? instance)
    ;; We filter what we can (ie. everything that is in a collection) out already when querying
    true))
(defmethod check-permissions-for-model :metric
  [archived? instance]
  (if archived?
    (mi/can-write? instance)
    (mi/can-read? instance)))
(defmethod check-permissions-for-model :segment
  [archived? instance]
  (if archived?
    (mi/can-write? instance)
    (mi/can-read? instance)))
(defmethod check-permissions-for-model :database
  [archived? instance]
  (if archived?
    (mi/can-write? instance)
    (mi/can-read? instance)))
(mu/defn query-model-set :- [:set SearchableModel]
  "Queries all models with respect to query for one result to see if we get a result or not"
  [search-ctx :- SearchContext]
  (let [model-queries (for [model (search.filter/search-context->applicable-models
                                   (assoc search-ctx :models search.config/all-models))]
                        {:nest (sql.helpers/limit (search-query-for-model model search-ctx) 1)})
        query         (when (pos-int? (count model-queries))
                        {:select [:*]
                         :from   [[{:union-all model-queries} :dummy_alias]]})]
    (set (some->> query
                  mdb.query/query
                  (map :model)
                  set))))

Postgres 9 is not happy with the type munging it needs to do to make the union-all degenerate down to trivial case of one model without errors. Therefore we degenerate it down for it

(mu/defn ^:private full-search-query
  [search-ctx :- SearchContext]
  (let [models       (:models search-ctx)
        order-clause [((fnil order-clause "") (:search-string search-ctx))]]
    (cond
      (= (count models) 0)
      {:select [nil]}
      (= (count models) 1)
      (search-query-for-model (first models) search-ctx)
      :else
      {:select   [:*]
       :from     [[{:union-all (vec (for [model models
                                          :let  [query (search-query-for-model model search-ctx)]
                                          :when (seq query)]
                                      query))} :alias_is_required_by_sql_but_not_needed_here]]
       :order-by order-clause})))

Hydrate common-name for lasteditedby and created_by from result.

(defn- hydrate-user-metadata
  [results]
  (let [user-ids             (set (flatten (for [result results]
                                             (remove nil? ((juxt :last_editor_id :creator_id) result)))))
        user-id->common-name (if (pos? (count user-ids))
                               (t2/select-pk->fn :common_name [:model/User :id :first_name :last_name :email] :id [:in user-ids])
                               {})]
    (mapv (fn [{:keys [creator_id last_editor_id] :as result}]
            (assoc result
                   :creator_common_name (get user-id->common-name creator_id)
                   :last_editor_common_name (get user-id->common-name last_editor_id)))
          results)))

Builds a search query that includes all the searchable entities and runs it

(mu/defn ^:private search
  [search-ctx :- SearchContext]
  (let [search-query       (full-search-query search-ctx)
        _                  (log/tracef "Searching with query:\n%s\n%s"
                                       (u/pprint-to-str search-query)
                                       (mdb.query/format-sql (first (mdb.query/compile search-query))))
        to-toucan-instance (fn [row]
                             (let [model (-> row :model search.config/model-to-db-model :db-model)]
                               (t2.instance/instance model row)))
        reducible-results  (mdb.query/reducible-query search-query :max-rows search.config/*db-max-results*)
        xf                 (comp
                            (map t2.realize/realize)
                            (map to-toucan-instance)
                            (filter (partial check-permissions-for-model (:archived? search-ctx)))
                            ;; MySQL returns `:bookmark` and `:archived` as `1` or `0` so convert those to boolean as
                            ;; needed
                            (map #(update % :bookmark api/bit->boolean))
                            (map #(update % :archived api/bit->boolean))
                            (map #(update % :pk_ref json/parse-string))
                            (map (partial scoring/score-and-result (:search-string search-ctx)))
                            (filter #(pos? (:score %))))
        total-results      (hydrate-user-metadata (scoring/top-results reducible-results search.config/max-filtered-results xf))]
    ;; We get to do this slicing and dicing with the result data because
    ;; the pagination of search is for UI improvement, not for performance.
    ;; We intend for the cardinality of the search results to be below the default max before this slicing occurs
    {:total            (count total-results)
     :data             (cond->> total-results
                         (some? (:offset-int search-ctx)) (drop (:offset-int search-ctx))
                         (some? (:limit-int search-ctx)) (take (:limit-int search-ctx)))
     :available_models (query-model-set search-ctx)
     :limit            (:limit-int search-ctx)
     :offset           (:offset-int search-ctx)
     :table_db_id      (:table-db-id search-ctx)
     :models           (:models search-ctx)}))

+----------------------------------------------------------------------------------------------------------------+ | Endpoint | +----------------------------------------------------------------------------------------------------------------+

(mu/defn ^:private search-context
  [{:keys [archived
           created-at
           created-by
           last-edited-at
           last-edited-by
           limit
           models
           filter-items-in-personal-collection
           offset
           search-string
           table-db-id
           search-native-query
           verified]}      :- [:map {:closed true}
                               [:search-string                                        [:maybe ms/NonBlankString]]
                               [:models                                               [:maybe [:set SearchableModel]]]
                               [:archived                            {:optional true} [:maybe :boolean]]
                               [:created-at                          {:optional true} [:maybe ms/NonBlankString]]
                               [:created-by                          {:optional true} [:maybe [:set ms/PositiveInt]]]
                               [:filter-items-in-personal-collection {:optional true} [:maybe [:enum "only" "exclude"]]]
                               [:last-edited-at                      {:optional true} [:maybe ms/NonBlankString]]
                               [:last-edited-by                      {:optional true} [:maybe [:set ms/PositiveInt]]]
                               [:limit                               {:optional true} [:maybe ms/Int]]
                               [:offset                              {:optional true} [:maybe ms/Int]]
                               [:table-db-id                         {:optional true} [:maybe ms/PositiveInt]]
                               [:search-native-query                 {:optional true} [:maybe boolean?]]
                               [:verified                            {:optional true} [:maybe true?]]]] :- SearchContext
  (when (some? verified)
    (premium-features/assert-has-any-features
     [:content-verification :official-collections]
     (deferred-tru "Content Management or Official Collections")))
  (let [models (if (string? models) [models] models)
        ctx    (cond-> {:search-string      search-string
                        :current-user-perms @api/*current-user-permissions-set*
                        :archived?          (boolean archived)
                        :models             models}
                 (some? created-at)                          (assoc :created-at created-at)
                 (seq created-by)                            (assoc :created-by created-by)
                 (some? filter-items-in-personal-collection) (assoc :filter-items-in-personal-collection filter-items-in-personal-collection)
                 (some? last-edited-at)                     (assoc :last-edited-at last-edited-at)
                 (seq last-edited-by)                       (assoc :last-edited-by last-edited-by)
                 (some? table-db-id)                        (assoc :table-db-id table-db-id)
                 (some? limit)                              (assoc :limit-int limit)
                 (some? offset)                             (assoc :offset-int offset)
                 (some? search-native-query)                (assoc :search-native-query search-native-query)
                 (some? verified)                           (assoc :verified verified))]
    (assoc ctx :models (search.filter/search-context->applicable-models ctx))))

/models

TODO maybe deprecate this and make it as a parameter in GET /api/search/models so we don't have to keep the arguments between 2 API in sync

(api/defendpoint GET 
  "Get the set of models that a search query will return"
  [q archived table-db-id created_at created_by last_edited_at last_edited_by
   filter_items_in_personal_collection search_native_query verified]
  {archived            [:maybe ms/BooleanValue]
   table-db-id         [:maybe ms/PositiveInt]
   created_at          [:maybe ms/NonBlankString]
   created_by          [:maybe [:or ms/PositiveInt [:sequential ms/PositiveInt]]]
   last_edited_at      [:maybe ms/PositiveInt]
   last_edited_by      [:maybe [:or ms/PositiveInt [:sequential ms/PositiveInt]]]
   search_native_query [:maybe true?]
   verified            [:maybe true?]}
  (query-model-set (search-context {:search-string       q
                                    :archived            archived
                                    :table-db-id         table-db-id
                                    :created-at          created_at
                                    :created-by          (set (u/one-or-many created_by))
                                    :filter-items-in-personal-collection filter_items_in_personal_collection
                                    :last-edited-at      last_edited_at
                                    :last-edited-by      (set (u/one-or-many last_edited_by))
                                    :search-native-query search_native_query
                                    :verified            verified
                                    :models              search.config/all-models})))

/

(api/defendpoint GET 
  "Search for items in Metabase.
  For the list of supported models, check [[metabase.search.config/all-models]].
  Filters:
  - `archived`: set to true to search archived items only, default is false
  - `table_db_id`: search for tables, cards, and models of a certain DB
  - `models`: only search for items of specific models. If not provided, search for all models
  - `filters_items_in_personal_collection`: only search for items in personal collections
  - `created_at`: search for items created at a specific timestamp
  - `created_by`: search for items created by a specific user
  - `last_edited_at`: search for items last edited at a specific timestamp
  - `last_edited_by`: search for items last edited by a specific user
  - `search_native_query`: set to true to search the content of native queries
  - `verified`: set to true to search for verified items only (requires Content Management or Official Collections premium feature)
  Note that not all item types support all filters, and the results will include only models that support the provided filters. For example:
  - The `created-by` filter supports dashboards, models, actions, and cards.
  - The `verified` filter supports models and cards.
  A search query that has both filters applied will only return models and cards."
  [q archived context created_at created_by table_db_id models last_edited_at last_edited_by
   filter_items_in_personal_collection search_native_query verified]
  {q                                   [:maybe ms/NonBlankString]
   archived                            [:maybe :boolean]
   table_db_id                         [:maybe ms/PositiveInt]
   models                              [:maybe [:or SearchableModel [:sequential SearchableModel]]]
   filter_items_in_personal_collection [:maybe [:enum "only" "exclude"]]
   context                             [:maybe [:enum "search-bar" "search-app"]]
   created_at                          [:maybe ms/NonBlankString]
   created_by                          [:maybe [:or ms/PositiveInt [:sequential ms/PositiveInt]]]
   last_edited_at                      [:maybe ms/NonBlankString]
   last_edited_by                      [:maybe [:or ms/PositiveInt [:sequential ms/PositiveInt]]]
   search_native_query                 [:maybe true?]
   verified                            [:maybe true?]}
  (api/check-valid-page-params mw.offset-paging/*limit* mw.offset-paging/*offset*)
  (let [start-time (System/currentTimeMillis)
        models-set (cond
                     (nil? models)    search.config/all-models
                     (string? models) #{models}
                     :else            (set models))
        results    (search (search-context
                            {:search-string       q
                             :archived            archived
                             :created-at          created_at
                             :created-by          (set (u/one-or-many created_by))
                             :filter-items-in-personal-collection filter_items_in_personal_collection
                             :last-edited-at      last_edited_at
                             :last-edited-by      (set (u/one-or-many last_edited_by))
                             :table-db-id         table_db_id
                             :models              models-set
                             :limit               mw.offset-paging/*limit*
                             :offset              mw.offset-paging/*offset*
                             :search-native-query search_native_query
                             :verified            verified}))
        duration   (- (System/currentTimeMillis) start-time)
        has-advanced-filters (some some?
                                   [models created_by created_at last_edited_by
                                    last_edited_at search_native_query verified])]
    (when (contains? #{"search-app" "search-bar"} context)
      (snowplow/track-event! ::snowplow/new-search-query api/*current-user-id*
                             {:runtime-milliseconds duration
                              :context              context})
      (when has-advanced-filters
        (snowplow/track-event! ::snowplow/search-results-filtered api/*current-user-id*
                               {:runtime-milliseconds  duration
                                :content-type          (u/one-or-many models)
                                :creator               (some? created_by)
                                :creation-date         (some? created_at)
                                :last-editor           (some? last_edited_by)
                                :last-edit-date        (some? last_edited_at)
                                :verified-items        (some? verified)
                                :search-native-queries (some? search_native_query)})))
    results))
(api/define-routes)
 

/api/segment endpoints.

(ns metabase.api.segment
  (:require
   [compojure.core :refer [DELETE GET POST PUT]]
   [metabase.api.common :as api]
   [metabase.events :as events]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.models.interface :as mi]
   [metabase.models.revision :as revision]
   [metabase.models.segment :as segment :refer [Segment]]
   [metabase.related :as related]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

/

(api/defendpoint POST 
  "Create a new `Segment`."
  [:as {{:keys [name description table_id definition], :as body} :body}]
  {name        ms/NonBlankString
   table_id    ms/PositiveInt
   definition  ms/Map
   description [:maybe :string]}
  ;; TODO - why can't we set other properties like `show_in_getting_started` when we create the Segment?
  (api/create-check Segment body)
  (let [segment (api/check-500
                 (first (t2/insert-returning-instances! Segment
                                                        :table_id    table_id
                                                        :creator_id  api/*current-user-id*
                                                        :name        name
                                                        :description description
                                                        :definition  definition)))]
    (events/publish-event! :event/segment-create {:object segment :user-id api/*current-user-id*})
    (t2/hydrate segment :creator)))
(mu/defn ^:private hydrated-segment [id :- ms/PositiveInt]
  (-> (api/read-check (t2/select-one Segment :id id))
      (t2/hydrate :creator)))

/:id

(api/defendpoint GET 
  "Fetch `Segment` with ID."
  [id]
  {id ms/PositiveInt}
  (hydrated-segment id))

/

(api/defendpoint GET 
  "Fetch *all* `Segments`."
  []
  (as-> (t2/select Segment, :archived false, {:order-by [[:%lower.name :asc]]}) segments
    (filter mi/can-read? segments)
    (t2/hydrate segments :creator :definition_description)))

Check whether current user has write permissions, then update Segment with values in body. Publishes appropriate event and returns updated/hydrated Segment.

(defn- write-check-and-update-segment!
  [id {:keys [revision_message], :as body}]
  (let [existing   (api/write-check Segment id)
        clean-body (u/select-keys-when body
                     :present #{:description :caveats :points_of_interest}
                     :non-nil #{:archived :definition :name :show_in_getting_started})
        new-def    (->> clean-body :definition (mbql.normalize/normalize-fragment []))
        new-body   (merge
                     (dissoc clean-body :revision_message)
                     (when new-def {:definition new-def}))
        changes    (when-not (= new-body existing)
                     new-body)
        archive?   (:archived changes)]
    (when changes
      (t2/update! Segment id changes))
    (u/prog1 (hydrated-segment id)
      (events/publish-event! (if archive? :event/segment-delete :event/segment-update)
                             {:object <> :user-id api/*current-user-id* :revision-message revision_message}))))

/:id

(api/defendpoint PUT 
  "Update a `Segment` with ID."
  [id :as {{:keys [name definition revision_message archived caveats description points_of_interest
                   show_in_getting_started]
            :as   body} :body}]
  {id                      ms/PositiveInt
   name                    [:maybe ms/NonBlankString]
   definition              [:maybe :map]
   revision_message        ms/NonBlankString
   archived                [:maybe :boolean]
   caveats                 [:maybe :string]
   description             [:maybe :string]
   points_of_interest      [:maybe :string]
   show_in_getting_started [:maybe :boolean]}
  (write-check-and-update-segment! id body))

/:id

(api/defendpoint DELETE 
  "Archive a Segment. (DEPRECATED -- Just pass updated value of `:archived` to the `PUT` endpoint instead.)"
  [id revision_message]
  {id               ms/PositiveInt
   revision_message ms/NonBlankString}
  (log/warn
   (trs "DELETE /api/segment/:id is deprecated. Instead, change its `archived` value via PUT /api/segment/:id."))
  (write-check-and-update-segment! id {:archived true, :revision_message revision_message})
  api/generic-204-no-content)

/:id/revisions

(api/defendpoint GET 
  "Fetch `Revisions` for `Segment` with ID."
  [id]
  {id ms/PositiveInt}
  (api/read-check Segment id)
  (revision/revisions+details Segment id))

/:id/revert

(api/defendpoint POST 
  "Revert a `Segement` to a prior `Revision`."
  [id :as {{:keys [revision_id]} :body}]
  {id          ms/PositiveInt
   revision_id ms/PositiveInt}
  (api/write-check Segment id)
  (revision/revert!
   {:entity      Segment
    :id          id
    :user-id     api/*current-user-id*
    :revision-id revision_id}))

/:id/related

(api/defendpoint GET 
  "Return related entities."
  [id]
  {id ms/PositiveInt}
  (-> (t2/select-one Segment :id id) api/read-check related/related))
(api/define-routes)
 

/api/session endpoints

(ns metabase.api.session
  (:require
   [compojure.core :refer [DELETE GET POST]]
   [java-time.api :as t]
   [metabase.analytics.snowplow :as snowplow]
   [metabase.api.common :as api]
   [metabase.api.ldap :as api.ldap]
   [metabase.config :as config]
   [metabase.email.messages :as messages]
   [metabase.events :as events]
   [metabase.integrations.google :as google]
   [metabase.integrations.ldap :as ldap]
   [metabase.models :refer [PulseChannel]]
   [metabase.models.login-history :refer [LoginHistory]]
   [metabase.models.pulse :as pulse]
   [metabase.models.session :refer [Session]]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.models.user :as user :refer [User]]
   [metabase.public-settings :as public-settings]
   [metabase.server.middleware.session :as mw.session]
   [metabase.server.request.util :as request.u]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [metabase.util.password :as u.password]
   [throttle.core :as throttle]
   [toucan2.core :as t2])
  (:import
   (com.unboundid.util LDAPSDKException)
   (java.util UUID)))
(set! *warn-on-reflection* true)
(mu/defn ^:private record-login-history!
  [session-id  :- (ms/InstanceOfClass UUID)
   user-id     :- ms/PositiveInt
   device-info :- request.u/DeviceInfo]
  (t2/insert! LoginHistory (merge {:user_id    user-id
                                   :session_id (str session-id)}
                                  device-info)))

Generate a new Session for a User. session-type is the currently either :password (for email + password login) or :sso (for other login types). Returns the newly generated Session.

(defmulti create-session!
  {:arglists '(^java.util.UUID [session-type user device-info])}
  (fn [session-type & _]
    session-type))
(def ^:private CreateSessionUserInfo
  [:map
   [:id          ms/PositiveInt]
   [:last_login :any]])
(def ^:private SessionSchema
  [:and
   [:map-of :keyword :any]
   [:map
    [:id   (ms/InstanceOfClass UUID)]
    [:type [:enum :normal :full-app-embed]]]])
(mu/defmethod create-session! :sso :- SessionSchema
  [_ user :- CreateSessionUserInfo device-info :- request.u/DeviceInfo]
  (let [session-uuid (random-uuid)
        session      (first (t2/insert-returning-instances! Session
                                                            :id      (str session-uuid)
                                                            :user_id (u/the-id user)))]
    (assert (map? session))
    (let [event {:user-id (u/the-id user)}]
      (events/publish-event! :event/user-login event)
      (when (nil? (:last_login user))
        (events/publish-event! :event/user-joined event)))
    (record-login-history! session-uuid (u/the-id user) device-info)
    (when-not (:last_login user)
      (snowplow/track-event! ::snowplow/new-user-created (u/the-id user)))
    (assoc session :id session-uuid)))
(mu/defmethod create-session! :password :- SessionSchema
  [session-type
   user         :- CreateSessionUserInfo
   device-info  :- request.u/DeviceInfo]
  ;; this is actually the same as `create-session!` for `:sso` but we check whether password login is enabled.
  (when-not (public-settings/enable-password-login)
    (throw (ex-info (str (tru "Password login is disabled for this instance.")) {:status-code 400})))
  ((get-method create-session! :sso) session-type user device-info))

API Endpoints

(def ^:private login-throttlers
  {:username   (throttle/make-throttler :username)
   ;; IP Address doesn't have an actual UI field so just show error by username
   :ip-address (throttle/make-throttler :username, :attempts-threshold 50)})
(def ^:private password-fail-message (deferred-tru "Password did not match stored password."))
(def ^:private password-fail-snippet (deferred-tru "did not match stored password"))
(def ^:private disabled-account-message (deferred-tru "Your account is disabled. Please contact your administrator."))
(def ^:private disabled-account-snippet (deferred-tru "Your account is disabled."))

Fake salt & hash used to run bcrypt hash if user doesn't exist, to avoid timing attacks (Metaboat #134)

(def ^:private fake-salt "ee169694-5eb6-4010-a145-3557252d7807")
(def ^:private fake-hashed-password "$2a$10$owKjTym0ZGEEZOpxM0UyjekSvt66y1VvmOJddkAaMB37e0VAIVOX2")
(mu/defn ^:private ldap-login :- [:maybe [:map [:id (ms/InstanceOfClass UUID)]]]
  "If LDAP is enabled and a matching user exists return a new Session for them, or `nil` if they couldn't be
  authenticated."
  [username password device-info :- request.u/DeviceInfo]
  (when (api.ldap/ldap-enabled)
    (try
      (when-let [user-info (ldap/find-user username)]
        (when-not (ldap/verify-password user-info password)
          ;; Since LDAP knows about the user, fail here to prevent the local strategy to be tried with a possibly
          ;; outdated password
          (throw (ex-info (str password-fail-message)
                          {:status-code 401
                           :errors      {:password password-fail-snippet}})))
        ;; password is ok, return new session if user is not deactivated
        (let [user (ldap/fetch-or-create-user! user-info)]
          (if (:is_active user)
            (create-session! :sso user device-info)
            (throw (ex-info (str disabled-account-message)
                            {:status-code 401
                             :errors      {:_error disabled-account-snippet}})))))
      (catch LDAPSDKException e
        (log/error e (trs "Problem connecting to LDAP server, will fall back to local authentication"))))))
(mu/defn ^:private email-login :- [:maybe [:map [:id (ms/InstanceOfClass UUID)]]]
  "Find a matching `User` if one exists and return a new Session for them, or `nil` if they couldn't be authenticated."
  [username    :- ms/NonBlankString
   password    :- [:maybe ms/NonBlankString]
   device-info :- request.u/DeviceInfo]
  (if-let [user (t2/select-one [User :id :password_salt :password :last_login :is_active], :%lower.email (u/lower-case-en username))]
    (when (u.password/verify-password password (:password_salt user) (:password user))
      (if (:is_active user)
        (create-session! :password user device-info)
        (throw (ex-info (str disabled-account-message)
                        {:status-code 401
                         :errors      {:_error disabled-account-snippet}}))))
    (do
      ;; User doesn't exist; run bcrypt hash anyway to avoid leaking account existence in request timing
      (u.password/verify-password password fake-salt fake-hashed-password)
      nil)))
(def ^:private throttling-disabled? (config/config-bool :mb-disable-session-throttle))

Pass through to throttle/check but will not check if throttling-disabled? is true

(defn- throttle-check
  [throttler throttle-key]
  (when-not throttling-disabled?
    (throttle/check throttler throttle-key)))
(mu/defn ^:private login :- SessionSchema
  "Attempt to login with different avaialable methods with `username` and `password`, returning new Session ID or
  throwing an Exception if login could not be completed."
  [username    :- ms/NonBlankString
   password    :- ms/NonBlankString
   device-info :- request.u/DeviceInfo]
  ;; Primitive "strategy implementation", should be reworked for modular providers in #3210
  (or (ldap-login username password device-info)  ; First try LDAP if it's enabled
      (email-login username password device-info) ; Then try local authentication
      ;; If nothing succeeded complain about it
      ;; Don't leak whether the account doesn't exist or the password was incorrect
      (throw
       (ex-info (str password-fail-message)
                {:status-code 401
                 :errors      {:password password-fail-snippet}}))))
(defn- do-http-401-on-error [f]
  (try
    (f)
    (catch clojure.lang.ExceptionInfo e
      (throw (ex-info (ex-message e)
                      (assoc (ex-data e) :status-code 401))))))

Add {:status-code 401} to exception data thrown by body.

(defmacro http-401-on-error
  [& body]
  `(do-http-401-on-error (fn [] ~@body)))

/

(api/defendpoint POST 
  "Login."
  [:as {{:keys [username password]} :body, :as request}]
  {username ms/NonBlankString
   password ms/NonBlankString}
  (let [ip-address   (request.u/ip-address request)
        request-time (t/zoned-date-time (t/zone-id "GMT"))
        do-login     (fn []
                       (let [{session-uuid :id, :as session} (login username password (request.u/device-info request))
                             response                        {:id (str session-uuid)}]
                         (mw.session/set-session-cookies request response session request-time)))]
    (if throttling-disabled?
      (do-login)
      (http-401-on-error
       (throttle/with-throttling [(login-throttlers :ip-address) ip-address
                                  (login-throttlers :username)   username]
           (do-login))))))

/

(api/defendpoint DELETE 
  "Logout."
  [:as {:keys [metabase-session-id]}]
  (api/check-exists? Session metabase-session-id)
  (t2/delete! Session :id metabase-session-id)
  (mw.session/clear-session-cookie api/generic-204-no-content))

Reset tokens: We need some way to match a plaintext token with the a user since the token stored in the DB is hashed. So we'll make the plaintext token in the format USER-ID_RANDOM-UUID, e.g. "100_8a266560-e3a8-4dc1-9cd1-b4471dcd56d7", before hashing it. "Leaking" the ID this way is ok because the plaintext token is only sent in the password reset email to the user in question.

There's also no need to salt the token because it's already random <3

(def ^:private forgot-password-throttlers
  {:email      (throttle/make-throttler :email)
   :ip-address (throttle/make-throttler :email, :attempts-threshold 50)})
(defn- forgot-password-impl
  [email]
  (future
    (when-let [{user-id      :id
                sso-source   :sso_source
                is-active?   :is_active :as user}
               (t2/select-one [User :id :sso_source :is_active]
                              :%lower.email
                              (u/lower-case-en email))]
      (if (some? sso-source)
        ;; If user uses any SSO method to log in, no need to generate a reset token
        (messages/send-password-reset-email! email sso-source nil is-active?)
        (let [reset-token        (user/set-password-reset-token! user-id)
              password-reset-url (str (public-settings/site-url) "/auth/reset_password/" reset-token)]
          (log/info password-reset-url)
          (messages/send-password-reset-email! email nil password-reset-url is-active?)))
      (events/publish-event! :event/password-reset-initiated
                             {:object (assoc user :token (t2/select-one-fn :reset_token :model/User :id user-id))}))))

/forgot_password

(api/defendpoint POST 
  "Send a reset email when user has forgotten their password."
  [:as {{:keys [email]} :body, :as request}]
  {email ms/Email}
  ;; Don't leak whether the account doesn't exist, just pretend everything is ok
  (let [request-source (request.u/ip-address request)]
    (throttle-check (forgot-password-throttlers :ip-address) request-source))
  (throttle-check (forgot-password-throttlers :email) email)
  (forgot-password-impl email)
  api/generic-204-no-content)
(defsetting reset-token-ttl-hours
  (deferred-tru "Number of hours a password reset is considered valid.")
  :visibility :internal
  :type       :integer
  :default    48
  :audit      :getter)

number of milliseconds a password reset is considered valid.

(defn reset-token-ttl-ms
  []
  (* (reset-token-ttl-hours) 60 60 1000))

Check if a password reset token is valid. If so, return the User ID it corresponds to.

(defn- valid-reset-token->user
  [^String token]
  (when-let [[_ user-id] (re-matches #"(^\d+)_.+$" token)]
    (let [user-id (Integer/parseInt user-id)]
      (when-let [{:keys [reset_token reset_triggered], :as user} (t2/select-one [User :id :last_login :reset_triggered
                                                                                 :reset_token]
                                                                   :id user-id, :is_active true)]
        ;; Make sure the plaintext token matches up with the hashed one for this user
        (when (u/ignore-exceptions
                (u.password/bcrypt-verify token reset_token))
          ;; check that the reset was triggered within the last 48 HOURS, after that the token is considered expired
          (let [token-age (- (System/currentTimeMillis) reset_triggered)]
            (when (< token-age (reset-token-ttl-ms))
              user)))))))

/reset_password

(api/defendpoint POST 
  "Reset password with a reset token."
  [:as {{:keys [token password]} :body, :as request}]
  {token    ms/NonBlankString
   password ms/ValidPassword}
  (or (when-let [{user-id :id, :as user} (valid-reset-token->user token)]
        (let [reset-token (t2/select-one-fn :reset_token :model/User :id user-id)]
          (user/set-password! user-id password)
          ;; if this is the first time the user has logged in it means that they're just accepted their Metabase invite.
          ;; Otherwise, send audit log event that a user reset their password.
          (if (:last_login user)
            (events/publish-event! :event/password-reset-successful {:object (assoc user :token reset-token)})
            ;; Send all the active admins an email :D
            (messages/send-user-joined-admin-notification-email! (t2/select-one User :id user-id)))
          ;; after a successful password update go ahead and offer the client a new session that they can use
          (let [{session-uuid :id, :as session} (create-session! :password user (request.u/device-info request))
                response                        {:success    true
                                                 :session_id (str session-uuid)}]
            (mw.session/set-session-cookies request response session (t/zoned-date-time (t/zone-id "GMT"))))))
      (api/throw-invalid-param-exception :password (tru "Invalid reset token"))))

/passwordresettoken_valid

(api/defendpoint GET 
  "Check is a password reset token is valid and isn't expired."
  [token]
  {token ms/NonBlankString}
  {:valid (boolean (valid-reset-token->user token))})

/properties

(api/defendpoint GET 
  "Get all properties and their values. These are the specific `Settings` that are readable by the current user, or are
  public if no user is logged in."
  []
  (setting/user-readable-values-map (setting/current-user-readable-visibilities)))

/google_auth

(api/defendpoint POST 
  "Login with Google Auth."
  [:as {{:keys [token]} :body, :as request}]
  {token ms/NonBlankString}
  (when-not (google/google-auth-client-id)
    (throw (ex-info "Google Auth is disabled." {:status-code 400})))
  ;; Verify the token is valid with Google
  (if throttling-disabled?
    (google/do-google-auth request)
    (http-401-on-error
     (throttle/with-throttling [(login-throttlers :ip-address) (request.u/ip-address request)]
       (let [user (google/do-google-auth request)
             {session-uuid :id, :as session} (create-session! :sso user (request.u/device-info request))
             response {:id (str session-uuid)}
             user (t2/select-one [User :id :is_active], :email (:email user))]
         (if (and user (:is_active user))
           (mw.session/set-session-cookies request
                                           response
                                           session
                                           (t/zoned-date-time (t/zone-id "GMT")))
           (throw (ex-info (str disabled-account-message)
                           {:status-code 401
                            :errors      {:account disabled-account-snippet}}))))))))
(defn- +log-all-request-failures [handler]
  (fn [request respond raise]
    (try
      (handler request respond raise)
      (catch Throwable e
        (log/error e (trs "Authentication endpoint error"))
        (throw e)))))

----------------------------------------------------- Unsubscribe non-users from pulses -----------------------------------------------

(def ^:private unsubscribe-throttler (throttle/make-throttler :unsubscribe, :attempts-threshold 50))
(defn- check-hash [pulse-id email hash ip-address]
  (throttle-check unsubscribe-throttler ip-address)
  (when (not= hash (messages/generate-pulse-unsubscribe-hash pulse-id email))
    (throw (ex-info (tru "Invalid hash.")
                    {:type        type
                     :status-code 400}))))

/pulse/unsubscribe

(api/defendpoint POST 
  "Allow non-users to unsubscribe from pulses/subscriptions, with the hash given through email."
  [:as {{:keys [email hash pulse-id]} :body, :as request}]
  {pulse-id ms/PositiveInt
   email    :string
   hash     :string}
  (check-hash pulse-id email hash (request.u/ip-address request))
  (api/let-404 [pulse-channel (t2/select-one PulseChannel :pulse_id pulse-id :channel_type "email")]
    (let [emails (get-in pulse-channel [:details :emails])]
      (if (some #{email} emails)
        (t2/update! PulseChannel (:id pulse-channel) (assoc-in pulse-channel [:details :emails] (remove #{email} emails)))
        (throw (ex-info (tru "Email for pulse-id doesn't exist.")
                        {:type        type
                         :status-code 400}))))
    (events/publish-event! :event/subscription-unsubscribe {:object {:email email}})
    {:status :success :title (:name (pulse/retrieve-notification pulse-id :archived false))}))

/pulse/unsubscribe/undo

(api/defendpoint POST 
  "Allow non-users to undo an unsubscribe from pulses/subscriptions, with the hash given through email."
  [:as {{:keys [email hash pulse-id]} :body, :as request}]
  {pulse-id ms/PositiveInt
   email    :string
   hash     :string}
  (check-hash pulse-id email hash (request.u/ip-address request))
  (api/let-404 [pulse-channel (t2/select-one PulseChannel :pulse_id pulse-id :channel_type "email")]
    (let [emails       (get-in pulse-channel [:details :emails])
          given-email? #(= % email)]
      (if (some given-email? emails)
        (throw (ex-info (tru "Email for pulse-id already exists.")
                        {:type        type
                         :status-code 400}))
        (t2/update! PulseChannel (:id pulse-channel) (update-in pulse-channel [:details :emails] conj email))))
    (events/publish-event! :event/subscription-unsubscribe-undo {:object {:email email}})
    {:status :success :title (:name (pulse/retrieve-notification pulse-id :archived false))}))
(api/define-routes +log-all-request-failures)
 

/api/setting endpoints

(ns metabase.api.setting
  (:require
   [compojure.core :refer [GET PUT]]
   [metabase.api.common :as api]
   [metabase.api.common.validation :as validation]
   [metabase.models.setting :as setting]
   [metabase.util :as u]))
(defn- do-with-setting-access-control
  [thunk]
  (try
    (binding [setting/*enforce-setting-access-checks* true]
      (thunk))
    (catch clojure.lang.ExceptionInfo e
      ;; Throw a generic 403 for non-admins, so as to not reveal details about settings
      (api/check-superuser)
      (throw e))))

Executes the given body with setting access enforcement enabled, and adds some exception handling to make sure we return generic 403s to non-admins who try to read or write settings they don't have access to.

(defmacro ^:private with-setting-access-control
  [& body]
  `(do-with-setting-access-control (fn [] ~@body)))

/

TODO: deprecate /api/session/properties and have a single endpoint for listing settings

(api/defendpoint GET 
  "Get all `Settings` and their values. You must be a superuser or have `setting` permission to do this.
  For non-superusers, a list of visible settings and values can be retrieved using the /api/session/properties endpoint."
  []
  (validation/check-has-application-permission :setting)
  (setting/writable-settings))

Keyword that can be transformed from "a_b" -> :a-b

(def ^:private kebab-cased-keyword
  [:keyword {:decode/json #(keyword (u/->kebab-case-en %))}])

/

(api/defendpoint PUT 
  "Update multiple `Settings` values. If called by a non-superuser, only user-local settings can be updated."
  [:as {settings :body}]
  {settings [:map-of kebab-cased-keyword :any]}
  (with-setting-access-control
    (setting/set-many! settings))
  api/generic-204-no-content)

/:key

(api/defendpoint GET 
  "Fetch a single `Setting`."
  [key]
  {key kebab-cased-keyword}
  (with-setting-access-control
    (setting/user-facing-value key)))

/:key

(api/defendpoint PUT 
  "Create/update a `Setting`. If called by a non-admin, only user-local settings can be updated.
   This endpoint can also be used to delete Settings by passing `nil` for `:value`."
  [key :as {{:keys [value]} :body}]
  {key kebab-cased-keyword}
  (with-setting-access-control
    (setting/set! key value))
  api/generic-204-no-content)
(api/define-routes)
 
(ns metabase.api.setup
  (:require
   [compojure.core :refer [GET POST]]
   [java-time.api :as t]
   [metabase.analytics.snowplow :as snowplow]
   [metabase.api.common :as api]
   [metabase.api.common.validation :as validation]
   [metabase.api.database :as api.database]
   [metabase.config :as config]
   [metabase.db :as mdb]
   [metabase.driver :as driver]
   [metabase.email :as email]
   [metabase.events :as events]
   [metabase.integrations.slack :as slack]
   [metabase.models.card :refer [Card]]
   [metabase.models.collection :refer [Collection]]
   [metabase.models.dashboard :refer [Dashboard]]
   [metabase.models.database :refer [Database]]
   [metabase.models.permissions-group :as perms-group]
   [metabase.models.pulse :refer [Pulse]]
   [metabase.models.session :refer [Session]]
   [metabase.models.setting.cache :as setting.cache]
   [metabase.models.table :refer [Table]]
   [metabase.models.user :as user :refer [User]]
   [metabase.public-settings :as public-settings]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.server.middleware.session :as mw.session]
   [metabase.setup :as setup]
   [metabase.sync.schedules :as sync.schedules]
   [metabase.util :as u]
   [metabase.util.i18n :as i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

Schema for a string that matches the instance setup token.

(def ^:private ^:deprcated SetupToken
  (mu/with-api-error-message
   [:and
    ms/NonBlankString
    [:fn
     {:error/message "setup token"}
     (every-pred string? #'setup/token-match?)]]
   (i18n/deferred-tru "Token does not match the setup token.")))

We must not allow users to setup multiple super users after the first user is created. But tests still need to be able to. This var is redef'd to false by certain tests to allow that.

(def ^:dynamic ^:private *allow-api-setup-after-first-user-is-created*
  false)
(defn- setup-create-user! [{:keys [email first-name last-name password]}]
  (when (and (setup/has-user-setup)
             (not *allow-api-setup-after-first-user-is-created*))
    ;; many tests use /api/setup to setup multiple users, so *allow-api-setup-after-first-user-is-created* is
    ;; redefined by them
    (throw (ex-info
            (tru "The /api/setup route can only be used to create the first user, however a user currently exists.")
            {:status-code 403})))
  (let [session-id (str (random-uuid))
        new-user   (first (t2/insert-returning-instances! User
                                                          :email        email
                                                          :first_name   first-name
                                                          :last_name    last-name
                                                          :password     (str (random-uuid))
                                                          :is_superuser true))
        user-id    (u/the-id new-user)]
    ;; this results in a second db call, but it avoids redundant password code so figure it's worth it
    (user/set-password! user-id password)
    ;; then we create a session right away because we want our new user logged in to continue the setup process
    (let [session (first (t2/insert-returning-instances! Session
                                                         :id      session-id
                                                         :user_id user-id))]
      ;; return user ID, session ID, and the Session object itself
      {:session-id session-id, :user-id user-id, :session session})))
(defn- setup-maybe-create-and-invite-user! [{:keys [email] :as user}, invitor]
  (when email
    (if-not (email/email-configured?)
      (log/error (trs "Could not invite user because email is not configured."))
      (u/prog1 (user/create-and-invite-user! user invitor true)
        (user/set-permissions-groups! <> [(perms-group/all-users) (perms-group/admin)])
        (events/publish-event! :event/user-invited {:object (assoc <> :invite_method "email")})
        (snowplow/track-event! ::snowplow/invite-sent api/*current-user-id* {:invited-user-id (u/the-id <>)
                                                                             :source          "setup"})))))

Create a new Database. Returns newly created Database.

(defn- setup-create-database!
  [{:keys [name driver details schedules database creator-id]}]
  (when driver
    (when-not (some-> (u/ignore-exceptions (driver/the-driver driver)) driver/available?)
      (let [msg (tru "Cannot create Database: cannot find driver {0}." driver)]
        (throw (ex-info msg {:errors {:database {:engine msg}}, :status-code 400}))))
    (when-let [error (api.database/test-database-connection driver details)]
      (throw (ex-info (:message error (tru "Cannot connect to Database")) (assoc error :status-code 400))))
    (first (t2/insert-returning-instances! Database
                                           (merge
                                             {:name name, :engine driver, :details details, :creator_id creator-id}
                                             (u/select-non-nil-keys database #{:is_on_demand :is_full_sync :auto_run_queries})
                                             (when schedules
                                               (sync.schedules/schedule-map->cron-strings schedules)))))))
(defn- setup-set-settings! [_request {:keys [email site-name site-locale allow-tracking?]}]
  ;; set a couple preferences
  (public-settings/site-name! site-name)
  (public-settings/admin-email! email)
  (when site-locale
    (public-settings/site-locale! site-locale))
  ;; default to `true` if allow_tracking isn't specified. The setting will set itself correctly whether a boolean or
  ;; boolean string is specified
  (public-settings/anon-tracking-enabled! (or (nil? allow-tracking?)
                                              allow-tracking?)))

/

(api/defendpoint POST 
  "Special endpoint for creating the first user during setup. This endpoint both creates the user AND logs them in and
  returns a session ID. This endpoint can also be used to add a database, create and invite a second admin, and/or
  set specific settings from the setup flow."
  [:as {{:keys                                          [token]
         {:keys [name engine details
                 schedules auto_run_queries]
          :as   database}                               :database
         {:keys [first_name last_name email password]}  :user
         {invited_first_name :first_name,
          invited_last_name  :last_name,
          invited_email      :email}                    :invite
         {:keys [allow_tracking site_name site_locale]} :prefs} :body, :as request}]
  {token              SetupToken
   site_name          ms/NonBlankString
   site_locale        [:maybe ms/ValidLocale]
   first_name         [:maybe ms/NonBlankString]
   last_name          [:maybe ms/NonBlankString]
   email              ms/Email
   invited_first_name [:maybe ms/NonBlankString]
   invited_last_name  [:maybe ms/NonBlankString]
   invited_email      [:maybe ms/Email]
   password           ms/ValidPassword
   allow_tracking     [:maybe [:or :boolean ms/BooleanString]]
   schedules          [:maybe sync.schedules/ExpandedSchedulesMap]
   auto_run_queries   [:maybe :boolean]}
  (letfn [(create! []
            (try
              (t2/with-transaction [_conn]
                (let [user-info (setup-create-user!
                                 {:email email, :first-name first_name, :last-name last_name, :password password})
                      db        (setup-create-database! {:name name
                                                         :driver engine
                                                         :details details
                                                         :schedules schedules
                                                         :database database
                                                         :creator-id (:user-id user-info)})]
                  (setup-maybe-create-and-invite-user! {:email invited_email,
                                                        :first_name invited_first_name,
                                                        :last_name invited_last_name}
                                                       {:email email, :first_name first_name})
                  (setup-set-settings!
                   request
                   {:email email, :site-name site_name, :site-locale site_locale, :allow-tracking? allow_tracking})
                  (assoc user-info :database db)))
              (catch Throwable e
                ;; if the transaction fails, restore the Settings cache from the DB again so any changes made in this
                ;; endpoint (such as clearing the setup token) are reverted. We can't use `dosync` here to accomplish
                ;; this because there is `io!` in this block
                (setting.cache/restore-cache!)
                (snowplow/track-event! ::snowplow/database-connection-failed nil {:database engine, :source :setup})
                (throw e))))]
    (let [{:keys [user-id session-id database session]} (create!)
          superuser (t2/select-one :model/User :id user-id)]
      (when database
        (events/publish-event! :event/database-create {:object database :user-id user-id}))
      (events/publish-event! :event/user-login {:user-id user-id})
      (when-not (:last_login superuser)
        (events/publish-event! :event/user-joined {:user-id user-id}))
      (snowplow/track-event! ::snowplow/new-user-created user-id)
      (when database
        (snowplow/track-event! ::snowplow/database-connection-successful
                               user-id
                               {:database     engine
                                :database-id  (u/the-id database)
                                :source       :setup
                                :dbms_version (:version (driver/dbms-version (keyword engine) database))}))
      ;; return response with session ID and set the cookie as well
      (mw.session/set-session-cookies request {:id session-id} session (t/zoned-date-time (t/zone-id "GMT"))))))

/validate

(api/defendpoint POST 
  "Validate that we can connect to a database given a set of details."
  [:as {{{:keys [engine details]} :details, token :token} :body}]
  {token  SetupToken
   engine api.database/DBEngineString}
  (when (setup/has-user-setup)
    (throw (ex-info (tru "Instance already initialized")
                    {:status-code 400})))
  (let [engine       (keyword engine)
        error-or-nil (api.database/test-database-connection engine details)]
    (when error-or-nil
      (snowplow/track-event! ::snowplow/database-connection-failed
                             nil
                             {:database engine, :source :setup})
      {:status 400
       :body   error-or-nil})))

Admin Checklist

Malli schema for the state to annotate the checklist.

(def ^:private ChecklistState
  [:map {:closed true}
   [:db-type [:enum :h2 :mysql :postgres]]
   [:hosted? :boolean]
   [:configured [:map
                 [:email :boolean]
                 [:slack :boolean]]]
   [:counts [:map
             [:user :int]
             [:card :int]
             [:table :int]]]
   [:exists [:map
             [:model :boolean]
             [:non-sample-db :boolean]
             [:dashboard :boolean]
             [:pulse :boolean]
             [:hidden-table :boolean]
             [:collection :boolean]]]])
(mu/defn ^:private state-for-checklist :- ChecklistState
  []
  {:db-type    (mdb/db-type)
   :hosted?    (premium-features/is-hosted?)
   :configured {:email (email/email-configured?)
                :slack (slack/slack-configured?)}
   :counts     {:user  (t2/count User)
                :card  (t2/count Card)
                :table (t2/count Table)}
   :exists     {:non-sample-db (t2/exists? Database, :is_sample false)
                :dashboard     (t2/exists? Dashboard)
                :pulse         (t2/exists? Pulse)
                :hidden-table  (t2/exists? Table, :visibility_type [:not= nil])
                :collection    (t2/exists? Collection)
                :model         (t2/exists? Card :dataset true)}})
(defn- get-connected-tasks
  [{:keys [configured counts exists] :as _info}]
  [{:title       (tru "Add a database")
    :group       (tru "Get connected")
    :description (tru "Connect to your data so your whole team can start to explore.")
    :link        "/admin/databases/create"
    :completed   (exists :non-sample-db)
    :triggered   :always}
   {:title       (tru "Set up email")
    :group       (tru "Get connected")
    :description (tru "Add email credentials so you can more easily invite team members and get updates via Pulses.")
    :link        "/admin/settings/email"
    :completed   (configured :email)
    :triggered   :always}
   {:title       (tru "Set Slack credentials")
    :group       (tru "Get connected")
    :description (tru "Does your team use Slack? If so, you can send automated updates via dashboard subscriptions.")
    :link        "/admin/settings/slack"
    :completed   (configured :slack)
    :triggered   :always}
   {:title       (tru "Invite team members")
    :group       (tru "Get connected")
    :description (tru "Share answers and data with the rest of your team.")
    :link        "/admin/people/"
    :completed   (> (counts :user) 1)
    :triggered   (or (exists :dashboard)
                     (exists :pulse)
                     (>= (counts :card) 5))}])
(defn- productionize-tasks
  [info]
  [{:title       (tru "Switch to a production-ready app database")
    :group       (tru "Productionize")
    :description (tru "Migrate off of the default H2 application database to PostgreSQL or MySQL")
    :link        "https://www.metabase.com/docs/latest/installation-and-operation/migrating-from-h2"
    :completed   (not= (:db-type info) :h2)
    :triggered   (and (= (:db-type info) :h2) (not (:hosted? info)))}])
(defn- curate-tasks
  [{:keys [counts exists] :as _info}]
  [{:title       (tru "Hide irrelevant tables")
    :group       (tru "Curate your data")
    :description (tru "If your data contains technical or irrelevant info you can hide it.")
    :link        "/admin/datamodel/database"
    :completed   (exists :hidden-table)
    :triggered   (>= (counts :table) 20)}
   {:title       (tru "Organize questions")
    :group       (tru "Curate your data")
    :description (tru "Have a lot of saved questions in {0}? Create collections to help manage them and add context." (tru "Metabase"))
    :link        "/collection/root"
    :completed   (exists :collection)
    :triggered   (>= (counts :card) 30)}
   {:title       (tru "Create a model")
    :group       (tru "Curate your data")
    :description (tru "Set up friendly starting points for your team to explore data")
    :link        "/model/new"
    :completed   (exists :model)
    :triggered   (not (exists :model))}])
(mu/defn ^:private checklist-items
  [info :- ChecklistState]
  (remove nil?
          [{:name  (tru "Get connected")
            :tasks (get-connected-tasks info)}
           (when-not (:hosted? info)
             {:name  (tru "Productionize")
              :tasks (productionize-tasks info)})
           {:name  (tru "Curate your data")
            :tasks (curate-tasks info)}]))

Add is_next_step key to all the steps from admin-checklist, and ensure triggered is a boolean. The next step is the first step where :triggered is true and :completed is false.

(defn- annotate
  [checklist]
  (let [next-step        (->> checklist
                              (mapcat :tasks)
                              (filter (every-pred :triggered (complement :completed)))
                              first
                              :title)
        mark-next-step   (fn identity-task-by-name [task]
                           (assoc task :is_next_step (= (:title task) next-step)))
        update-triggered (fn [task]
                           (update task :triggered boolean))]
    (for [group checklist]
      (update group :tasks
              (partial map (comp update-triggered mark-next-step))))))
(defn- admin-checklist
  ([] (admin-checklist (state-for-checklist)))
  ([checklist-info]
   (annotate (checklist-items checklist-info))))

/admin_checklist

(api/defendpoint GET 
  "Return various \"admin checklist\" steps and whether they've been completed. You must be a superuser to see this!"
  []
  (validation/check-has-application-permission :setting)
  (admin-checklist))

User defaults endpoint

/user_defaults

(api/defendpoint GET 
  "Returns object containing default user details for initial setup, if configured,
   and if the provided token value matches the token in the configuration value."
  [token]
  (let [{config-token :token :as defaults} (config/mb-user-defaults)]
    (api/check-404 config-token)
    (api/check-403 (= token config-token))
    (dissoc defaults :token)))
(api/define-routes)
 

/api/slack endpoints

(ns metabase.api.slack
  (:require
   [clojure.java.io :as io]
   [compojure.core :refer [PUT]]
   [metabase.api.common :as api]
   [metabase.api.common.validation :as validation]
   [metabase.config :as config]
   [metabase.integrations.slack :as slack]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli.schema :as ms]))

/settings

(api/defendpoint PUT 
  "Update Slack related settings. You must be a superuser to do this. Also updates the slack-cache.
  There are 3 cases where we alter the slack channel/user cache:
  1. falsy token           -> clear
  2. invalid token         -> clear
  3. truthy, valid token   -> refresh "
  [:as {{slack-app-token :slack-app-token, slack-files-channel :slack-files-channel} :body}]
  {slack-app-token     [:maybe ms/NonBlankString]
   slack-files-channel [:maybe ms/NonBlankString]}
  (validation/check-has-application-permission :setting)
  (try
    (when (and slack-app-token
               (not config/is-test?)
               (not (slack/valid-token? slack-app-token)))
      (slack/clear-channel-cache!)
      (throw (ex-info (tru "Invalid Slack token.")
                      {:errors {:slack-app-token (tru "invalid token")}})))
    (slack/slack-app-token! slack-app-token)
    (if slack-app-token
      (do (slack/slack-token-valid?! true)
          ;; Clear the deprecated `slack-token` when setting a new `slack-app-token`
          (slack/slack-token! nil)
          ;; refresh user/conversation cache when token is newly valid
          (slack/refresh-channels-and-usernames-when-needed!))
      ;; clear user/conversation cache when token is newly empty
      (slack/clear-channel-cache!))
    (let [processed-files-channel (slack/process-files-channel-name slack-files-channel)]
      (when (and processed-files-channel (not (slack/channel-exists? processed-files-channel)))
        ;; Files channel could not be found; clear the token we had previously set since the integration should not be
        ;; enabled.
        (slack/slack-token-valid?! false)
        (slack/slack-app-token! nil)
        (throw (ex-info (tru "Slack channel not found.")
                        {:errors {:slack-files-channel (tru "channel not found")}})))
      (slack/slack-files-channel! processed-files-channel))
    {:ok true}
    (catch clojure.lang.ExceptionInfo info
      {:status 400, :body (ex-data info)})))
(def ^:private slack-manifest
  (delay (slurp (io/resource "slack-manifest.yaml"))))

/manifest

(api/defendpoint GET 
  "Returns the YAML manifest file that should be used to bootstrap new Slack apps"
  []
  (validation/check-has-application-permission :setting)
  @slack-manifest)
(api/define-routes)
 

/api/table endpoints.

(ns metabase.api.table
  (:require
   [clojure.java.io :as io]
   [compojure.core :refer [GET POST PUT]]
   [medley.core :as m]
   [metabase.api.common :as api]
   [metabase.db.query :as mdb.query]
   [metabase.driver :as driver]
   [metabase.driver.h2 :as h2]
   [metabase.driver.util :as driver.u]
   [metabase.events :as events]
   [metabase.models.card :refer [Card]]
   [metabase.models.database :refer [Database]]
   [metabase.models.field :refer [Field]]
   [metabase.models.field-values :as field-values :refer [FieldValues]]
   [metabase.models.interface :as mi]
   [metabase.models.table :as table :refer [Table]]
   [metabase.related :as related]
   [metabase.sync :as sync]
   [metabase.sync.concurrent :as sync.concurrent]
   #_{:clj-kondo/ignore [:consistent-alias]}
   [metabase.sync.field-values :as sync.field-values]
   [metabase.types :as types]
   [metabase.upload :as upload]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

Schema for a valid table visibility type.

(def ^:private TableVisibilityType
  (into [:enum] (map name table/visibility-types)))

Schema for a valid table field ordering.

(def ^:private FieldOrder
  (into [:enum] (map name table/field-orderings)))

/

(api/defendpoint GET 
  "Get all `Tables`."
  []
  (as-> (t2/select Table, :active true, {:order-by [[:name :asc]]}) tables
    (t2/hydrate tables :db)
    (filterv mi/can-read? tables)))

/:id

(api/defendpoint GET 
  "Get `Table` with ID."
  [id include_editable_data_model]
  {id ms/PositiveInt
   include_editable_data_model [:maybe :boolean]}
  (let [api-perm-check-fn (if include_editable_data_model
                            api/write-check
                            api/read-check)]
    (-> (api-perm-check-fn Table id)
        (t2/hydrate :db :pk_field))))

Takes an existing table and the changes, updates in the database and optionally calls table/update-field-positions! if field positions have changed.

(defn- update-table!*
  [{:keys [id] :as existing-table} body]
  {id ms/PositiveInt}
  (when-let [changes (not-empty (u/select-keys-when body
                                  :non-nil [:display_name :show_in_getting_started :entity_type :field_order]
                                  :present [:description :caveats :points_of_interest :visibility_type]))]
    (api/check-500 (pos? (t2/update! Table id changes))))
  (let [updated-table        (t2/select-one Table :id id)
        changed-field-order? (not= (:field_order updated-table) (:field_order existing-table))]
    (if changed-field-order?
      (do
        (table/update-field-positions! updated-table)
        (t2/hydrate updated-table [:fields [:target :has_field_values] :dimensions :has_field_values]))
      updated-table)))

Function to call on newly unhidden tables. Starts a thread to sync all tables.

(defn- sync-unhidden-tables
  [newly-unhidden]
  (when (seq newly-unhidden)
    (sync.concurrent/submit-task
     (fn []
       (let [database (table/database (first newly-unhidden))]
         ;; it's okay to allow testing H2 connections during sync. We only want to disallow you from testing them for the
         ;; purposes of creating a new H2 database.
         (if (binding [h2/*allow-testing-h2-connections* true]
               (driver.u/can-connect-with-details? (:engine database) (:details database)))
           (doseq [table newly-unhidden]
             (log/info (u/format-color 'green (trs "Table ''{0}'' is now visible. Resyncing." (:name table))))
             (sync/sync-table! table))
           (log/warn (u/format-color 'red (trs "Cannot connect to database ''{0}'' in order to sync unhidden tables"
                                               (:name database))))))))))
(defn- update-tables!
  [ids {:keys [visibility_type] :as body}]
  (let [existing-tables (t2/select Table :id [:in ids])]
    (api/check-404 (= (count existing-tables) (count ids)))
    (run! api/write-check existing-tables)
    (let [updated-tables (t2/with-transaction [_conn] (mapv #(update-table!* % body) existing-tables))
          newly-unhidden (when (and (contains? body :visibility_type) (nil? visibility_type))
                           (into [] (filter (comp some? :visibility_type)) existing-tables))]
      (sync-unhidden-tables newly-unhidden)
      updated-tables)))

/:id

(api/defendpoint PUT 
  "Update `Table` with ID."
  [id :as {{:keys [display_name entity_type visibility_type description caveats points_of_interest
                   show_in_getting_started field_order], :as body} :body}]
  {id                      ms/PositiveInt
   display_name            [:maybe ms/NonBlankString]
   entity_type             [:maybe ms/EntityTypeKeywordOrString]
   visibility_type         [:maybe TableVisibilityType]
   description             [:maybe :string]
   caveats                 [:maybe :string]
   points_of_interest      [:maybe :string]
   show_in_getting_started [:maybe :boolean]
   field_order             [:maybe FieldOrder]}
  (first (update-tables! [id] body)))

/

(api/defendpoint PUT 
  "Update all `Table` in `ids`."
  [:as {{:keys [ids display_name entity_type visibility_type description caveats points_of_interest
                show_in_getting_started], :as body} :body}]
  {ids                     [:sequential ms/PositiveInt]
   display_name            [:maybe ms/NonBlankString]
   entity_type             [:maybe ms/EntityTypeKeywordOrString]
   visibility_type         [:maybe TableVisibilityType]
   description             [:maybe :string]
   caveats                 [:maybe :string]
   points_of_interest      [:maybe :string]
   show_in_getting_started [:maybe :boolean]}
  (update-tables! ids body))
(def ^:private auto-bin-str (deferred-tru "Auto bin"))
(def ^:private dont-bin-str (deferred-tru "Don''t bin"))
(def ^:private minute-str (deferred-tru "Minute"))
(def ^:private hour-str (deferred-tru "Hour"))
(def ^:private day-str (deferred-tru "Day"))

note the order of these options corresponds to the order they will be shown to the user in the UI

(def ^:private time-options
  [[minute-str "minute"]
   [hour-str "hour"]
   [(deferred-tru "Minute of hour") "minute-of-hour"]])
(def ^:private datetime-options
  [[minute-str "minute"]
   [hour-str "hour"]
   [day-str "day"]
   [(deferred-tru "Week") "week"]
   [(deferred-tru "Month") "month"]
   [(deferred-tru "Quarter") "quarter"]
   [(deferred-tru "Year") "year"]
   [(deferred-tru "Minute of hour") "minute-of-hour"]
   [(deferred-tru "Hour of day") "hour-of-day"]
   [(deferred-tru "Day of week") "day-of-week"]
   [(deferred-tru "Day of month") "day-of-month"]
   [(deferred-tru "Day of year") "day-of-year"]
   [(deferred-tru "Week of year") "week-of-year"]
   [(deferred-tru "Month of year") "month-of-year"]
   [(deferred-tru "Quarter of year") "quarter-of-year"]])
(def ^:private date-options
  [[day-str "day"]
   [(deferred-tru "Week") "week"]
   [(deferred-tru "Month") "month"]
   [(deferred-tru "Quarter") "quarter"]
   [(deferred-tru "Year") "year"]
   [(deferred-tru "Day of week") "day-of-week"]
   [(deferred-tru "Day of month") "day-of-month"]
   [(deferred-tru "Day of year") "day-of-year"]
   [(deferred-tru "Week of year") "week-of-year"]
   [(deferred-tru "Month of year") "month-of-year"]
   [(deferred-tru "Quarter of year") "quarter-of-year"]])
(def ^:private dimension-options
  (let [default-entry [auto-bin-str ["default"]]]
    (zipmap (range)
            (concat
             (map (fn [[name param]]
                    {:name name
                     :mbql [:field nil {:temporal-unit param}]
                     :type :type/Date})
                  date-options)
             (map (fn [[name param]]
                    {:name name
                     :mbql [:field nil {:temporal-unit param}]
                     :type :type/DateTime})
                  datetime-options)
             (map (fn [[name param]]
                    {:name name
                     :mbql [:field nil {:temporal-unit param}]
                     :type :type/Time})
                  time-options)
             (conj
              (mapv (fn [[name [strategy param]]]
                      {:name name
                       :mbql [:field nil {:binning (merge {:strategy strategy}
                                                          (when param
                                                            {strategy param}))}]
                       :type :type/Number})
                    [default-entry
                     [(deferred-tru "10 bins") ["num-bins" 10]]
                     [(deferred-tru "50 bins") ["num-bins" 50]]
                     [(deferred-tru "100 bins") ["num-bins" 100]]])
              {:name dont-bin-str
               :mbql nil
               :type :type/Number})
             (conj
              (mapv (fn [[name [strategy param]]]
                      {:name name
                       :mbql [:field nil {:binning (merge {:strategy strategy}
                                                          (when param
                                                            {strategy param}))}]
                       :type :type/Coordinate})
                    [default-entry
                     [(deferred-tru "Bin every 0.1 degrees") ["bin-width" 0.1]]
                     [(deferred-tru "Bin every 1 degree") ["bin-width" 1.0]]
                     [(deferred-tru "Bin every 10 degrees") ["bin-width" 10.0]]
                     [(deferred-tru "Bin every 20 degrees") ["bin-width" 20.0]]])
              {:name dont-bin-str
               :mbql nil
               :type :type/Coordinate})))))
(def ^:private dimension-options-for-response
  (m/map-keys str dimension-options))
(defn- create-dim-index-seq [dim-type]
  (->> dimension-options
       (m/filter-vals (fn [v] (= (:type v) dim-type)))
       keys
       sort
       (map str)))
(def ^:private datetime-dimension-indexes
  (create-dim-index-seq :type/DateTime))
(def ^:private time-dimension-indexes
  (create-dim-index-seq :type/Time))
(def ^:private date-dimension-indexes
  (create-dim-index-seq :type/Date))
(def ^:private numeric-dimension-indexes
  (create-dim-index-seq :type/Number))
(def ^:private coordinate-dimension-indexes
  (create-dim-index-seq :type/Coordinate))
(defn- dimension-index-for-type [dim-type pred]
  (let [dim' (keyword dim-type)]
    (first (m/find-first (fn [[_k v]]
                           (and (= dim' (:type v))
                                (pred v))) dimension-options-for-response))))
(def ^:private datetime-default-index
  (dimension-index-for-type :type/DateTime #(= (str day-str) (str (:name %)))))
(def ^:private date-default-index
  (dimension-index-for-type :type/Date #(= (str day-str) (str (:name %)))))
(def ^:private time-default-index
  (dimension-index-for-type :type/Time #(= (str hour-str) (str (:name %)))))
(def ^:private numeric-default-index
  (dimension-index-for-type :type/Number #(.contains ^String (str (:name %)) (str auto-bin-str))))
(def ^:private coordinate-default-index
  (dimension-index-for-type :type/Coordinate #(.contains ^String (str (:name %)) (str auto-bin-str))))
(defn- supports-numeric-binning? [db]
  (and db (driver/database-supports? (:engine db) :binning db)))

TODO: Remove all this when the FE is fully ported to [[metabase.lib.binning/available-binning-strategies]].

(defn- assoc-field-dimension-options [{:keys [base_type semantic_type fingerprint] :as field} db]
  (let [{min_value :min, max_value :max} (get-in fingerprint [:type :type/Number])
        [default-option all-options] (cond
                                       (types/field-is-type? :type/Time field)
                                       [time-default-index time-dimension-indexes]
                                       (types/field-is-type? :type/Date field)
                                       [date-default-index date-dimension-indexes]
                                       (types/temporal-field? field)
                                       [datetime-default-index datetime-dimension-indexes]
                                       (and min_value max_value
                                            (isa? semantic_type :type/Coordinate)
                                            (supports-numeric-binning? db))
                                       [coordinate-default-index coordinate-dimension-indexes]
                                       (and min_value max_value
                                            (isa? base_type :type/Number)
                                            (not (isa? semantic_type :Relation/*))
                                            (supports-numeric-binning? db))
                                       [numeric-default-index numeric-dimension-indexes]
                                       :else
                                       [nil []])]
    (assoc field
           :default_dimension_option default-option
           :dimension_options        all-options)))
(defn- assoc-dimension-options [resp db]
  (-> resp
      (assoc :dimension_options dimension-options-for-response)
      (update :fields (fn [fields]
                        (mapv #(assoc-field-dimension-options % db) fields)))))
(defn- format-fields-for-response [resp]
  (update resp :fields
          (fn [fields]
            (for [{:keys [values] :as field} fields]
              (if (seq values)
                (update field :values field-values/field-values->pairs)
                field)))))

Returns the query metadata used to power the Query Builder for the given table. include-sensitive-fields?, include-hidden-fields? and include-editable-data-model? can be either booleans or boolean strings.

(defn fetch-query-metadata
  [table {:keys [include-sensitive-fields? include-hidden-fields? include-editable-data-model?]}]
  (if include-editable-data-model?
    (api/write-check table)
    (api/read-check table))
  (let [db (t2/select-one Database :id (:db_id table))]
    (-> table
        (t2/hydrate :db [:fields [:target :has_field_values] :dimensions :has_field_values] :segments :metrics)
        (m/dissoc-in [:db :details])
        (assoc-dimension-options db)
        format-fields-for-response
        (update :fields (partial filter (fn [{visibility-type :visibility_type}]
                                          (case (keyword visibility-type)
                                            :hidden    include-hidden-fields?
                                            :sensitive include-sensitive-fields?
                                            true)))))))

/:id/query_metadata

(api/defendpoint GET 
  "Get metadata about a `Table` useful for running queries.
   Returns DB, fields, field FKs, and field values.
  Passing `include_hidden_fields=true` will include any hidden `Fields` in the response. Defaults to `false`
  Passing `include_sensitive_fields=true` will include any sensitive `Fields` in the response. Defaults to `false`.
  Passing `include_editable_data_model=true` will check that the current user has write permissions for the table's
  data model, while `false` checks that they have data access perms for the table. Defaults to `false`.
  These options are provided for use in the Admin Edit Metadata page."
  [id include_sensitive_fields include_hidden_fields include_editable_data_model]
  {id                          ms/PositiveInt
   include_sensitive_fields    [:maybe ms/BooleanValue]
   include_hidden_fields       [:maybe ms/BooleanValue]
   include_editable_data_model [:maybe ms/BooleanValue]}
  (fetch-query-metadata (t2/select-one Table :id id) {:include-sensitive-fields?    include_sensitive_fields
                                                      :include-hidden-fields?       include_hidden_fields
                                                      :include-editable-data-model? include_editable_data_model}))

Return a sequence of 'virtual' fields metadata for the 'virtual' table for a Card in the Saved Questions 'virtual' database.

(defn- card-result-metadata->virtual-fields
  [card-id database-id metadata]
  (let [db (t2/select-one Database :id database-id)
        underlying (m/index-by :id (when-let [ids (seq (keep :id metadata))]
                                     (t2/select Field :id [:in ids])))
        fields (for [{col-id :id :as col} metadata]
                 (-> col
                     (update :base_type keyword)
                     (merge (select-keys (underlying col-id)
                                         [:semantic_type :fk_target_field_id :has_field_values]))
                     (assoc
                      :table_id     (str "card__" card-id)
                      :id           (or col-id
                                        ;; TODO -- what????
                                        [:field (:name col) {:base-type (or (:base_type col) :type/*)}])
                      ;; Assoc semantic_type at least temprorarily. We need the correct semantic type in place to make decisions
                      ;; about what kind of dimension options should be added. PK/FK values will be removed after we've added
                      ;; the dimension options
                      :semantic_type (keyword (:semantic_type col)))
                     (assoc-field-dimension-options db)))
        field->annotated (let [with-ids (filter (comp number? :id) fields)]
                           (zipmap with-ids (t2/hydrate with-ids [:target :has_field_values] :has_field_values)))]
    (map #(field->annotated % %) fields)))

Schema name to use for the saved questions virtual database for Cards that are in the root collection (i.e., not in any collection).

(defn root-collection-schema-name
  []
  "Everything else")

Return metadata for a 'virtual' table for a card in the Saved Questions 'virtual' database. Optionally include 'virtual' fields as well.

(defn card->virtual-table
  [{:keys [database_id] :as card} & {:keys [include-fields?]}]
  ;; if collection isn't already hydrated then do so
  (let [card (t2/hydrate card :collection)]
    (cond-> {:id               (str "card__" (u/the-id card))
             :db_id            (:database_id card)
             :display_name     (:name card)
             :schema           (get-in card [:collection :name] (root-collection-schema-name))
             :moderated_status (:moderated_status card)
             :description      (:description card)}
      include-fields? (assoc :fields (card-result-metadata->virtual-fields (u/the-id card)
                                                                           database_id
                                                                           (:result_metadata card))))))

This method clears the semantic_type attribute for PK/FK fields of nested queries. Those fields having a semantic type confuses the frontend and it can really used in the same way

(defn- remove-nested-pk-fk-semantic-types
  [{:keys [fields] :as metadata-response}]
  (assoc metadata-response :fields (for [{:keys [semantic_type id] :as field} fields]
                                     (if (and (or (isa? semantic_type :type/PK)
                                                  (isa? semantic_type :type/FK))
                                              ;; if they have a user entered id let it stay
                                              (or (nil? id)
                                                  (not (number? id))))
                                       (assoc field :semantic_type nil)
                                       field))))

/card_:id/querymetadata

(api/defendpoint GET 
  "Return metadata for the 'virtual' table for a Card."
  [id]
  {id ms/PositiveInt}
  (let [{:keys [database_id] :as card} (api/check-404
                                        (t2/select-one [Card :id :dataset_query :result_metadata :name :description
                                                        :collection_id :database_id]
                                                       :id id))
        moderated-status              (->> (mdb.query/query {:select   [:status]
                                                             :from     [:moderation_review]
                                                             :where    [:and
                                                                        [:= :moderated_item_type "card"]
                                                                        [:= :moderated_item_id id]
                                                                        [:= :most_recent true]]
                                                             :order-by [[:id :desc]]
                                                             :limit    1}
                                                            :id id)
                                           first :status)
        db (t2/select-one Database :id database_id)]
    (-> (assoc card :moderated_status moderated-status)
        api/read-check
        (card->virtual-table :include-fields? true)
        (assoc-dimension-options db)
        remove-nested-pk-fk-semantic-types)))

/card__:id/fks

(api/defendpoint GET 
  "Return FK info for the 'virtual' table for a Card. This is always empty, so this endpoint
   serves mainly as a placeholder to avoid having to change anything on the frontend."
  [id]
  {id ms/PositiveInt}
  []) ; return empty array

/:id/fks

(api/defendpoint GET 
  "Get all foreign keys whose destination is a `Field` that belongs to this `Table`."
  [id]
  {id ms/PositiveInt}
  (api/read-check Table id)
  (when-let [field-ids (seq (t2/select-pks-set Field, :table_id id, :visibility_type [:not= "retired"], :active true))]
    (for [origin-field (t2/select Field, :fk_target_field_id [:in field-ids], :active true)]
      ;; it's silly to be hydrating some of these tables/dbs
      {:relationship   :Mt1
       :origin_id      (:id origin-field)
       :origin         (t2/hydrate origin-field [:table :db])
       :destination_id (:fk_target_field_id origin-field)
       :destination    (t2/hydrate (t2/select-one Field :id (:fk_target_field_id origin-field)) :table)})))

/:id/rescan_values

(api/defendpoint POST 
  "Manually trigger an update for the FieldValues for the Fields belonging to this Table. Only applies to Fields that
   are eligible for FieldValues."
  [id]
  {id ms/PositiveInt}
  (let [table (api/write-check (t2/select-one Table :id id))]
    (events/publish-event! :event/table-manual-scan {:object table :user-id api/*current-user-id*})
    ;; Override *current-user-permissions-set* so that permission checks pass during sync. If a user has DB detail perms
    ;; but no data perms, they should stll be able to trigger a sync of field values. This is fine because we don't
    ;; return any actual field values from this API. (#21764)
    (binding [api/*current-user-permissions-set* (atom #{"/"})]
      ;; async so as not to block the UI
      (sync.concurrent/submit-task
       (fn []
         (sync.field-values/update-field-values-for-table! table))))
    {:status :success}))

/:id/discard_values

(api/defendpoint POST 
  "Discard the FieldValues belonging to the Fields in this Table. Only applies to fields that have FieldValues. If
   this Table's Database is set up to automatically sync FieldValues, they will be recreated during the next cycle."
  [id]
  {id ms/PositiveInt}
  (api/write-check (t2/select-one Table :id id))
  (when-let [field-ids (t2/select-pks-set Field :table_id id)]
    (t2/delete! (t2/table-name FieldValues) :field_id [:in field-ids]))
  {:status :success})

/:id/related

(api/defendpoint GET 
  "Return related entities."
  [id]
  {id ms/PositiveInt}
  (-> (t2/select-one Table :id id) api/read-check related/related))

/:id/fields/order

(api/defendpoint PUT 
  "Reorder fields"
  [id :as {field_order :body}]
  {id ms/PositiveInt
   field_order [:sequential ms/PositiveInt]}
  (-> (t2/select-one Table :id id) api/write-check (table/custom-order-fields! field_order)))

This helper function exists to make testing the POST /api/table/:id/append-csv endpoint easier.

(mu/defn ^:private append-csv!
  [{:keys [id file]}
   :- [:map
       [:id ms/PositiveInt]
       [:file (ms/InstanceOfClass java.io.File)]]]
  (try
    (let [model (upload/append-csv! {:table-id id
                                     :file     file})]
      {:status 200
       :body   (:id model)})
    (catch Throwable e
      {:status (or (-> e ex-data :status-code)
                   500)
       :body   {:message (or (ex-message e)
                             (tru "There was an error uploading the file"))}})
    (finally (io/delete-file file :silently))))

/:id/append-csv

(api/defendpoint ^:multipart POST 
  "Inserts the rows of an uploaded CSV file into the table identified by `:id`. The table must have been created by uploading a CSV file."
  [id :as {raw-params :params}]
  {id ms/PositiveInt}
  (append-csv! {:id id, :file (get-in raw-params ["file" :tempfile])}))
(api/define-routes)
 

/api/task endpoints

(ns metabase.api.task
  (:require
   [compojure.core :refer [GET]]
   [metabase.api.common :as api]
   [metabase.api.common.validation :as validation]
   [metabase.models.task-history :as task-history :refer [TaskHistory]]
   [metabase.server.middleware.offset-paging :as mw.offset-paging]
   [metabase.task :as task]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

/

(api/defendpoint GET 
  "Fetch a list of recent tasks stored as Task History"
  []
  (validation/check-has-application-permission :monitoring)
  {:total  (t2/count TaskHistory)
   :limit  mw.offset-paging/*limit*
   :offset mw.offset-paging/*offset*
   :data   (task-history/all mw.offset-paging/*limit* mw.offset-paging/*offset*)})

/:id

(api/defendpoint GET 
  "Get `TaskHistory` entry with ID."
  [id]
  {id ms/PositiveInt}
  (api/check-404 (api/read-check TaskHistory id)))

/info

(api/defendpoint GET 
  "Return raw data about all scheduled tasks (i.e., Quartz Jobs and Triggers)."
  []
  (validation/check-has-application-permission :monitoring)
  (task/scheduler-info))
(api/define-routes)
 

Endpoints for testing.

(ns metabase.api.testing
  (:require
   [clojure.java.jdbc :as jdbc]
   [clojure.string :as str]
   [compojure.core :refer [POST]]
   [metabase.api.common :as api]
   [metabase.config :as config]
   [metabase.db.connection :as mdb.connection]
   [metabase.db.setup :as mdb.setup]
   [metabase.util.files :as u.files]
   [metabase.util.log :as log]
   [metabase.util.malli.schema :as ms])
  (:import
   (com.mchange.v2.c3p0 PoolBackedDataSource)
   (java.util.concurrent.locks ReentrantReadWriteLock)))
(set! *warn-on-reflection* true)

EVERYTHING BELOW IS FOR H2 ONLY.

(defn- assert-h2 [app-db]
  (assert (= (:db-type app-db) :h2)
          "Snapshot/restore only works for :h2 application databases."))
(defn- snapshot-path-for-name
  ^String [snapshot-name]
  (let [path (u.files/get-path "e2e" "snapshots"
                               (str (str/replace (name snapshot-name) #"\W" "_") ".sql"))]
    (str (.toAbsolutePath path))))

SAVE

(defn- save-snapshot! [snapshot-name]
  (assert-h2 mdb.connection/*application-db*)
  (let [path (snapshot-path-for-name snapshot-name)]
    (log/infof "Saving snapshot to %s" path)
    (jdbc/query {:datasource mdb.connection/*application-db*} ["SCRIPT TO ?" path]))
  :ok)

/snapshot/:name

(api/defendpoint POST 
  "Snapshot the database for testing purposes."
  [name]
  {name ms/NonBlankString}
  (save-snapshot! name)
  nil)

RESTORE

Immediately destroy all open connections in the app DB connection pool.

(defn- reset-app-db-connection-pool!
  []
  (let [{:keys [data-source]} mdb.connection/*application-db*]
     (when (instance? PoolBackedDataSource data-source)
       (log/info "Destroying application database connection pool")
       (.hardReset ^PoolBackedDataSource data-source))))

Drop all objects in the application DB, then reload everything from the SQL dump at snapshot-path.

(defn- restore-app-db-from-snapshot!
  [^String snapshot-path]
  (log/infof "Restoring snapshot from %s" snapshot-path)
  (api/check-404 (.exists (java.io.File. snapshot-path)))
  (with-open [conn (.getConnection mdb.connection/*application-db*)]
    (doseq [sql-args [["SET LOCK_TIMEOUT 180000"]
                      ["DROP ALL OBJECTS"]
                      ["RUNSCRIPT FROM ?" snapshot-path]]]
      (jdbc/execute! {:connection conn} sql-args))
    ;; We've found a delightful bug in H2 where if you:
    ;; - create a table, then
    ;; - create a view based on the table, then
    ;; - modify the original table, then
    ;; - generate a snapshot
    ;; the generated snapshot has the `CREATE VIEW` *before* the `CREATE TABLE`. This results in a view that can't be
    ;; queried successfully until it is recompiled. Our workaround is to recompile ALL views immediately after we
    ;; restore the app DB from a snapshot. Bug report is here: https://github.com/h2database/h2database/issues/3942
    (doseq [table-name
            (->> (jdbc/query {:connection conn} ["SELECT table_name FROM information_schema.views WHERE table_schema=?" "PUBLIC"])
                 (map :table_name))]
      ;; parameterization doesn't work with view names. If someone maliciously named a table, this is bad. On the
      ;; other hand, this is not running in prod and you already had to have enough access to maliciously name the
      ;; table, so this is probably safe enough.
      (jdbc/execute! {:connection conn} (format "ALTER VIEW %s RECOMPILE" table-name))))
  ;; don't know why this happens but when I try to test things locally with `yarn-test-cypress-open-no-backend` and a
  ;; backend server started with `dev/start!` the snapshots are always missing columms added by DB migrations. So let's
  ;; just check and make sure it's fully up to date in this scenario. Not doing this outside of dev because it seems to
  ;; work fine for whatever reason normally and we don't want tests taking 5 million years to run because we're wasting
  ;; a bunch of time initializing Liquibase and checking for unrun migrations for every test when we don't need to. --
  ;; Cam
  (when config/is-dev?
    (mdb.setup/migrate! (mdb.connection/db-type) mdb.connection/*application-db* :up)))

Increment the [[mdb.connection/unique-identifier]] for the Metabase application DB. This effectively flushes all caches using it as a key (including things using [[mdb.connection/memoize-for-application-db]]) such as the Settings cache.

(defn- increment-app-db-unique-indentifier!
  []
  (alter-var-root #'mdb.connection/*application-db* assoc :id (swap! mdb.connection/application-db-counter inc)))
(defn- restore-snapshot! [snapshot-name]
  (assert-h2 mdb.connection/*application-db*)
  (let [path                         (snapshot-path-for-name snapshot-name)
        ^ReentrantReadWriteLock lock (:lock mdb.connection/*application-db*)]
    ;; acquire the application DB WRITE LOCK which will prevent any other threads from getting any new connections until
    ;; we release it.
    (try
      (.. lock writeLock lock)
      (reset-app-db-connection-pool!)
      (restore-app-db-from-snapshot! path)
      (increment-app-db-unique-indentifier!)
      (finally
        (.. lock writeLock unlock))))
  :ok)

/restore/:name

(api/defendpoint POST 
  "Restore a database snapshot for testing purposes."
  [name]
  {name ms/NonBlankString}
  (restore-snapshot! name)
  nil)

/echo

(api/defendpoint POST 
  [fail :as {:keys [body]}]
  {fail ms/BooleanValue}
  (if fail
    {:status 400
     :body {:error-code "oops"}}
    {:status 200
     :body body}))
(api/define-routes)
 

/api/tiles endpoints.

(ns metabase.api.tiles
  (:require
   [cheshire.core :as json]
   [clojure.set :as set]
   [compojure.core :refer [GET]]
   [metabase.api.common :as api]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor :as qp]
   [metabase.query-processor.util :as qp.util]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli.schema :as ms])
  (:import
   (java.awt Color)
   (java.awt.image BufferedImage)
   (java.io ByteArrayOutputStream)
   (javax.imageio ImageIO)))
(set! *warn-on-reflection* true)

--------------------------------------------------- CONSTANTS ----------------------------------------------------

Limit for number of pins to query for per tile.

(def ^:private ^:const tile-size             256.0)
(def ^:private ^:const pixel-origin          (float (/ tile-size 2)))
(def ^:private ^:const pin-size              6)
(def ^:private ^:const pixels-per-lon-degree (float (/ tile-size 360)))
(def ^:private ^:const pixels-per-lon-radian (float (/ tile-size (* 2 Math/PI))))
(def ^:private ^:const tile-coordinate-limit
  2000)

---------------------------------------------------- UTIL FNS ----------------------------------------------------

(defn- degrees->radians ^double [^double degrees]
  (* degrees (/ Math/PI 180.0)))
(defn- radians->degrees ^double [^double radians]
  (/ radians (/ Math/PI 180.0)))

--------------------------------------------------- QUERY FNS ----------------------------------------------------

Get the latitude & longitude of the upper left corner of a given tile.

(defn- x+y+zoom->lat-lon
  [^double x, ^double y, ^long zoom]
  (let [num-tiles   (bit-shift-left 1 zoom)
        corner-x    (/ (* x tile-size) num-tiles)
        corner-y    (/ (* y tile-size) num-tiles)
        lon         (/ (- corner-x pixel-origin) pixels-per-lon-degree)
        lat-radians (/ (- corner-y pixel-origin) (* pixels-per-lon-radian -1))
        lat         (radians->degrees (- (* 2 (Math/atan (Math/exp lat-radians)))
                                         (/ Math/PI 2)))]
    {:lat lat, :lon lon}))

Add an INSIDE filter to the given query to restrict results to a bounding box. The fields passed in can be either integer field ids or string field names. When a field name, the base-type will be set to :type/Float.

(defn- query-with-inside-filter
  [details lat-field lon-field x y zoom]
  (let [top-left      (x+y+zoom->lat-lon      x       y  zoom)
        bottom-right  (x+y+zoom->lat-lon (inc x) (inc y) zoom)
        inside-filter [:inside
                       lat-field
                       lon-field
                       (top-left :lat)
                       (top-left :lon)
                       (bottom-right :lat)
                       (bottom-right :lon)]]
    (update details :filter mbql.u/combine-filter-clauses inside-filter)))

--------------------------------------------------- RENDERING ----------------------------------------------------

(defn- create-tile ^BufferedImage [zoom points]
  (let [num-tiles (bit-shift-left 1 zoom)
        tile      (BufferedImage. tile-size tile-size (BufferedImage/TYPE_INT_ARGB))
        graphics  (.getGraphics tile)
        color-blue (new Color 76 157 230)
        color-white (Color/white)]
    (try
      (doseq [[^double lat, ^double lon] points]
        (let [sin-y      (-> (Math/sin (degrees->radians lat))
                             (Math/max -0.9999)                           ; bound sin-y between -0.9999 and 0.9999 (why ?))
                             (Math/min 0.9999))
              point      {:x (+ pixel-origin
                                (* lon pixels-per-lon-degree))
                          :y (+ pixel-origin
                                (* 0.5
                                   (Math/log (/ (+ 1 sin-y)
                                                (- 1 sin-y)))
                                   (* pixels-per-lon-radian -1.0)))}      ; huh?
              map-pixel  {:x (int (Math/floor (* (point :x) num-tiles)))
                          :y (int (Math/floor (* (point :y) num-tiles)))}
              tile-pixel {:x (mod (map-pixel :x) tile-size)
                          :y (mod (map-pixel :y) tile-size)}]
          ;; now draw a "pin" at the given tile pixel location
          (.setColor graphics color-white)
          (.fillRect graphics (tile-pixel :x) (tile-pixel :y) pin-size pin-size)
          (.setColor graphics color-blue)
          (.fillRect graphics (inc (tile-pixel :x)) (inc (tile-pixel :y)) (- pin-size 2) (- pin-size 2))))
      (catch Throwable e
        (.printStackTrace e))
      (finally
        (.dispose graphics)))
    tile))
(defn- tile->byte-array ^bytes [^BufferedImage tile]
  (let [output-stream (ByteArrayOutputStream.)]
    (try
      (when-not (ImageIO/write tile "png" output-stream) ; returns `true` if successful -- see JavaDoc
        (throw (Exception. (tru "No appropriate image writer found!"))))
      (.flush output-stream)
      (.toByteArray output-stream)
      (catch Throwable _e
        (byte-array 0)) ; return empty byte array if we fail for some reason
      (finally
        (u/ignore-exceptions
          (.close output-stream))))))

Adjust native queries to be an mbql from a source query so we can add the filter clause.

(defn- native->source-query
  [query]
  (if (contains? query :native)
    (let [native (set/rename-keys (:native query) {:query :native})]
      {:database (:database query)
       :type     :query
       :query    {:source-query native}})
    query))

---------------------------------------------------- ENDPOINT ----------------------------------------------------

Parse a string into an integer if it can be otherwise return the string. Intended to determine whether something is a field id or a field name.

(defn- int-or-string
  [x]
  (if (re-matches #"\d+" x)
    (Integer/parseInt x)
    x))

Makes a field reference for id-or-name. If id, the type information can be determined, if a string, must be provided. Since we deal exclusively with lat/long fields, assumed to be a float.

(defn- field-ref
  [id-or-name]
  (let [id-or-name' (int-or-string id-or-name)]
    [:field id-or-name' (when (string? id-or-name') {:base-type :type/Float})]))

Transform a card's query into a query finding coordinates in a particular region.

  • transform native queries into nested mbql queries from that native query
  • add [:inside lat lon bounding-region coordings] filter
  • limit query results to tile-coordinate-limit number of results
  • only select lat and lon fields rather than entire query's fields
(defn- query->tiles-query
  [query {:keys [zoom x y lat-field lon-field]}]
  (-> query
      native->source-query
      (update :query query-with-inside-filter
              lat-field lon-field
              x y zoom)
      (assoc-in [:query :fields] [lat-field lon-field])
      (assoc-in [:query :limit] tile-coordinate-limit)
      (assoc :async? false)))

/:zoom/:x/:y/:lat-field/:lon-field

TODO - this can be reworked to be defendpoint-async instead

TODO - this should reduce results from the QP in a streaming fashion instead of requiring them all to be in memory at the same time

(api/defendpoint GET 
  "This endpoints provides an image with the appropriate pins rendered given a MBQL `query` (passed as a GET query
  string param). We evaluate the query and find the set of lat/lon pairs which are relevant and then render the
  appropriate ones. It's expected that to render a full map view several calls will be made to this endpoint in
  parallel."
  [zoom x y lat-field lon-field query]
  {zoom        ms/Int
   x           ms/Int
   y           ms/Int
   lat-field   :string
   lon-field   :string
   query       ms/JSONString}
  (let [lat-field-ref (field-ref lat-field)
        lon-field-ref (field-ref lon-field)
        query
        (mbql.normalize/normalize (json/parse-string query keyword))
        updated-query (query->tiles-query query {:zoom zoom :x x :y y
                                                 :lat-field lat-field-ref
                                                 :lon-field lon-field-ref})
        {:keys [status], {:keys [rows cols]} :data, :as result}
        (qp/process-query-and-save-execution! updated-query
                                              {:executed-by api/*current-user-id*
                                               :context     :map-tiles})
        lat-key (qp.util/field-ref->key lat-field-ref)
        lon-key (qp.util/field-ref->key lon-field-ref)
        find-fn (fn [lat-or-lon-key]
                  (first (keep-indexed
                          (fn [idx col] (when (= (qp.util/field-ref->key (:field_ref col)) lat-or-lon-key) idx))
                          cols)))
        lat-idx (find-fn lat-key)
        lon-idx (find-fn lon-key)
        points  (for [row rows]
                  [(nth row lat-idx) (nth row lon-idx)])]
    (if (= status :completed)
      {:status  200
       :headers {"Content-Type" "image/png"}
       :body    (tile->byte-array (create-tile zoom points))}
      (throw (ex-info (tru "Query failed")
                      ;; `result` might be a `core.async` channel or something we're not expecting
                      (assoc (when (map? result) result) :status-code 400))))))
(api/define-routes)
 

/api/timeline endpoints.

(ns metabase.api.timeline
  (:require
   [compojure.core :refer [DELETE GET POST PUT]]
   [metabase.api.common :as api]
   [metabase.models.collection :as collection]
   [metabase.models.collection.root :as collection.root]
   [metabase.models.timeline :as timeline :refer [Timeline]]
   [metabase.models.timeline-event
    :as timeline-event
    :refer [TimelineEvent]]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

Events Query Parameters Schema

(def Include
  [:enum "events"])

/

(api/defendpoint POST 
  "Create a new [[Timeline]]."
  [:as {{:keys [name default description icon collection_id archived], :as body} :body}]
  {name          ms/NonBlankString
   default       [:maybe :boolean]
   description   [:maybe :string]
   icon          [:maybe timeline-event/Icon]
   collection_id [:maybe ms/PositiveInt]
   archived      [:maybe :boolean]}
  (collection/check-write-perms-for-collection collection_id)
  (let [tl (merge
            body
            {:creator_id api/*current-user-id*}
            (when-not icon
              {:icon timeline-event/default-icon}))]
    (first (t2/insert-returning-instances! Timeline tl))))

/

(api/defendpoint GET 
  "Fetch a list of [[Timelines]]. Can include `archived=true` to return archived timelines."
  [include archived]
  {include  [:maybe Include]
   archived [:maybe ms/BooleanString]}
  (let [archived? (Boolean/parseBoolean archived)
        timelines (->> (t2/select Timeline
                         {:where    [:and
                                     [:= :archived archived?]
                                     (collection/visible-collection-ids->honeysql-filter-clause
                                      (collection/permissions-set->visible-collection-ids @api/*current-user-permissions-set*))]
                          :order-by [[:%lower.name :asc]]})
                       (map collection.root/hydrate-root-collection))]
    (cond->> (t2/hydrate timelines :creator [:collection :can_write])
      (= include "events")
      (map #(timeline-event/include-events-singular % {:events/all? archived?})))))

/:id

(api/defendpoint GET 
  "Fetch the [[Timeline]] with `id`. Include `include=events` to unarchived events included on the timeline. Add
  `archived=true` to return all events on the timeline, both archived and unarchived."
  [id include archived start end]
  {id       ms/PositiveInt
   include  [:maybe Include]
   archived [:maybe ms/BooleanString]
   start    [:maybe ms/TemporalString]
   end      [:maybe ms/TemporalString]}
  (let [archived? (Boolean/parseBoolean archived)
        timeline  (api/read-check (t2/select-one Timeline :id id))]
    (cond-> (t2/hydrate timeline :creator [:collection :can_write])
      ;; `collection_id` `nil` means we need to assoc 'root' collection
      ;; because hydrate `:collection` needs a proper `:id` to work.
      (nil? (:collection_id timeline))
      collection.root/hydrate-root-collection
      (= include "events")
      (timeline-event/include-events-singular {:events/all?  archived?
                                               :events/start (when start (u.date/parse start))
                                               :events/end   (when end (u.date/parse end))}))))

/:id

(api/defendpoint PUT 
  "Update the [[Timeline]] with `id`. Returns the timeline without events. Archiving a timeline will archive all of the
  events in that timeline."
  [id :as {{:keys [name default description icon collection_id archived] :as timeline-updates} :body}]
  {id            ms/PositiveInt
   name          [:maybe ms/NonBlankString]
   default       [:maybe :boolean]
   description   [:maybe :string]
   icon          [:maybe timeline-event/Icon]
   collection_id [:maybe ms/PositiveInt]
   archived      [:maybe :boolean]}
  (let [existing (api/write-check Timeline id)
        current-archived (:archived (t2/select-one Timeline :id id))]
    (collection/check-allowed-to-change-collection existing timeline-updates)
    (t2/update! Timeline id
      (u/select-keys-when timeline-updates
        :present #{:description :icon :collection_id :default :archived}
        :non-nil #{:name}))
    (when (and (some? archived) (not= current-archived archived))
      (t2/update! TimelineEvent {:timeline_id id} {:archived archived}))
    (t2/hydrate (t2/select-one Timeline :id id) :creator [:collection :can_write])))

/:id

(api/defendpoint DELETE 
  "Delete a [[Timeline]]. Will cascade delete its events as well."
  [id]
  {id ms/PositiveInt}
  (api/write-check Timeline id)
  (t2/delete! Timeline :id id)
  api/generic-204-no-content)
(api/define-routes)
 

/api/timeline-event endpoints.

(ns metabase.api.timeline-event
  (:require
   [compojure.core :refer [DELETE GET POST PUT]]
   [metabase.analytics.snowplow :as snowplow]
   [metabase.api.common :as api]
   [metabase.models.collection :as collection]
   [metabase.models.timeline :as timeline :refer [Timeline]]
   [metabase.models.timeline-event
    :as timeline-event
    :refer [TimelineEvent]]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

/

(api/defendpoint POST 
  "Create a new [[TimelineEvent]]."
  [:as {{:keys [name description timestamp time_matters timezone icon timeline_id source question_id archived] :as body} :body}]
  {name         ms/NonBlankString
   description  [:maybe :string]
   timestamp    ms/TemporalString
   time_matters [:maybe :boolean]
   timezone     :string
   icon         [:maybe timeline-event/Icon]
   timeline_id  ms/PositiveInt
   source       [:maybe timeline-event/Source]
   question_id  [:maybe ms/PositiveInt]
   archived     [:maybe :boolean]}
  ;; deliberately not using api/check-404 so we can have a useful error message.
  (let [timeline (t2/select-one Timeline :id timeline_id)]
    (when-not timeline
      (throw (ex-info (tru "Timeline with id {0} not found" timeline_id)
                      {:status-code 404})))
    (collection/check-write-perms-for-collection (:collection_id timeline))
    ;; todo: revision system
    (let [parsed   (if (nil? timestamp)
                     (throw (ex-info (tru "Timestamp cannot be null") {:status-code 400}))
                     (u.date/parse timestamp))
          tl-event (merge (dissoc body :source :question_id)
                          {:creator_id api/*current-user-id*
                           :timestamp  parsed}
                          (when-not icon
                            {:icon (t2/select-one-fn :icon Timeline :id timeline_id)}))]
      (snowplow/track-event! ::snowplow/new-event-created
                             api/*current-user-id*
                             (cond-> {:time_matters time_matters
                                      :collection_id (:collection_id timeline)}
                               (boolean source)      (assoc :source source)
                               (boolean question_id) (assoc :question_id question_id)))
      (first (t2/insert-returning-instances! TimelineEvent tl-event)))))

/:id

(api/defendpoint GET 
  "Fetch the [[TimelineEvent]] with `id`."
  [id]
  {id ms/PositiveInt}
  (api/read-check TimelineEvent id))

/:id

(api/defendpoint PUT 
  "Update a [[TimelineEvent]]."
  [id :as {{:keys [name description timestamp time_matters timezone icon timeline_id archived]
            :as   timeline-event-updates} :body}]
  {id           ms/PositiveInt
   name         [:maybe ms/NonBlankString]
   description  [:maybe :string]
   timestamp    [:maybe ms/TemporalString]
   time_matters [:maybe :boolean]
   timezone     [:maybe :string]
   icon         [:maybe timeline-event/Icon]
   timeline_id  [:maybe ms/PositiveInt]
   archived     [:maybe :boolean]}
  (let [existing (api/write-check TimelineEvent id)
        timeline-event-updates (cond-> timeline-event-updates
                                 (boolean timestamp) (update :timestamp u.date/parse))]
    (collection/check-allowed-to-change-collection existing timeline-event-updates)
    ;; todo: if we accept a new timestamp, must we require a timezone? gut says yes?
    (t2/update! TimelineEvent id
                (u/select-keys-when timeline-event-updates
                                    :present #{:description :timestamp :time_matters :timezone :icon :timeline_id :archived}
                                    :non-nil #{:name}))
    (t2/select-one TimelineEvent :id id)))

/:id

(api/defendpoint DELETE 
  "Delete a [[TimelineEvent]]."
  [id]
  {id ms/PositiveInt}
  (api/write-check TimelineEvent id)
  (t2/delete! TimelineEvent :id id)
  api/generic-204-no-content)
(api/define-routes)
 
(ns metabase.api.transform
  (:require
   [compojure.core :refer [GET]]
   [medley.core :as m]
   [metabase.api.common :as api]
   [metabase.models.permissions :as perms]
   [metabase.transforms.core :as tf]
   [metabase.transforms.specs :as tf.specs]
   [metabase.util.malli.schema :as ms]))

/:db-id/:schema/:transform-name

(api/defendpoint GET 
  "Look up a database schema transform"
  [db-id schema transform-name]
  {db-id          ms/PositiveInt
   schema         ms/NonBlankString
   transform-name ms/NonBlankString}
  (api/check-403 (perms/set-has-full-permissions? @api/*current-user-permissions-set*
                   (perms/data-perms-path db-id schema)))
  (->> @tf.specs/transform-specs
       (m/find-first (comp #{transform-name} :name))
       (tf/apply-transform! db-id schema)))
(api/define-routes)
 

/api/user endpoints

(ns metabase.api.user
  (:require
   [compojure.core :refer [DELETE GET POST PUT]]
   [honey.sql.helpers :as sql.helpers]
   [java-time.api :as t]
   [metabase.analytics.snowplow :as snowplow]
   [metabase.api.common :as api]
   [metabase.api.common.validation :as validation]
   [metabase.api.ldap :as api.ldap]
   [metabase.api.session :as api.session]
   [metabase.config :as config]
   [metabase.email.messages :as messages]
   [metabase.events :as events]
   [metabase.integrations.google :as google]
   [metabase.models.collection :as collection :refer [Collection]]
   [metabase.models.dashboard :refer [Dashboard]]
   [metabase.models.interface :as mi]
   [metabase.models.login-history :refer [LoginHistory]]
   [metabase.models.permissions-group :as perms-group]
   [metabase.models.setting :refer [defsetting]]
   [metabase.models.user :as user :refer [User]]
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings :as public-settings]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.server.middleware.offset-paging :as mw.offset-paging]
   [metabase.server.middleware.session :as mw.session]
   [metabase.server.request.util :as request.u]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru tru]]
   [metabase.util.malli.schema :as ms]
   [metabase.util.password :as u.password]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)
(when config/ee-available?
  (classloader/require 'metabase-enterprise.sandbox.api.util
                       'metabase-enterprise.advanced-permissions.common
                       'metabase-enterprise.advanced-permissions.models.permissions.group-manager))
(defsetting user-visibility
  (deferred-tru "Note: Sandboxed users will never see suggestions.")
  :visibility   :authenticated
  :feature      :email-restrict-recipients
  :type         :keyword
  :default      :all
  :audit        :raw-value)

Check that user-id is current-user-idor thatcurrent-user` is a superuser, or throw a 403.

(defn check-self-or-superuser
  [user-id]
  {:pre [(integer? user-id)]}
  (api/check-403
   (or
    (= user-id api/*current-user-id*)
    api/*is-superuser?*)))

Check that user-id is not the id of the Internal User.

(defn check-not-internal-user
  [user-id]
  {:pre [(integer? user-id)]}
  (api/check (not= user-id config/internal-mb-user-id)
           [400 (tru "Not able to modify the internal user")]))
(defn- fetch-user [& query-criteria]
  (apply t2/select-one (vec (cons User user/admin-or-self-visible-columns)) :type :personal query-criteria))
(defn- maybe-set-user-permissions-groups! [user-or-id new-groups-or-ids]
  (when (and new-groups-or-ids
             (not (= (user/group-ids user-or-id)
                     (set (map u/the-id new-groups-or-ids)))))
    (api/check-superuser)
    (user/set-permissions-groups! user-or-id new-groups-or-ids)))
(defn- maybe-set-user-group-memberships!
  [user-or-id new-user-group-memberships & [is-superuser?]]
  (when new-user-group-memberships
    ;; if someone passed in both `:is_superuser` and `:group_ids`, make sure the whether the admin group is in group_ids
    ;; agrees with is_superuser -- don't want to have ambiguous behavior
    (when (some? is-superuser?)
      (api/checkp (= is-superuser? (contains? (set (map :id new-user-group-memberships)) (u/the-id (perms-group/admin))))
                  "is_superuser" (tru "Value of is_superuser must correspond to presence of Admin group ID in group_ids.")))
    (if-let [f (and (premium-features/enable-advanced-permissions?)
                    (resolve 'metabase-enterprise.advanced-permissions.models.permissions.group-manager/set-user-group-memberships!))]
      (f user-or-id new-user-group-memberships)
      (maybe-set-user-permissions-groups! user-or-id (map :id new-user-group-memberships)))))
(defn- updated-user-name [user-before-update changes]
  (let [[previous current] (map #(select-keys % [:first_name :last_name]) [user-before-update changes])
        updated-names (merge previous current)]
    (when (not= previous updated-names)
      updated-names)))
(defn- maybe-update-user-personal-collection-name! [user-before-update changes]
  ;; If the user name is updated, we shall also update the personal collection name (if such collection exists).
  (when-some [{:keys [first_name last_name]} (updated-user-name user-before-update changes)]
    (when-some [collection (collection/user->existing-personal-collection (u/the-id user-before-update))]
      (let [{email :email} user-before-update
            new-collection-name (collection/format-personal-collection-name first_name last_name email :site)]
        (when-not (= new-collection-name (:name collection))
          (t2/update! Collection (:id collection) {:name new-collection-name}))))))

+----------------------------------------------------------------------------------------------------------------+ | Fetching Users -- GET /api/user, GET /api/user/current, GET /api/user/:id | +----------------------------------------------------------------------------------------------------------------+

Figure out what where clause to add to the user query when we get a fiddly status and include_deactivated query.

This is to keep backwards compatibility with include_deactivated while adding `status.

(defn- status-clause
  [status include_deactivated]
  (if include_deactivated
    nil
    (case status
      "all"         nil
      "deactivated" [:= :is_active false]
      "active"      [:= :is_active true]
      [:= :is_active true])))
(defn- wildcard-query [query] (str "%" (u/lower-case-en query) "%"))

Honeysql clause to shove into user query if there's a query

(defn- query-clause
  [query]
  [:or
   [:like :%lower.first_name (wildcard-query query)]
   [:like :%lower.last_name  (wildcard-query query)]
   [:like :%lower.email      (wildcard-query query)]])

Columns of user table visible to current caller of API.

(defn- user-visible-columns
  []
  (cond
   api/*is-superuser?*
   user/admin-or-self-visible-columns
   api/*is-group-manager?*
   user/group-manager-visible-columns
   :else
   user/non-admin-or-self-visible-columns))

Honeysql clauses for filtering on users - with a status, - with a query, - with a group_id, - with include_deactivated

(defn- user-clauses
  [status query group_ids include_deactivated]
  (cond-> {}
    true                                               (sql.helpers/where [:= :core_user.type "personal"])
    true                                               (sql.helpers/where (status-clause status include_deactivated))
    ;; don't send the internal user
    (premium-features/sandboxed-or-impersonated-user?) (sql.helpers/where [:= :core_user.id api/*current-user-id*])
    (some? query)                                      (sql.helpers/where (query-clause query))
    (some? group_ids)                                  (sql.helpers/right-join
                                                        :permissions_group_membership
                                                        [:= :core_user.id :permissions_group_membership.user_id])
    (some? group_ids)                                  (sql.helpers/where
                                                        [:in :permissions_group_membership.group_id group_ids])
    (some? mw.offset-paging/*limit*)                   (sql.helpers/limit mw.offset-paging/*limit*)
    (some? mw.offset-paging/*offset*)                  (sql.helpers/offset mw.offset-paging/*offset*)))

Given a where clause, return a clause that can be used to count.

(defn- filter-clauses-without-paging
  [clauses]
  (dissoc clauses :order-by :limit :offset))

Given a user-id return a list of group-ids of which the user is a group manager.

(defn- group-ids-for-manager
  [user-id]
  (t2/select-fn-set
   :group_id
   :model/PermissionsGroupMembership
   {:where [:and [:= :user_id user-id]
            [:= :is_group_manager true]
            [:not= :group_id (:id (perms-group/all-users))]]}))

/

(api/defendpoint GET 
  "Fetch a list of `Users` for admins or group managers.
  By default returns only active users for admins and only active users within groups that the group manager is managing for group managers.
   - If `status` is `deactivated`, include deactivated users only.
   - If `status` is `all`, include all users (active and inactive).
   - Also supports `include_deactivated`, which if true, is equivalent to `status=all`; If is false, is equivalent to `status=active`.
   `status` and `include_deactivated` requires superuser permissions.
   - `include_deactivated` is a legacy alias for `status` and will be removed in a future release, users are advised to use `status` for better support and flexibility.
   If both params are passed, `status` takes precedence.
  For users with segmented permissions, return only themselves.
  Takes `limit`, `offset` for pagination.
  Takes `query` for filtering on first name, last name, email.
  Also takes `group_id`, which filters on group id."
  [status query group_id include_deactivated]
  {status              [:maybe :string]
   query               [:maybe :string]
   group_id            [:maybe ms/PositiveInt]
   include_deactivated [:maybe ms/BooleanString]}
  (or
   api/*is-superuser?*
   (if group_id
     (validation/check-manager-of-group group_id)
     (validation/check-group-manager)))
  (let [include_deactivated (Boolean/parseBoolean include_deactivated)
        manager-group-ids   (set (group-ids-for-manager api/*current-user-id*))
        group-id-clause     (cond
                              ;; We know that the user is either admin or group manager of the given group_id (if it exists)
                              group_id                [group_id]
                              ;; Superuser can see all users, so don't filter by group ID
                              api/*is-superuser?*     nil
                              ;; otherwise, if the user is a group manager, only show them users in the groups they manage
                              api/*is-group-manager?* (vec manager-group-ids))
        clauses             (user-clauses status query group-id-clause include_deactivated)]
    {:data (cond-> (t2/select
                    (vec (cons User (user-visible-columns)))
                    (cond-> clauses
                      (and (some? group_id) group-id-clause) (sql.helpers/order-by [:core_user.is_superuser :desc] [:is_group_manager :desc])
                      true             (sql.helpers/order-by [:%lower.first_name :asc]
                                                             [:%lower.last_name :asc]
                                                             [:id :asc])))
             ;; For admins also include the IDs of Users' Personal Collections
             api/*is-superuser?*
             (t2/hydrate :personal_collection_id)
             (or api/*is-superuser?*
                 api/*is-group-manager?*)
             (t2/hydrate :group_ids)
             ;; if there is a group_id clause, make sure the list is deduped in case the same user is in multiple gropus
             group-id-clause
             distinct)
     :total  (-> (t2/query
                  (merge {:select [[[:count [:distinct :core_user.id]] :count]]
                          :from   :core_user}
                         (filter-clauses-without-paging clauses)))
                 first
                 :count)
     :limit  mw.offset-paging/*limit*
     :offset mw.offset-paging/*offset*}))

Return a list of all user-ids in the same group with the user with id user-id. Ignore the All-user groups.

(defn- same-groups-user-ids
  [user-id]
  (map :user_id
       (t2/query {:select-distinct [:permissions_group_membership.user_id]
                  :from [:permissions_group_membership]
                  :where [:in :permissions_group_membership.group_id
                          ;; get all the groups ids that the current user is in
                          {:select-distinct [:permissions_group_membership.group_id]
                           :from  [:permissions_group_membership]
                           :where [:and [:= :permissions_group_membership.user_id user-id]
                                   [:not= :permissions_group_membership.group_id (:id (perms-group/all-users))]]}]})))

/recipients

(api/defendpoint GET 
  "Fetch a list of `Users`. Returns only active users. Meant for non-admins unlike GET /api/user.
   - If user-visibility is :all or the user is an admin, include all users.
   - If user-visibility is :group, include only users in the same group (excluding the all users group).
   - If user-visibility is :none or the user is sandboxed, include only themselves."
  []
  (cond
    (or (= :all (user-visibility)) api/*is-superuser?*)
    (let [clauses (-> (user-clauses nil nil nil nil)
                      (sql.helpers/order-by [:%lower.last_name :asc] [:%lower.first_name :asc]))]
      {:data   (t2/select (vec (cons User (user-visible-columns))) clauses)
       :total  (t2/count :model/User (filter-clauses-without-paging clauses))
       :limit  mw.offset-paging/*limit*
       :offset mw.offset-paging/*offset*})
    (and (= :group (user-visibility)) (not (premium-features/sandboxed-or-impersonated-user?)))
    (let [user-ids (same-groups-user-ids api/*current-user-id*)
          clauses  (cond-> (user-clauses nil nil nil nil)
                     (seq user-ids) (sql.helpers/where [:in :core_user.id user-ids])
                     true           (sql.helpers/order-by [:%lower.last_name :asc] [:%lower.first_name :asc]))]
      {:data   (t2/select (vec (cons User (user-visible-columns))) clauses)
       :total  (t2/count :model/User (filter-clauses-without-paging clauses))
       :limit  mw.offset-paging/*limit*
       :offset mw.offset-paging/*offset*})
    :else
    {:data   [(fetch-user :id api/*current-user-id*)]
     :total  1
     :limit  mw.offset-paging/*limit*
     :offset mw.offset-paging/*offset*}))

If advanced-permissions is enabled, add to user a permissions map.

(defn- maybe-add-advanced-permissions
  [user]
  (if-let [with-advanced-permissions
           (and (premium-features/enable-advanced-permissions?)
                (resolve 'metabase-enterprise.advanced-permissions.common/with-advanced-permissions))]
    (with-advanced-permissions user)
    user))

Adds sso_source key to the User, so FE could determine if the user is logged in via SSO.

(defn- maybe-add-sso-source
  [{:keys [id] :as user}]
  (if (premium-features/enable-any-sso?)
    (assoc user :sso_source (t2/select-one-fn :sso_source User :id id))
    user))

True when the user has permissions for at least one un-archived question and one un-archived dashboard.

(defn- add-has-question-and-dashboard
  [user]
  (let [coll-ids-filter (collection/visible-collection-ids->honeysql-filter-clause
                          :collection_id
                          (collection/permissions-set->visible-collection-ids @api/*current-user-permissions-set*))
        perms-query {:where [:and
                             [:= :archived false]
                             coll-ids-filter]}]
    (assoc user :has_question_and_dashboard (and (t2/exists? :model/Card perms-query)
                                                 (t2/exists? :model/Dashboard perms-query)))))

Adds first_login key to the User with the oldest timestamp from that user's login history. Otherwise give the current time, as it's the user's first login.

(defn- add-first-login
  [{:keys [id] :as user}]
  (let [ts (or
            (:timestamp (t2/select-one [LoginHistory :timestamp] :user_id id
                                       {:order-by [[:timestamp :asc]]}))
            (t/offset-date-time))]
    (assoc user :first_login ts)))

Adds custom homepage dashboard information to the current user.

(defn add-custom-homepage-info
  [user]
  (let [enabled? (public-settings/custom-homepage)
        id       (public-settings/custom-homepage-dashboard)
        dash     (t2/select-one Dashboard :id id)
        valid?   (and enabled? id (some? dash) (not (:archived dash)) (mi/can-read? dash))]
    (assoc user
           :custom_homepage (when valid? {:dashboard_id id}))))

/current

(api/defendpoint GET 
  "Fetch the current `User`."
  []
  (-> (api/check-404 @api/*current-user*)
      (t2/hydrate :personal_collection_id :group_ids :is_installer :has_invited_second_user)
      add-has-question-and-dashboard
      add-first-login
      maybe-add-advanced-permissions
      maybe-add-sso-source
      add-custom-homepage-info))

/:id

(api/defendpoint GET 
  "Fetch a `User`. You must be fetching yourself *or* be a superuser *or* a Group Manager."
  [id]
  {id ms/PositiveInt}
  (try
   (check-self-or-superuser id)
   (catch clojure.lang.ExceptionInfo _e
     (validation/check-group-manager)))
  (check-not-internal-user id)
  (-> (api/check-404 (fetch-user :id id, :is_active true))
      (t2/hydrate :user_group_memberships)))

+----------------------------------------------------------------------------------------------------------------+ | Creating a new User -- POST /api/user | +----------------------------------------------------------------------------------------------------------------+

/

(api/defendpoint POST 
  "Create a new `User`, return a 400 if the email address is already taken"
  [:as {{:keys [first_name last_name email user_group_memberships login_attributes] :as body} :body}]
  {first_name             [:maybe ms/NonBlankString]
   last_name              [:maybe ms/NonBlankString]
   email                  ms/Email
   user_group_memberships [:maybe [:sequential user/UserGroupMembership]]
   login_attributes       [:maybe user/LoginAttributes]}
  (api/check-superuser)
  (api/checkp (not (t2/exists? User :%lower.email (u/lower-case-en email)))
    "email" (tru "Email address already in use."))
  (t2/with-transaction [_conn]
    (let [new-user-id (u/the-id (user/create-and-invite-user!
                                 (u/select-keys-when body
                                   :non-nil [:first_name :last_name :email :password :login_attributes])
                                 @api/*current-user*
                                 false))]
      (maybe-set-user-group-memberships! new-user-id user_group_memberships)
      (snowplow/track-event! ::snowplow/invite-sent api/*current-user-id* {:invited-user-id new-user-id
                                                                           :source          "admin"})
      (-> (fetch-user :id new-user-id)
          (t2/hydrate :user_group_memberships)))))

+----------------------------------------------------------------------------------------------------------------+ | Updating a User -- PUT /api/user/:id | +----------------------------------------------------------------------------------------------------------------+

This predicate tests whether or not the user is allowed to update the email address associated with this account.

(defn- valid-email-update?
  [{:keys [sso_source email]} maybe-new-email]
  (or
   ;; Admin users can update
   api/*is-superuser?*
   ;; If the email address didn't change, let it through
   (= email maybe-new-email)
   ;; We should not allow a regular user to change their email address if they are a google/ldap user
   (and
    (not (= :google sso_source))
    (not (= :ldap sso_source)))))

This predicate tests whether or not the user is allowed to update the first/last name associated with this account. If the user is an SSO user, no name edits are allowed, but we accept if the new names are equal to the existing names.

(defn- valid-name-update?
  [{:keys [sso_source] :as user} name-key new-name]
  (or
   (= (get user name-key) new-name)
   (not sso_source)))

/:id

(api/defendpoint PUT 
  "Update an existing, active `User`.
  Self or superusers can update user info and groups.
  Group Managers can only add/remove users from groups they are manager of."
  [id :as {{:keys [email first_name last_name user_group_memberships
                   is_superuser is_group_manager login_attributes locale] :as body} :body}]
  {id                     ms/PositiveInt
   email                  [:maybe ms/Email]
   first_name             [:maybe ms/NonBlankString]
   last_name              [:maybe ms/NonBlankString]
   user_group_memberships [:maybe [:sequential user/UserGroupMembership]]
   is_superuser           [:maybe :boolean]
   is_group_manager       [:maybe :boolean]
   login_attributes       [:maybe user/LoginAttributes]
   locale                 [:maybe ms/ValidLocale]}
  (try
    (check-self-or-superuser id)
    (catch clojure.lang.ExceptionInfo _e
      (validation/check-group-manager)))
  (check-not-internal-user id)
  ;; only allow updates if the specified account is active
  (api/let-404 [user-before-update (fetch-user :id id, :is_active true)]
    ;; Google/LDAP non-admin users can't change their email to prevent account hijacking
    (api/check-403 (valid-email-update? user-before-update email))
    ;; SSO users (JWT, SAML, LDAP, Google) can't change their first/last names
    (when (contains? body :first_name)
      (api/checkp (valid-name-update? user-before-update :first_name first_name)
        "first_name" (tru "Editing first name is not allowed for SSO users.")))
    (when (contains? body :last_name)
      (api/checkp (valid-name-update? user-before-update :last_name last_name)
        "last_name" (tru "Editing last name is not allowed for SSO users.")))
    ;; can't change email if it's already taken BY ANOTHER ACCOUNT
    (api/checkp (not (t2/exists? User, :%lower.email (if email (u/lower-case-en email) email), :id [:not= id]))
      "email" (tru "Email address already associated to another user."))
    (t2/with-transaction [_conn]
      ;; only superuser or self can update user info
      ;; implicitly prevent group manager from updating users' info
      (when (or (= id api/*current-user-id*)
                api/*is-superuser?*)
        (when-let [changes (not-empty
                            (u/select-keys-when body
                              :present (cond-> #{:first_name :last_name :locale}
                                         api/*is-superuser?* (conj :login_attributes))
                              :non-nil (cond-> #{:email}
                                         api/*is-superuser?* (conj :is_superuser))))]
          (t2/update! User id changes)
          (events/publish-event! :event/user-update {:object (t2/select-one User :id id)
                                                     :previous-object user-before-update
                                                     :user-id api/*current-user-id*}))
        (maybe-update-user-personal-collection-name! user-before-update body))
      (maybe-set-user-group-memberships! id user_group_memberships is_superuser)))
  (-> (fetch-user :id id)
      (t2/hydrate :user_group_memberships)))

+----------------------------------------------------------------------------------------------------------------+ | Reactivating a User -- PUT /api/user/:id/reactivate | +----------------------------------------------------------------------------------------------------------------+

(defn- reactivate-user! [existing-user]
  (t2/update! User (u/the-id existing-user)
              {:is_active     true
               :is_superuser  false
               ;; if the user orignally logged in via Google Auth/LDAP and it's no longer enabled, convert them into a regular user
               ;; (see metabase#3323)
               :sso_source   (case (:sso_source existing-user)
                               :google (when (google/google-auth-enabled) :google)
                               :ldap   (when (api.ldap/ldap-enabled) :ldap)
                               (:sso_source existing-user))})
  ;; now return the existing user whether they were originally active or not
  (fetch-user :id (u/the-id existing-user)))

/:id/reactivate

(api/defendpoint PUT 
  "Reactivate user at `:id`"
  [id]
  {id ms/PositiveInt}
  (api/check-superuser)
  (check-not-internal-user id)
  (let [user (t2/select-one [:model/User :id :email :first_name :last_name :is_active :sso_source]
                            :type :personal
                            :id id)]
    (api/check-404 user)
    ;; Can only reactivate inactive users
    (api/check (not (:is_active user))
      [400 {:message (tru "Not able to reactivate an active user")}])
    (events/publish-event! :event/user-reactivated {:object user :user-id api/*current-user-id*})
    (reactivate-user! (dissoc user [:email :first_name :last_name]))))

+----------------------------------------------------------------------------------------------------------------+ | Updating a Password -- PUT /api/user/:id/password | +----------------------------------------------------------------------------------------------------------------+

/:id/password

(api/defendpoint PUT 
  "Update a user's password."
  [id :as {{:keys [password old_password]} :body, :as request}]
  {id       ms/PositiveInt
   password ms/ValidPassword}
  (check-self-or-superuser id)
  (api/let-404 [user (t2/select-one [User :id :last_login :password_salt :password],
                                    :id id,
                                    :type :personal,
                                    :is_active true)]
    ;; admins are allowed to reset anyone's password (in the admin people list) so no need to check the value of
    ;; `old_password` for them regular users have to know their password, however
    (when-not api/*is-superuser?*
      (api/checkp (u.password/bcrypt-verify (str (:password_salt user) old_password) (:password user))
                  "old_password"
                  (tru "Invalid password")))
    (user/set-password! id password)
    ;; after a successful password update go ahead and offer the client a new session that they can use
    (when (= id api/*current-user-id*)
      (let [{session-uuid :id, :as session} (api.session/create-session! :password user (request.u/device-info request))
            response                        {:success    true
                                             :session_id (str session-uuid)}]
        (mw.session/set-session-cookies request response session (t/zoned-date-time (t/zone-id "GMT")))))))

+----------------------------------------------------------------------------------------------------------------+ | Deleting (Deactivating) a User -- DELETE /api/user/:id | +----------------------------------------------------------------------------------------------------------------+

/:id

(api/defendpoint DELETE 
  "Disable a `User`.  This does not remove the `User` from the DB, but instead disables their account."
  [id]
  {id ms/PositiveInt}
  (api/check-superuser)
  ;; don't technically need to because the internal user is already 'deleted' (deactivated), but keeps the warnings consistent
  (check-not-internal-user id)
  (api/check-500
   (when (pos? (t2/update! User id {:type :personal} {:is_active false}))
     (events/publish-event! :event/user-deactivated {:object (t2/select-one User :id id) :user-id api/*current-user-id*})))
  {:success true})

+----------------------------------------------------------------------------------------------------------------+ | Other Endpoints -- PUT /api/user/:id/qpnewb, POST /api/user/:id/send_invite | +----------------------------------------------------------------------------------------------------------------+

/:id/modal/:modal

TODO - This could be handled by PUT /api/user/:id, we don't need a separate endpoint

(api/defendpoint PUT 
  "Indicate that a user has been informed about the vast intricacies of 'the' Query Builder."
  [id modal]
  {id ms/PositiveInt}
  (check-self-or-superuser id)
  (check-not-internal-user id)
  (let [k (or (get {"qbnewb"      :is_qbnewb
                    "datasetnewb" :is_datasetnewb}
                   modal)
              (throw (ex-info (tru "Unrecognized modal: {0}" modal)
                              {:modal modal
                               :allowable-modals #{"qbnewb" "datasetnewb"}})))]
    (api/check-500 (pos? (t2/update! User id {:type :personal} {k false}))))
  {:success true})

/:id/send_invite

(api/defendpoint POST 
  "Resend the user invite email for a given user."
  [id]
  {id ms/PositiveInt}
  (api/check-superuser)
  (check-not-internal-user id)
  (when-let [user (t2/select-one User :id id, :is_active true, :type :personal)]
    (let [reset-token (user/set-password-reset-token! id)
          ;; NOTE: the new user join url is just a password reset with an indicator that this is a first time user
          join-url    (str (user/form-password-reset-url reset-token) "#new")]
      (messages/send-new-user-email! user @api/*current-user* join-url false)))
  {:success true})
(api/define-routes)
 

Random utilty endpoints for things that don't belong anywhere else in particular, e.g. endpoints for certain admin page tasks.

(ns metabase.api.util
  (:require
   [compojure.core :refer [GET POST]]
   [crypto.random :as crypto-random]
   [metabase.analytics.prometheus :as prometheus]
   [metabase.analytics.stats :as stats]
   [metabase.api.common :as api]
   [metabase.api.common.validation :as validation]
   [metabase.logger :as logger]
   [metabase.troubleshooting :as troubleshooting]
   [metabase.util.malli.schema :as ms]
   [ring.util.response :as response]))

/password_check

(api/defendpoint POST 
  "Endpoint that checks if the supplied password meets the currently configured password complexity rules."
  [:as {{:keys [password]} :body}]
  {password ms/ValidPassword} ;; if we pass the su/ValidPassword test we're g2g
  {:valid true})

/logs

(api/defendpoint GET 
  "Logs."
  []
  (validation/check-has-application-permission :monitoring)
  (logger/messages))

/stats

(api/defendpoint GET 
  "Anonymous usage stats. Endpoint for testing, and eventually exposing this to instance admins to let them see
  what is being phoned home."
  []
  (validation/check-has-application-permission :monitoring)
  (stats/anonymous-usage-stats))

/random_token

(api/defendpoint GET 
  "Return a cryptographically secure random 32-byte token, encoded as a hexadecimal string.
   Intended for use when creating a value for `embedding-secret-key`."
  []
  {:token (crypto-random/hex 32)})

/bugreportdetails

(api/defendpoint GET 
  "Returns version and system information relevant to filing a bug report against Metabase."
  []
  (validation/check-has-application-permission :monitoring)
  {:system-info   (troubleshooting/system-info)
   :metabase-info (troubleshooting/metabase-info)})

/diagnosticinfo/connectionpool_info

(api/defendpoint GET 
  "Returns database connection pool info for the current Metabase instance."
  []
  (validation/check-has-application-permission :monitoring)
  (let [pool-info (prometheus/connection-pool-info)
        headers   {"Content-Disposition" "attachment; filename=\"connection_pool_info.json\""}]
    (assoc (response/response {:connection-pools pool-info}) :headers headers, :status 200)))
(api/define-routes)
 
(ns metabase.async.streaming-response
  (:require
   [cheshire.core :as json]
   [clojure.core.async :as a]
   [compojure.response]
   [metabase.async.streaming-response.thread-pool :as thread-pool]
   [metabase.async.util :as async.u]
   [metabase.server.protocols :as server.protocols]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [potemkin.types :as p.types]
   [pretty.core :as pretty]
   [ring.adapter.jetty9.common :as common]
   [ring.util.response :as response])
  (:import
   (java.io BufferedWriter OutputStream OutputStreamWriter)
   (java.nio ByteBuffer)
   (java.nio.channels ClosedChannelException SocketChannel)
   (java.nio.charset StandardCharsets)
   (java.util.zip GZIPOutputStream)
   (jakarta.servlet AsyncContext)
   (jakarta.servlet.http HttpServletResponse)
   (org.eclipse.jetty.io EofException)
   (org.eclipse.jetty.server Request)))
(set! *warn-on-reflection* true)
(defn- write-to-output-stream!
  ([^OutputStream os x]
   (if (int? x)
     (.write os ^int x)
     (.write os ^bytes x)))
  ([^OutputStream os ^bytes ba ^Integer offset ^Integer len]
   (.write os ba offset len)))
(defn- ex-status-code [e]
  (or (some #((some-fn :status-code :status) (ex-data %))
            (take-while some? (iterate ex-cause e)))
      500))
(defn- format-exception [e]
  (assoc (Throwable->map e) :_status (ex-status-code e)))

Write an error to the output stream, formatting it nicely. Closes output stream afterwards.

(defn write-error!
  [^OutputStream os obj]
  (cond
    (some #(instance? % obj)
          [InterruptedException EofException])
    (log/trace "Error is an InterruptedException or EofException, not writing to output stream")
    (instance? Throwable obj)
    (recur os (format-exception obj))
    :else
    (with-open [os os]
      (log/trace (u/pprint-to-str (list 'write-error! obj)))
      (try
        (with-open [writer (BufferedWriter. (OutputStreamWriter. os StandardCharsets/UTF_8))]
          (json/generate-stream obj writer))
        (catch EofException _)
        (catch Throwable e
          (log/error e (trs "Error writing error to output stream") obj))))))
(defn- do-f* [f ^OutputStream os _finished-chan canceled-chan]
  (try
    (f os canceled-chan)
    (catch EofException _
      (a/>!! canceled-chan ::jetty-eof)
      nil)
    (catch InterruptedException _
      (a/>!! canceled-chan ::thread-interrupted)
      nil)
    (catch Throwable e
      (log/error e (trs "Caught unexpected Exception in streaming response body"))
      (write-error! os e)
      nil)))

Runs f asynchronously on the streaming response thread-pool, returning immediately. When f finishes, completes (i.e., closes) Jetty async-context.

(defn- do-f-async
  [^AsyncContext async-context f ^OutputStream os finished-chan canceled-chan]
  {:pre [(some? os)]}
  (let [task (^:once fn* []
               (try
                 (do-f* f os finished-chan canceled-chan)
                 (catch Throwable e
                   (log/error e (trs "bound-fn caught unexpected Exception"))
                   (a/>!! finished-chan :unexpected-error))
                 (finally
                   (a/>!! finished-chan (if (a/poll! canceled-chan)
                                          :canceled
                                          :completed))
                   (a/close! finished-chan)
                   (a/close! canceled-chan)
                   (.complete async-context))))]
    (.submit (thread-pool/thread-pool) ^Runnable task)
    nil))

Does the client accept GZIP-encoded responses?

ring.middleware.gzip doesn't work on our StreamingResponse class.

(defn- should-gzip-response?
  [{{:strs [accept-encoding]} :headers}]
  (some->> accept-encoding (re-find #"gzip|\*")))
(defn- output-stream-delay [gzip? ^HttpServletResponse response]
  (if gzip?
    (delay
      (GZIPOutputStream. (.getOutputStream response) true))
    (delay
      (.getOutputStream response))))

An OutputStream proxy that fetches the actual output stream by dereffing a delay (or other dereffable) before first use.

(defn- delay-output-stream
  [dlay]
  (proxy [OutputStream] []
    (close []
      (.close ^OutputStream @dlay))
    (flush []
      (.flush ^OutputStream @dlay))
    (write
      ([x]
       (write-to-output-stream! @dlay x))
      ([ba offset length]
       (write-to-output-stream! @dlay ba offset length)))))

How often to check whether the request was canceled by the client.

(def ^:private async-cancellation-poll-interval-ms
  1000)

Check whether the HTTP request has been canceled by the client.

This function attempts to read a single byte from the underlying TCP socket; if the request is canceled, .read will return -1. Otherwise, since the entire request has already been read, .read should probably complete immediately, returning 0.

(defn- canceled?
  [^Request request]
  (try
    (let [^SocketChannel channel (.. request getHttpChannel getEndPoint getTransport)
          buf    (ByteBuffer/allocate 1)
          status (.read channel buf)]
      (log/tracef "Check cancelation status: .read returned %d" status)
      (neg? status))
    (catch InterruptedException _
      false)
    (catch ClosedChannelException _
      true)
    (catch Throwable e
      (log/error e (trs "Error determining whether HTTP request was canceled"))
      false)))

How long to wait for the cancelation check to complete (it should usually complete immediately -- see above -- but if it doesn't, we don't want to block forever).

(def ^:private async-cancellation-poll-timeout-ms
  1000)

Starts an async loop that checks whether the client has canceled HTTP request at some interval. If the client has canceled the request, this sends a message to canceled-chan.

(defn- start-async-cancel-loop!
  [request finished-chan canceled-chan]
  (a/go-loop []
    (let [poll-timeout-chan (a/timeout async-cancellation-poll-interval-ms)
          [_ port]          (a/alts! [poll-timeout-chan finished-chan])]
      (when (= port poll-timeout-chan)
        (log/tracef "Checking cancelation status after waiting %s" (u/format-milliseconds async-cancellation-poll-interval-ms))
        (let [canceled-status-chan (async.u/cancelable-thread (canceled? request))
              status-timeout-chan  (a/timeout async-cancellation-poll-timeout-ms)
              [canceled? port]     (a/alts! [finished-chan canceled-status-chan status-timeout-chan])]
          ;; if `canceled-status-chan` *wasn't* the first channel to return (i.e., we either timed out or the request
          ;; was completed) then close `canceled-status-chan` which will kill the underlying thread
          (a/close! canceled-status-chan)
          (when (= port status-timeout-chan)
            (log/debug (trs "Check cancelation status timed out after {0}"
                            (u/format-milliseconds async-cancellation-poll-timeout-ms))))
          (when (not= port finished-chan)
            (if canceled?
              (a/>! canceled-chan ::request-canceled)
              (recur))))))))
(defn- respond
  [{:keys [^HttpServletResponse response ^AsyncContext async-context request-map response-map request]}
   f {:keys [content-type status headers], :as _options} finished-chan]
  (let [canceled-chan (a/promise-chan)]
    (try
      (.setStatus response (or status 202))
      (let [gzip?   (should-gzip-response? request-map)
            headers (cond-> (assoc (merge headers (:headers response-map)) "Content-Type" content-type)
                      gzip? (assoc "Content-Encoding" "gzip"))]
        (#'common/set-headers response headers)
        (let [output-stream-delay (output-stream-delay gzip? response)
              delay-os            (delay-output-stream output-stream-delay)]
          (start-async-cancel-loop! request finished-chan canceled-chan)
          (do-f-async async-context f delay-os finished-chan canceled-chan)))
      (catch Throwable e
        (log/error e (trs "Unexpected exception in do-f-async"))
        (try
          (.sendError response 500 (.getMessage e))
          (catch Throwable e
            (log/error e (trs "Unexpected exception writing error response"))))
        (a/>!! finished-chan :unexpected-error)
        (a/close! finished-chan)
        (a/close! canceled-chan)
        (.complete async-context)))))
(declare render)
(p.types/deftype+ StreamingResponse [f options donechan]
  pretty/PrettyPrintable
  (pretty [_]
    (list (pretty/qualify-symbol-for-*ns* `->StreamingResponse) f options donechan))
  server.protocols/Respond
  (respond [_this context]
    (respond context f options donechan))
  ;; sync responses only (in some cases?)
  compojure.response/Renderable
  (render [this request]
    (render this (should-gzip-response? request)))
  ;; async responses only
  compojure.response/Sendable
  (send* [this request respond* _]
    (respond* (compojure.response/render this request))))
(defn- render [^StreamingResponse streaming-response gzip?]
  (let [{:keys [headers content-type], :as options} (.options streaming-response)]
    (assoc (response/response (if gzip?
                                (StreamingResponse. (.f streaming-response)
                                                    (assoc options :gzip? true)
                                                    (.donechan streaming-response))
                                streaming-response))
           :headers      (cond-> (assoc headers "Content-Type" content-type)
                           gzip? (assoc "Content-Encoding" "gzip"))
           :status       (or (:status options) 202))))

Fetch a promise channel that will get a message when a StreamingResponse is completely finished. Provided primarily for logging purposes.

(defn finished-chan
  [^StreamingResponse response]
  (.donechan response))

Impl for streaming-response macro.

(defn streaming-response*
  [f options]
  (->StreamingResponse f options (a/promise-chan)))

Create an API response that streams results to an OutputStream.

Minimal example:

(streaming-response {:content-type "application/json; charset=utf-8"} [os canceled-chan] (write-something-to-stream! os))

f should block until it is completely finished writing to the stream, which will be closed thereafter. canceled-chan can be monitored to see if the request is canceled before results are fully written to the stream.

Current options:

  • :content-type -- string content type to return in the results. This is required!
  • :headers -- other headers to include in the API response.
(defmacro streaming-response
  {:style/indent 2, :arglists '([options [os-binding canceled-chan-binding] & body])}
  [options [os-binding canceled-chan-binding :as bindings] & body]
  {:pre [(= (count bindings) 2)]}
  `(streaming-response* (bound-fn [~(vary-meta os-binding assoc :tag 'java.io.OutputStream) ~canceled-chan-binding] ~@body)
                        ~options))
 
(ns metabase.async.streaming-response.thread-pool
  (:require
   [metabase.config :as config])
  (:import
   (java.util.concurrent Executors ThreadPoolExecutor)
   (org.apache.commons.lang3.concurrent BasicThreadFactory$Builder)))
(set! *warn-on-reflection* true)
(def ^:private ^Long thread-pool-max-size
  (or (config/config-int :mb-async-query-thread-pool-size)
      (config/config-int :mb-jetty-maxthreads)
      50))
(defonce ^:private thread-pool*
  (delay
    (Executors/newFixedThreadPool thread-pool-max-size
                                  (.build
                                   (doto (BasicThreadFactory$Builder.)
                                     (.namingPattern "streaming-response-thread-pool-%d")
                                     ;; Daemon threads do not block shutdown of the JVM
                                     (.daemon true))))))

Thread pool for asynchronously running streaming responses.

(defn thread-pool
  ^ThreadPoolExecutor []
  @thread-pool*)

The number of active streaming response threads.

(defn active-thread-count
  []
  (.getActiveCount (thread-pool)))

The number of queued streaming response threads.

(defn queued-thread-count
  []
  (count (.getQueue (thread-pool))))
 

Utility functions for core.async-based async logic.

(ns metabase.async.util
  (:require
   [clojure.core.async :as a]
   [metabase.util.log :as log]
   [schema.core :as s])
  (:import
   (clojure.core.async.impl.buffers PromiseBuffer)
   (clojure.core.async.impl.channels ManyToManyChannel)
   (java.util.concurrent ThreadPoolExecutor)))
(set! *warn-on-reflection* true)

TODO - most of this stuff can be removed now that we have the new-new reducible/async QP implementation of early 2020. No longer needed

Is core.async chan a promise-chan?

(defn promise-chan?
  [chan]
  (and (instance? ManyToManyChannel chan)
       (instance? PromiseBuffer (.buf ^ManyToManyChannel chan))))

Schema for a core.async promise channel.

(def PromiseChan
  (s/constrained ManyToManyChannel promise-chan? "promise chan"))

Like core.async/pipe but for promise channels, and closes in-chan if out-chan is closed before receiving a result. Closes both channels when in-chan closes or receives a result.

TODO -- this is used in literally one place only, [[metabase.api.public/run-query-for-card-with-id-async-run-fn]], so maybe we should consider getting rid of it.

(s/defn promise-pipe
  [in-chan :- PromiseChan, out-chan :- PromiseChan]
  (a/go
    (let [[val port] (a/alts! [in-chan out-chan] :priority true)]
      ;; forward any result of `in-chan` to `out-chan`.
      (when (and (= port in-chan)
                 (some? val))
        (a/>! out-chan val))
      ;; Close both channels once either gets a result or is closed.
      (a/close! in-chan)
      (a/close! out-chan)))
  nil)

Exactly like a/thread-call, with two differences:

1) the result channel is a promise channel instead of a regular channel 2) Closing the result channel early will cancel the async thread call.

(defn cancelable-thread-call
  [f]
  ;; create two channels:
  ;; * `done-chan` will always get closed immediately after `(f)` is finished
  ;; * `result-chan` will get the result of `(f)`, *after* `done-chan` is closed
  (let [done-chan   (a/promise-chan)
        result-chan (a/promise-chan)
        binds       (clojure.lang.Var/getThreadBindingFrame)
        f*          (fn []
                      (clojure.lang.Var/resetThreadBindingFrame binds)
                      (let [result (try
                                     (f)
                                     (catch Throwable e
                                       (log/trace e "cancelable-thread-call: caught exception in f")
                                       e))]
                        (a/close! done-chan)
                        (when (some? result)
                          (a/>!! result-chan result)))
                      (a/close! result-chan))
        futur       (.submit ^ThreadPoolExecutor @#'a/thread-macro-executor ^Runnable f*)]
    ;; if `result-chan` gets a result/closed *before* `done-chan`, it means it was closed by the caller, so we should
    ;; cancel the thread running `f*`
    (a/go
      (let [[_ port] (a/alts! [done-chan result-chan] :priority true)]
        (when (= port result-chan)
          (log/trace "cancelable-thread-call: result channel closed before f finished; canceling thread")
          (future-cancel futur))))
    result-chan))

Exactly like a/thread, with two differences:

1) the result channel is a promise channel instead of a regular channel 2) Closing the result channel early will cancel the async thread call.

(defmacro cancelable-thread
  {:style/indent 0}
  [& body]
  `(cancelable-thread-call (fn [] ~@body)))
 

Generate "interesting" combinations of metrics, dimensions, and filters.

In the metabase.automagic-dashboards.interesting namespace, we create "grounded" metrics, which are both realized (field references have been added to their aggregate clauses) and interesting (because metrics are always interesting), as well as grounded dimensions and filters. This ns combines these dimensions (as breakouts) and filters (as filters) into the ground metrics based on the affinities defined in provided card-templates.

Card templates provided the following key relationships: - dimension to dimension affinities - The groups of dimensions the might appear on the x-axis of a chart (breakouts). These generally a single dimension (e.g. time or category) but can be multiple (e.g. longitude and latitude) - dimension to metric affinities - Combinations of dimensions and metrics (e.g. profit metric over time dimension). This functionally adds breakouts to a metric. - metric to metric affinities - Combinations of metrics that belong together (e.g. Sum, Avg, Max, and Min of a field).

The primary function in this ns, grounded-metrics->dashcards takes the base context , above grounded values, and card definitions and creates a set of dashcards with the above combinations of metrics, dimensions, and filters.

(ns metabase.automagic-dashboards.combination
  (:require
    [clojure.math.combinatorics :as math.combo]
    [clojure.string :as str]
    [clojure.walk :as walk]
    [medley.core :as m]
    [metabase.automagic-dashboards.dashboard-templates :as dashboard-templates]
    [metabase.automagic-dashboards.interesting :as interesting]
    [metabase.automagic-dashboards.schema :as ads]
    [metabase.automagic-dashboards.util :as magic.util]
    [metabase.automagic-dashboards.visualization-macros :as visualization]
    [metabase.driver :as driver]
    [metabase.models.interface :as mi]
    [metabase.query-processor.util :as qp.util]
    [metabase.util :as u]
    [metabase.util.i18n :as i18n]
    [metabase.util.malli :as mu]))

Add breakouts and filters to a query based on the breakout fields and filter clauses

(defn add-breakouts-and-filter
  [query
   breakout-fields
   filter-clauses]
  (cond->
    (assoc query :breakout (mapv (partial interesting/->reference :mbql) breakout-fields))
    (seq filter-clauses)
    (assoc :filter (into [:and] filter-clauses))))

Given two seqs of types, return true of the types of the child types are satisfied by some permutation of the parent types.

(defn matching-types?
  [parent-types child-types]
  (true?
    (when (= (count parent-types)
             (count child-types))
      (some
        (fn [parent-types-permutation]
          (when (->> (map isa? child-types parent-types-permutation)
                     (every? true?))
            true))
        (math.combo/permutations parent-types)))))

Take a map with keys as sets of types and collection of types and return the map with only the type set keys that satisfy the types.

(defn filter-to-matching-types
  [types->x types]
  (into {} (filter #(matching-types? (first %) types)) types->x))
(comment
  (filter-to-matching-types
    {#{} :fail
     #{:type/Number} :pass
     #{:type/Integer} :pass
     #{:type/CreationTimestamp} :fail}
    #{:type/Integer})
  )

Add the :dataset_query key to this metric. Requires both the current metric-definition (from the grounded metric) and the database and table ids (from the source object).

(defn add-dataset-query
  [{:keys [metric-definition] :as ground-metric-with-dimensions}
   {{:keys [database]} :root :keys [source query-filter]}]
  (let [source-table (if (->> source (mi/instance-of? :model/Table))
                       (-> source u/the-id)
                       (->> source u/the-id (str "card__")))]
    (assoc ground-metric-with-dimensions
           :dataset_query {:database database
                           :type     :query
                           :query    (cond-> (assoc metric-definition
                                                    :source-table source-table)
                                       query-filter (assoc :filter query-filter))})))
(defn- instantiate-visualization
  [[k v] dimensions metrics]
  (let [dimension->name (comp vector :name dimensions)
        metric->name    (comp vector first :metric metrics)]
    [k (-> v
           (m/update-existing :map.latitude_column dimension->name)
           (m/update-existing :map.longitude_column dimension->name)
           (m/update-existing :graph.metrics metric->name)
           (m/update-existing :graph.dimensions dimension->name))]))

Capitalize only the first letter in a given string.

(defn capitalize-first
  [s]
  (let [s (str s)]
    (str (u/upper-case-en (subs s 0 1)) (subs s 1))))
(defn- fill-templates
  [template-type {:keys [root tables]} bindings s]
  (let [binding-fn (some-fn (merge {"this" (-> root
                                               :entity
                                               (assoc :full-name (:full-name root)))}
                                   bindings)
                            (comp first #(magic.util/filter-tables % tables) dashboard-templates/->entity)
                            identity)]
    (str/replace s #"\[\[(\w+)(?:\.([\w\-]+))?\]\]"
                 (fn [[_ identifier attribute]]
                   (let [entity    (binding-fn identifier)
                         attribute (some-> attribute qp.util/normalize-token)]
                     (str (or (and (ifn? entity) (entity attribute))
                              (root attribute)
                              (interesting/->reference template-type entity))))))))
(defn- instantiate-metadata
  [x context available-metrics bindings]
  (-> (walk/postwalk
        (fn [form]
          (if (i18n/localized-string? form)
            (let [s     (str form)
                  new-s (fill-templates :string context bindings s)]
              (if (not= new-s s)
                (capitalize-first new-s)
                s))
            form))
        x)
      (m/update-existing :visualization #(instantiate-visualization % bindings available-metrics))))

Given grounded dimensions (name->field map) and card-dimensions (the :dimensions key) from a card, combine these into a single map. This is needed because the card dimensions may contain specializations such as breakout details for card visualization.

(defn- combine-dimensions
  [dimension-name->field card-dimensions]
  (reduce (fn [acc [d v]]
            (cond-> acc
              (acc d)
              (update d into v)))
          dimension-name->field
          (map first card-dimensions)))
(def ^:private ^{:arglists '([field])} id-or-name
  (some-fn :id :name))
(defn- singular-cell-dimensions
  [{:keys [cell-query]}]
  (letfn [(collect-dimensions [[op & args]]
            (case (some-> op qp.util/normalize-token)
              :and (mapcat collect-dimensions args)
              :=   (magic.util/collect-field-references args)
              nil))]
    (->> cell-query
         collect-dimensions
         (map magic.util/field-reference->id)
         set)))
(defn- valid-breakout-dimension?
  [{:keys [base_type db fingerprint aggregation]}]
  (or (nil? aggregation)
      (not (isa? base_type :type/Number))
      (and (driver/database-supports? (:engine db) :binning db)
           (-> fingerprint :type :type/Number :min))))
(defn- valid-bindings? [{:keys [root]} satisfied-dimensions bindings]
  (let [cell-dimension? (singular-cell-dimensions root)]
    (->> satisfied-dimensions
         (map first)
         (map (fn [[identifier opts]]
                (merge (bindings identifier) opts)))
         (every? (every-pred valid-breakout-dimension?
                             (complement (comp cell-dimension? id-or-name)))))))
(mu/defn grounded-metrics->dashcards :- [:sequential ads/combined-metric]
  "Generate dashcards from ground dimensions, using the base context, ground dimensions,
  card templates, and grounded metrics as input."
  [base-context
   card-templates
   ground-dimensions :- ads/dim-name->matching-fields
   ground-filters
   grounded-metrics :- [:sequential ads/grounded-metric]]
  (let [metric-name->metric (zipmap
                              (map :metric-name grounded-metrics)
                              (map-indexed
                                (fn [idx grounded-metric] (assoc grounded-metric :position idx))
                                grounded-metrics))
        simple-grounded-filters (update-vals
                                  (group-by :filter-name ground-filters)
                                  (fn [vs] (apply max-key :score vs)))]
    (for [{card-name       :card-name
           card-metrics    :metrics
           card-score      :card-score
           card-dimensions :dimensions
           card-filters    :filters :as card-template} card-templates
          :let [dim-names (map ffirst card-dimensions)]
          :when (and (every? ground-dimensions dim-names)
                     (every? simple-grounded-filters card-filters))
          :let [dim-score (map (comp :score ground-dimensions) dim-names)]
          dimension-name->field (->> (map (comp :matches ground-dimensions) dim-names)
                                     (apply math.combo/cartesian-product)
                                     (map (partial zipmap dim-names)))
          :let [merged-dims (combine-dimensions dimension-name->field card-dimensions)]
          :when (and (valid-bindings? base-context card-dimensions dimension-name->field)
                     (every? metric-name->metric card-metrics))
          :let [[grounded-metric :as all-satisfied-metrics] (map metric-name->metric card-metrics)
                final-aggregate                    (into []
                                                         (comp (map (comp :aggregation :metric-definition))
                                                               cat)
                                                         all-satisfied-metrics)
                bound-metric-dimension-name->field (apply merge (map :dimension-name->field all-satisfied-metrics))
                card             (-> card-template
                                     (visualization/expand-visualization
                                       (vals dimension-name->field)
                                       nil)
                                     (instantiate-metadata base-context
                                                           {}
                                                           (into dimension-name->field bound-metric-dimension-name->field)))
                score-components (list* (:card-score card)
                                        (:metric-score grounded-metric)
                                        dim-score)]]
      (merge
        card
        (-> grounded-metric
            (assoc
              :id (gensym)
              :affinity-name card-name
              :card-score card-score
              :total-score (long (/ (apply + score-components) (count score-components)))
              :score-components score-components)
            (assoc-in [:metric-definition :aggregation] final-aggregate)
            (update :metric-definition add-breakouts-and-filter
                    (vals merged-dims)
                    (mapv (comp :filter simple-grounded-filters) card-filters))
            (add-dataset-query base-context))))))

Convert a seq of items to a string. If more than two items are present, they are separated by commas, including the oxford comma on the final pairing.

(defn items->str
  [[f s :as items]]
  (condp = (count items)
    0 ""
    1 (str f)
    2 (format "%s and %s" f s)
    (format "%s, and %s" (str/join ", " (butlast items)) (last items))))

Name of the dimension. Trying for :display_name and falling back to :name

(def dim-name
  (some-fn :display_name :name))
 
(ns metabase.automagic-dashboards.comparison
  (:require
   [medley.core :as m]
   [metabase.api.common :as api]
   [metabase.automagic-dashboards.core
    :refer [->related-entity
            ->root
            automagic-analysis
            capitalize-first]]
   [metabase.automagic-dashboards.filters :as filters]
   [metabase.automagic-dashboards.names :as names]
   [metabase.automagic-dashboards.populate :as populate]
   [metabase.automagic-dashboards.util :as magic.util]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.models.interface :as mi]
   [metabase.models.table :refer [Table]]
   [metabase.query-processor.util :as qp.util]
   [metabase.related :as related]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]))
(def ^:private ^{:arglists '([root])} comparison-name
  (comp capitalize-first (some-fn :comparison-name :full-name)))
(defn- dashboard->cards
  [dashboard]
  (->> dashboard
       :dashcards
       (map (fn [{:keys [size_y card col row series] :as dashcard}]
              (assoc card
                :text     (-> dashcard :visualization_settings :text)
                :series   series
                :height   size_y
                :position (+ (* row populate/grid-width) col))))
       (sort-by :position)))
(defn- clone-card
  [card]
  (-> card
      (select-keys [:dataset_query :description :display :name :result_metadata
                    :visualization_settings])
      (assoc :creator_id    api/*current-user-id*
             :collection_id nil
             :id            (gensym))))
(def ^:private ^{:arglists '([card])} display-type
  (comp qp.util/normalize-token :display))

Add new-filter-clauses to a query. There is actually an mbql.u/add-filter-clause function we should be using instead, but that validates its input and output, and the queries that come in here aren't always valid (for example, missing :database). If we can, it would be nice to use that instead of reinventing the wheel here.

(defn- add-filter-clauses
  [{{existing-filter-clause :filter} :query, :as query}, new-filter-clauses]
  (let [clauses           (filter identity (cons existing-filter-clause new-filter-clauses))
        new-filter-clause (when (seq clauses)
                            (mbql.normalize/normalize-fragment [:query :filter] (cons :and clauses)))]
    (cond-> query
      (seq new-filter-clause) (assoc-in [:query :filter] new-filter-clause))))

Inject filter clause into card.

(defn- inject-filter
  [{:keys [query-filter cell-query] :as root} card]
  (-> card
      (update :dataset_query #(add-filter-clauses % [query-filter cell-query]))
      (update :series (partial map (partial inject-filter root)))))
(defn- multiseries?
  [card]
  (or (-> card :series not-empty)
      (-> card (get-in [:dataset_query :query :aggregation]) count (> 1))
      (-> card (get-in [:dataset_query :query :breakout]) count (> 1))))
(defn- overlay-comparison?
  [card]
  (and (-> card display-type (#{:bar :line}))
       (not (multiseries? card))))
(defn- comparison-row
  [dashboard row left right card]
  (if (:display card)
    (let [height                   (:height card)
          card-left                (->> card (inject-filter left) clone-card)
          card-right               (->> card (inject-filter right) clone-card)
          [color-left color-right] (->> [left right]
                                        (map #(get-in % [:dataset_query :query :filter]))
                                        populate/map-to-colors)]
      (if (overlay-comparison? card)
        (let [card   (-> card-left
                         (assoc-in [:visualization_settings :graph.colors] [color-left color-right])
                         (update :name #(format "%s (%s)" % (comparison-name left))))
              series (-> card-right
                         (update :name #(format "%s (%s)" % (comparison-name right)))
                         vector)]
          (update dashboard :dashcards conj (merge (populate/card-defaults)
                                                       {:col                    0
                                                        :row                    row
                                                        :size_x                 populate/grid-width
                                                        :size_y                 height
                                                        :card                   card
                                                        :card_id                (:id card)
                                                        :series                 series
                                                        :visualization_settings {:graph.y_axis.auto_split false
                                                                                 :graph.series_labels     [(:name card) (:name (first series))]}})))
        (let [width        (/ populate/grid-width 2)
              series-left  (map clone-card (:series card-left))
              series-right (map clone-card (:series card-right))
              card-left    (cond-> card-left
                             (not (multiseries? card-left))
                             (assoc-in [:visualization_settings :graph.colors] [color-left]))
              card-right   (cond-> card-right
                             (not (multiseries? card-right))
                             (assoc-in [:visualization_settings :graph.colors] [color-right]))]
          (-> dashboard
              (update :dashcards conj (merge (populate/card-defaults)
                                                 {:col                    0
                                                  :row                    row
                                                  :size_x                 width
                                                  :size_y                 height
                                                  :card                   card-left
                                                  :card_id                (:id card-left)
                                                  :series                 series-left
                                                  :visualization_settings {}}))
              (update :dashcards conj (merge (populate/card-defaults)
                                                 {:col                    width
                                                   :row                    row
                                                   :size_x                 width
                                                   :size_y                 height
                                                   :card                   card-right
                                                   :card_id                (:id card-right)
                                                   :series                 series-right
                                                   :visualization_settings {}}))))))
    (populate/add-text-card dashboard {:text                   (:text card)
                                       :width                  (/ populate/grid-width 2)
                                       :height                 (:height card)
                                       :visualization-settings {:dashcard.background false
                                                                :text.align_vertical :bottom}}
                            [row 0])))
(def ^:private ^Long ^:const title-height 2)
(defn- add-col-title
  [dashboard title description col]
  (let [height (cond-> title-height
                 description inc)]
    [(populate/add-text-card dashboard
                             {:text                   (if description
                                                        (format "# %s\n\n%s" title description)
                                                        (format "# %s" title))
                              :width                  (/ populate/grid-width 2)
                              :height                 height
                              :visualization-settings {:dashcard.background false
                                                       :text.align_vertical :top}}
                             [0 col])
     height]))
(defn- add-title-row
  [dashboard left right]
  (let [[dashboard height-left]  (add-col-title dashboard
                                                (comparison-name left)
                                                (-> left :entity :description) 0)
        [dashboard height-right] (add-col-title dashboard
                                                (comparison-name right)
                                                (-> right :entity :description)
                                                (/ populate/grid-width 2))]
    [dashboard (max height-left height-right)]))
(defn- series-labels
  [card]
  (get-in card [:visualization_settings :graph.series_labels]
          (map (comp capitalize-first names/metric-name)
               (get-in card [:dataset_query :query :aggregation]))))
(defn- unroll-multiseries
  [card]
  (if (and (multiseries? card)
           (-> card :display (= :line)))
    (for [[aggregation label] (map vector
                                   (get-in card [:dataset_query :query :aggregation])
                                   (series-labels card))]
      (-> card
          (assoc-in [:dataset_query :query :aggregation] [aggregation])
          (assoc :name label)
          (m/dissoc-in [:visualization_settings :graph.series_labels])))
    [card]))
(defn- segment-constituents
  [segment]
  (->> (filters/inject-refinement (:query-filter segment) (:cell-query segment))
       magic.util/collect-field-references
       (map magic.util/field-reference->id)
       distinct
       (map (partial magic.util/->field segment))))
(defn- update-related
  [related left right]
  (-> related
      (update :related (comp distinct conj) (-> right :entity ->related-entity))
      (assoc :compare (concat
                       (for [segment (->> left :entity related/related :segments (map ->root))
                             :when (not= segment right)]
                         {:url         (str (:url left) "/compare/segment/"
                                            (-> segment :entity u/the-id))
                          :title       (tru "Compare with {0}" (:comparison-name segment))
                          :description })
                       (when (and ((some-fn :query-filter :cell-query) left)
                                  (not= (:source left) (:entity right)))
                         [{:url         (if (->> left :source (mi/instance-of? Table))
                                          (str (:url left) "/compare/table/"
                                               (-> left :source u/the-id))
                                          (str (:url left) "/compare/adhoc/"
                                               (magic.util/encode-base64-json
                                                {:database (:database left)
                                                 :type     :query
                                                 :query    {:source-table (->> left
                                                                               :source
                                                                               u/the-id
                                                                               (str "card__"))}})))
                           :title       (tru "Compare with entire dataset")
                           :description }])))
      (as-> related
          (if (-> related :compare empty?)
            (dissoc related :compare)
            related))))
(defn- part-vs-whole-comparison?
  [left right]
  (and ((some-fn :cell-query :query-filter) left)
       (not ((some-fn :cell-query :query-filter) right))))

Create a comparison dashboard based on dashboard dashboard comparing subsets of the dataset defined by segments left and right.

(defn comparison-dashboard
  [dashboard left right opts]
  (let [left               (-> left
                               ->root
                               (merge (:left opts)))
        right              (-> right
                               ->root
                               (merge (:right opts)))
        left               (cond-> left
                             (-> opts :left :cell-query)
                             (assoc :comparison-name (->> opts
                                                          :left
                                                          :cell-query
                                                          (names/cell-title left))))
        right              (cond-> right
                             (part-vs-whole-comparison? left right)
                             (assoc :comparison-name (condp mi/instance-of? (:entity right)
                                                       Table
                                                       (tru "All {0}" (:short-name right))
                                                       (tru "{0}, all {1}"
                                                            (comparison-name right)
                                                            (names/source-name right)))))
        segment-dashboards (->> (concat (segment-constituents left)
                                        (segment-constituents right))
                                distinct
                                (map #(automagic-analysis % {:source       (:source left)
                                                             :rules-prefix ["comparison"]})))]
    (assert (or (= (:source left) (:source right))
                (= (-> left :source :table_id) (-> right :source u/the-id))))
    (->> (concat segment-dashboards [dashboard])
         (reduce (fn [dashboard-1 dashboard-2]
                   (if dashboard-1
                     (populate/merge-dashboards dashboard-1 dashboard-2 {:skip-titles? true})
                     dashboard-2))
                 nil)
         dashboard->cards
         (m/distinct-by (some-fn :dataset_query hash))
         (transduce (mapcat unroll-multiseries)
                    (fn
                      ([]
                       (let [title (tru "Comparison of {0} and {1}"
                                        (comparison-name left)
                                        (comparison-name right))]
                         (-> {:name              title
                              :transient_name    title
                              :transient_filters nil
                              :param_fields      nil
                              :description       (tru "Automatically generated comparison dashboard comparing {0} and {1}"
                                                      (comparison-name left)
                                                      (comparison-name right))
                              :creator_id        api/*current-user-id*
                              :parameters        []
                              :related           (update-related (:related dashboard) left right)}
                             (add-title-row left right))))
                      ([[dashboard _row]] dashboard)
                      ([[dashboard row] card]
                       [(comparison-row dashboard row left right card)
                        (+ row (:height card))]))))))
 

Automatically generate questions and dashboards based on predefined heuristics.

There are two key inputs to this algorithm: - An entity to generate the dashboard for. The primary data needed from this entity is: - The entity type itself - The field information, especially the metadata about these fields - A set of potential dashboard templates from which a dashboard can be realized based on the entity and field data

The first step in the base automagic-dashboard is to select dashboard templates that match the entity type of the entity to be x-rayed. A simple entity might match only to a GenericTable template while a more complicated entity might match to a TransactionTable or EventTable template.

Once potential templates are selected, the following process is attempted for each template in order of most specialized template to least: - Determine which entity fields map to dimensions and metrics described in the template. - Match these selected dimensions and metrics to required dimensions and metrics for cards specified in the template. - If any cards match, we successfully return a dashboard generated with the created cards.

The following example is provided to better illustrate the template process and how dimensions and metrics work.

This is a notional dashboard template:

                        Card 1: You have N Items!

        Card 2:                      Card 3:                       Card 4:
  Avg Income over Time        Total Income per Category            X vs. Y
             ___
Avg  |    __/                  Total | #     #                 | *    *      *

Income | __/ Income | # # # X | * |/ | # # # # | * * * +---------- +----------- +----------------- Time Category Y

Key things to note: - Each dimension in a card is specified by name. - There are 5 dimensions across all cards: - Income - Time - Category - X - Y - There are 3 metrics: - Count (N Items) - Avg Income - Total Income - Each metric is a computed value based on 0 or more dimensions, also specified by name. - Count is dimensionless - Avg and Total require the Income dimensions - Not shown, but a card such as "Sales by Location" could require 3 dimensions: - Total of the Sales dimension - Longitude and Latitude dimensions - A metric can also have multiple dimensions with its calculated value, such as the quotient of 2 dimensions. - Not described here are filters, which have the same nominal syntax for referencing dimensions as cards and metrics.

Dimensions are the key Lego™ brick for all of the above and are specified as a named element with specialization based on entity and field semantic types as well as a score.

For example, Income could have the following potential matches to underlying fields: - A field from a Sales table with semantic type :type/Income and score of 100 - A field from an unspecified table with semantic type :type/Income and score of 90 - A field from a Sales table with semantic type :type/Number and score of 50

When matched with actual fields from an x-rayed entity, the highest matching field is selected to be "bound" to the Income dimensions. Suppose you have an entity of type SalesTable and fields of INCOME (semantic type Income), TAX (type Float), and TOTAL (Float). In this case, the INCOME field would match best (score 100) and be bound to the Income dimension.

The other specified dimensions will have similar matching rules. Note that X & Y are, like all other dimensions, named dimensions. In our above example the Income dimension matched to the INCOME field of type :type/Income. This happens to be well-aligned data. X and Y might look like: - X is a field from the Sales table of type :type/Decimal - Y is a field from the Sales table of type :type/Decimal So long as two fields match the above criteria (decimal types (including descendants) and from a Sales table), they can be bound to the X and Y dimensions. They could be, for example, TAX and TOTAL.

The above example, starting from the dashboard template, works backwards from the actual x-ray generation algorithm but should provide clarity as to the terminology and how everything fits together.

In practice, we gather the entity data (including fields), the dashboard templates, attempt to bind dimensions to fields specified in the template, then build metrics, filters, and finally cards based on the bound dimensions.

(ns metabase.automagic-dashboards.core
  (:require
   [clojure.set :as set]
   [clojure.string :as str]
   [clojure.walk :as walk]
   [kixi.stats.core :as stats]
   [kixi.stats.math :as math]
   [medley.core :as m]
   [metabase.automagic-dashboards.combination :as combination]
   [metabase.automagic-dashboards.dashboard-templates :as dashboard-templates]
   [metabase.automagic-dashboards.filters :as filters]
   [metabase.automagic-dashboards.interesting :as interesting]
   [metabase.automagic-dashboards.names :as names]
   [metabase.automagic-dashboards.populate :as populate]
   [metabase.automagic-dashboards.util :as magic.util]
   [metabase.db.query :as mdb.query]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.models.card :refer [Card]]
   [metabase.models.database :refer [Database]]
   [metabase.models.field :as field :refer [Field]]
   [metabase.models.interface :as mi]
   [metabase.models.metric :refer [Metric]]
   [metabase.models.query :refer [Query]]
   [metabase.models.segment :refer [Segment]]
   [metabase.models.table :refer [Table]]
   [metabase.query-processor.util :as qp.util]
   [metabase.related :as related]
   [metabase.sync.analyze.classify :as classify]
   [metabase.util :as u]
   [metabase.util.i18n :as i18n :refer [tru trun]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [schema.core :as s]
   [toucan2.core :as t2]))
(def ^:private public-endpoint "/auto/dashboard/")
(def ^:private ^{:arglists '([field])} id-or-name
  (some-fn :id :name))

Get user-defined metrics linked to a given entity.

(defmulti
  ^{:doc      
    :arglists '([entity])}
  linked-metrics mi/model)
(defmethod linked-metrics :model/Metric [{metric-name :name :keys [definition]}]
  [{:metric-name       metric-name
    :metric-title      metric-name
    :metric-definition definition
    :metric-score      100}])
(defmethod linked-metrics :model/Table [{table-id :id}]
  (mapcat
   linked-metrics
   (t2/select :model/Metric :table_id table-id)))
(defmethod linked-metrics :default [_] [])

root is a datatype that is an entity augmented with metadata for the purposes of creating an automatic dashboard with respect to that entity. It is called a root because the automated dashboard uses productions to recursively create a tree of dashboard cards to fill the dashboards. This multimethod is for turning a given entity into a root.

(defmulti ->root
  {:arglists '([entity])}
  mi/model)
(defmethod ->root Table
  [table]
  {:entity                     table
   :full-name                  (:display_name table)
   :short-name                 (:display_name table)
   :source                     table
   :database                   (:db_id table)
   :url                        (format "%stable/%s" public-endpoint (u/the-id table))
   :dashboard-templates-prefix ["table"]
   :linked-metrics             (linked-metrics table)})
(defmethod ->root Segment
  [segment]
  (let [table (->> segment :table_id (t2/select-one Table :id))]
    {:entity                     segment
     :full-name                  (tru "{0} in the {1} segment" (:display_name table) (:name segment))
     :short-name                 (:display_name table)
     :comparison-name            (tru "{0} segment" (:name segment))
     :source                     table
     :database                   (:db_id table)
     :query-filter               [:segment (u/the-id segment)]
     :url                        (format "%ssegment/%s" public-endpoint (u/the-id segment))
     :dashboard-templates-prefix ["table"]}))
(defmethod ->root Metric
  [metric]
  (let [table (->> metric :table_id (t2/select-one Table :id))]
    {:entity                     metric
     :full-name                  (if (:id metric)
                                   (trun "{0} metric" "{0} metrics" (:name metric))
                                   (:name metric))
     :short-name                 (:name metric)
     :source                     table
     :database                   (:db_id table)
     ;; We use :id here as it might not be a concrete field but rather one from a nested query which
     ;; does not have an ID.
     :url                        (format "%smetric/%s" public-endpoint (:id metric))
     :dashboard-templates-prefix ["metric"]}))
(defmethod ->root Field
  [field]
  (let [table (field/table field)]
    {:entity                     field
     :full-name                  (trun "{0} field" "{0} fields" (:display_name field))
     :short-name                 (:display_name field)
     :source                     table
     :database                   (:db_id table)
     ;; We use :id here as it might not be a concrete metric but rather one from a nested query
     ;; which does not have an ID.
     :url                        (format "%sfield/%s" public-endpoint (:id field))
     :dashboard-templates-prefix ["field"]}))

Is this card or question derived from another model or question?

(def ^:private ^{:arglists '([card-or-question])} nested-query?
  (comp some? qp.util/query->source-card-id :dataset_query))

Is this card or question native (SQL)?

(def ^:private ^{:arglists '([card-or-question])} native-query?
  (comp some? #{:native} qp.util/normalize-token #(get-in % [:dataset_query :type])))
(defn- source-question
  [card-or-question]
  (when-let [source-card-id (qp.util/query->source-card-id (:dataset_query card-or-question))]
    (t2/select-one Card :id source-card-id)))
(defn- table-like?
  [card-or-question]
  (nil? (get-in card-or-question [:dataset_query :query :aggregation])))

Get the Table ID from card-or-question, which can be either a Card from the DB (which has a :table_id property) or an ad-hoc query (referred to as a 'question' in this namespace) created with the metabase.models.query/adhoc-query function, which has a :table-id property.

(defn- table-id
  ;; TODO - probably better if we just changed `adhoc-query` to use the same keys as Cards (e.g. `:table_id`) so we
  ;; didn't need this function, seems like something that would be too easy to forget
  [card-or-question]
  (or (:table_id card-or-question)
      (:table-id card-or-question)))
(defn- source
  [card]
  (cond
    ;; This is a model
    (:dataset card) (assoc card :entity_type :entity/GenericTable)
    ;; This is a query based on a query. Eventually we will want to change this as it suffers from the same sourcing
    ;; problems as other cards -- The x-ray is not done on the card, but on its source.
    (nested-query? card) (-> card
                             source-question
                             (assoc :entity_type :entity/GenericTable))
    (native-query? card) (-> card (assoc :entity_type :entity/GenericTable))
    :else                (->> card table-id (t2/select-one Table :id))))
(defmethod ->root Card
  [card]
  (let [{:keys [dataset] :as source} (source card)]
    {:entity                     card
     :source                     source
     :database                   (:database_id card)
     :query-filter               (get-in card [:dataset_query :query :filter])
     :full-name                  (tru "\"{0}\"" (:name card))
     :short-name                 (names/source-name {:source source})
     :url                        (format "%s%s/%s" public-endpoint (if dataset "model" "question") (u/the-id card))
     :dashboard-templates-prefix [(if (table-like? card)
                                    "table"
                                    "question")]}))
(defmethod ->root Query
  [query]
  (let [source (source query)]
    {:entity                     query
     :source                     source
     :database                   (:database-id query)
     :query-filter               (get-in query [:dataset_query :query :filter])
     :full-name                  (cond
                                   (native-query? query) (tru "Native query")
                                   (table-like? query) (-> source ->root :full-name)
                                   :else (names/question-description {:source source} query))
     :short-name                 (names/source-name {:source source})
     :url                        (format "%sadhoc/%s" public-endpoint
                                         (magic.util/encode-base64-json (:dataset_query query)))
     :dashboard-templates-prefix [(if (table-like? query)
                                    "table"
                                    "question")]}))

NOTE - This has been lifted to foo. Nuke it here as well.

(defn- fill-templates
  [template-type {:keys [root tables]} bindings s]
  (let [bindings (some-fn (merge {"this" (-> root
                                             :entity
                                             (assoc :full-name (:full-name root)))}
                                 bindings)
                          (comp first #(magic.util/filter-tables % tables) dashboard-templates/->entity)
                          identity)]
    (str/replace s #"\[\[(\w+)(?:\.([\w\-]+))?\]\]"
                 (fn [[_ identifier attribute]]
                   (let [entity    (bindings identifier)
                         attribute (some-> attribute qp.util/normalize-token)]
                     (str (or (and (ifn? entity) (entity attribute))
                              (root attribute)
                              (interesting/->reference template-type entity))))))))
(defn- instantiate-visualization
  [[k v] dimensions metrics]
  (let [dimension->name (comp vector :name dimensions)
        metric->name    (comp vector first :metric metrics)]
    [k (-> v
           (m/update-existing :map.latitude_column dimension->name)
           (m/update-existing :map.longitude_column dimension->name)
           (m/update-existing :graph.metrics metric->name)
           (m/update-existing :graph.dimensions dimension->name))]))

Capitalize only the first letter in a given string.

(defn capitalize-first
  [s]
  (let [s (str s)]
    (str (u/upper-case-en (subs s 0 1)) (subs s 1))))
(defn- instantiate-metadata
  [x context available-metrics bindings]
  (-> (walk/postwalk
       (fn [form]
         (if (i18n/localized-string? form)
           (let [s     (str form)
                 new-s (fill-templates :string context bindings s)]
             (if (not= new-s s)
               (capitalize-first new-s)
               s))
           form))
       x)
      (m/update-existing :visualization #(instantiate-visualization % bindings available-metrics))))

Return the set of ids referenced in a cell query

(defn- singular-cell-dimension-field-ids
  [{:keys [cell-query]}]
  (letfn [(collect-dimensions [[op & args]]
            (case (some-> op qp.util/normalize-token)
              :and (mapcat collect-dimensions args)
              :=   (magic.util/collect-field-references args)
              nil))]
    (->> cell-query
         collect-dimensions
         (map magic.util/field-reference->id)
         set)))

Return matching dashboard templates ordered by specificity. Most specific is defined as entity type specification the longest ancestor chain.

(defn- matching-dashboard-templates
  [dashboard-templates {:keys [source entity]}]
  ;; Should this be here or lifted to the calling context. It's a magic step.
  (let [table-type (or (:entity_type source) :entity/GenericTable)]
    (->> dashboard-templates
         (filter (fn [{:keys [applies_to]}]
                   (let [[entity-type field-type] applies_to]
                     (and (isa? table-type entity-type)
                          (or (nil? field-type)
                              (magic.util/field-isa? entity field-type))))))
         (sort-by :specificity >))))

Return all tables accessible from a given table with the paths to get there. If there are multiple FKs pointing to the same table, multiple entries will be returned.

(defn- linked-tables
  [table]
  (for [{:keys [id target]} (field/with-targets
                              (t2/select Field
                                         :table_id           (u/the-id table)
                                         :fk_target_field_id [:not= nil]
                                         :active             true))
        :when (some-> target mi/can-read?)]
    (-> target field/table (assoc :link id))))
(def ^:private ^{:arglists '([source])} source->db
  (comp (partial t2/select-one Database :id) (some-fn :db_id :database_id)))

Source fields from tables that are applicable to the entity being x-rayed.

(defn- relevant-fields
  [{:keys [source _entity] :as _root} tables]
  (let [db (source->db source)]
    (if (mi/instance-of? Table source)
      (comp (->> (t2/select Field
                            :table_id [:in (map u/the-id tables)]
                            :visibility_type "normal"
                            :preview_display true
                            :active true)
                 field/with-targets
                 (map #(assoc % :db db))
                 (group-by :table_id))
            u/the-id)
      (let [source-fields (->> source
                               :result_metadata
                               (map (fn [field]
                                      (as-> field field
                                        (update field :base_type keyword)
                                        (update field :semantic_type keyword)
                                        (mi/instance Field field)
                                        (classify/run-classifiers field {})
                                        (assoc field :db db)))))]
        (constantly source-fields)))))

Create the underlying context to which we will add metrics, dimensions, and filters.

This is applicable to all dashboard templates.

(s/defn ^:private make-base-context
  [{:keys [source] :as root}]
  {:pre [source]}
  (let [tables        (concat [source] (when (mi/instance-of? Table source)
                                         (linked-tables source)))
        table->fields (relevant-fields root tables)]
    {:source       (assoc source :fields (table->fields source))
     :root         root
     :tables       (map #(assoc % :fields (table->fields %)) tables)
     :query-filter (filters/inject-refinement (:query-filter root)
                                              (:cell-query root))}))
(defn- make-dashboard
  ([root dashboard-template]
   (make-dashboard root dashboard-template {:tables [(:source root)] :root root} nil))
  ([root dashboard-template context {:keys [available-metrics]}]
   (-> dashboard-template
       (select-keys [:title :description :transient_title :groups])
       (cond->
         (:comparison? root)
         (update :groups (partial m/map-vals (fn [{:keys [title comparison_title] :as group}]
                                               (assoc group :title (or comparison_title title))))))
       (instantiate-metadata context available-metrics {}))))

Generate a map of satisfiable affinity sets (sets of dimensions that belong together) to visualization types that would be appropriate for each affinity set.

(defn affinities->viz-types
  [normalized-card-templates ground-dimensions]
  (reduce (partial merge-with set/union)
          {}
          (for [{:keys [dimensions visualization]} normalized-card-templates
                :let [dim-set (into #{} (map ffirst) dimensions)]
                :when (every? ground-dimensions dim-set)]
            {dim-set #{visualization}})))

Create a dashboard group for each user-defined metric.

(defn user-defined-groups
  [linked-metrics]
  (zipmap (map :metric-name linked-metrics)
          (map (fn [{:keys [metric-name]}]
                 {:title (format "Your %s Metric" metric-name)
                  :score 0}) linked-metrics)))

Produce card templates for user-defined metrics. The basic algorithm is to generate the cross product of all user defined metrics to all provided dimension affinities to all potential visualization options for these affinities.

(defn user-defined-metrics->card-templates
  [affinities->viz-types user-defined-metrics]
  (let [found-summary? (volatile! false)
        summary-viz-types #{["scalar" {}] ["smartscalar" {}]}]
    (for [[dimension-affinities viz-types] affinities->viz-types
          viz viz-types
          {:keys [metric-name] :as _user-defined-metric} user-defined-metrics
          :let [metric-title (if (seq dimension-affinities)
                               (format "%s by %s" metric-name
                                       (combination/items->str
                                        (map (fn [s] (format "[[%s]]" s)) (vec dimension-affinities))))
                               metric-name)
                group-name (if (and (not @found-summary?)
                                    (summary-viz-types viz))
                             (do (vreset! found-summary? true)
                                 "Overview")
                             metric-name)]]
      {:card-score    100
       :metrics       [metric-name]
       :dimensions    (mapv (fn [dim] {dim {}}) dimension-affinities)
       :visualization viz
       :width         6
       :title         (i18n/->UserLocalizedString metric-title nil {})
       :height        4
       :group         group-name
       :card-name     (format "Card[%s][%s]" metric-title (first viz))})))

Produce the "base" dashboard from the base context for an item and a dashboard template. This includes dashcards and global filters, but does not include related items and is not yet populated. Repeated calls of this might be generated (e.g. the main dashboard and related) then combined once using create dashboard.

(defn generate-base-dashboard
  [{{user-defined-metrics :linked-metrics :as root} :root :as base-context}
   {template-cards      :cards
    :keys               [dashboard_filters]
    :as                 dashboard-template}
   {grounded-dimensions :dimensions
    grounded-metrics    :metrics
    grounded-filters    :filters}]
  (let [card-templates                 (interesting/normalize-seq-of-maps :card template-cards)
        user-defined-card-templates    (user-defined-metrics->card-templates
                                        (affinities->viz-types card-templates grounded-dimensions)
                                        user-defined-metrics)
        all-cards                      (into card-templates user-defined-card-templates)
        dashcards                      (combination/grounded-metrics->dashcards
                                        base-context
                                        all-cards
                                        grounded-dimensions
                                        grounded-filters
                                        grounded-metrics)
        template-with-user-groups      (update dashboard-template
                                               :groups into (user-defined-groups user-defined-metrics))
        empty-dashboard                (make-dashboard root template-with-user-groups)]
    (assoc empty-dashboard
           ;; Adds the filters that show at the top of the dashboard
           ;; Why do we need (or do we) the last remove form?
           :filters (->> dashboard_filters
                         (mapcat (comp :matches grounded-dimensions))
                         (remove (comp (singular-cell-dimension-field-ids root) id-or-name)))
           :cards dashcards)))
(def ^:private ^:const ^Long max-related 8)
(def ^:private ^:const ^Long max-cards 15)

Turn entity into an entry in :related.

(defn ->related-entity
  [entity]
  (let [{:keys [dashboard-templates-prefix] :as root} (->root entity)
        candidate-templates (dashboard-templates/get-dashboard-templates dashboard-templates-prefix)
        dashboard-template  (->> root
                                 (matching-dashboard-templates candidate-templates)
                                 first)
        dashboard           (make-dashboard root dashboard-template)]
    {:url         (:url root)
     :title       (:full-name root)
     :description (:description dashboard)}))
(defn- related-entities
  [root]
  (-> root
      :entity
      related/related
      (update :fields (partial remove magic.util/key-col?))
      (->> (m/map-vals (comp (partial map ->related-entity) u/one-or-many)))))
(s/defn ^:private indepth
  [{:keys [dashboard-templates-prefix url] :as root}
   {:keys [dashboard-template-name]} :- (s/maybe dashboard-templates/DashboardTemplate)]
  (let [base-context (make-base-context root)]
    (->> (dashboard-templates/get-dashboard-templates (concat dashboard-templates-prefix [dashboard-template-name]))
         (keep (fn [{indepth-template-name :dashboard-template-name
                     template-dimensions   :dimensions
                     template-metrics      :metrics
                     template-filters      :filters
                     :as                   indepth}]
                 (let [grounded-values (interesting/identify
                                         base-context
                                         {:dimension-specs template-dimensions
                                          :metric-specs    template-metrics
                                          :filter-specs    template-filters})
                       {:keys [description cards] :as dashboard} (generate-base-dashboard
                                                                   base-context
                                                                   indepth
                                                                   grounded-values)]
                   (when (and description (seq cards))
                     {:title       ((some-fn :short-title :title) dashboard)
                      :description description
                      :url         (format "%s/rule/%s/%s" url dashboard-template-name indepth-template-name)}))))
         (hash-map :indepth))))
(defn- drilldown-fields
  [root available-dimensions]
  (when (and (->> root :source (mi/instance-of? Table))
             (-> root :entity magic.util/ga-table? not))
    (->> available-dimensions
         vals
         (mapcat :matches)
         (filter mi/can-read?)
         filters/interesting-fields
         (map ->related-entity)
         (hash-map :drilldown-fields))))
(defn- comparisons
  [root]
  {:compare (concat
             (for [segment (->> root :entity related/related :segments (map ->root))]
               {:url         (str (:url root) "/compare/segment/" (-> segment :entity u/the-id))
                :title       (tru "Compare with {0}" (:comparison-name segment))
                :description })
             (when ((some-fn :query-filter :cell-query) root)
               [{:url         (if (->> root :source (mi/instance-of? Table))
                                (str (:url root) "/compare/table/" (-> root :source u/the-id))
                                (str (:url root) "/compare/adhoc/"
                                     (magic.util/encode-base64-json
                                      {:database (:database root)
                                       :type     :query
                                       :query    {:source-table (->> root
                                                                     :source
                                                                     u/the-id
                                                                     (str "card__"))}})))
                 :title       (tru "Compare with entire dataset")
                 :description }]))})

We fill available slots round-robin style. Each selector is a list of fns that are tried against related in sequence until one matches.

(defn- fill-related
  [available-slots selectors related]
  (let [pop-first         (fn [m ks]
                            (loop [[k & ks] ks]
                              (let [item (-> k m first)]
                                (cond
                                  item        [item (update m k rest)]
                                  (empty? ks) [nil m]
                                  :else       (recur ks)))))
        count-leafs        (comp count (partial mapcat val))
        [selected related] (reduce-kv
                            (fn [[selected related] k v]
                              (loop [[selector & remaining-selectors] v
                                     related                          related
                                     selected                         selected]
                                (let [[next related] (pop-first related (mapcat shuffle selector))
                                      num-selected   (count-leafs selected)]
                                  (cond
                                    (= num-selected available-slots)
                                    (reduced [selected related])
                                    next
                                    (recur remaining-selectors related (update selected k conj next))
                                    (empty? remaining-selectors)
                                    [selected related]
                                    :else
                                    (recur remaining-selectors related selected)))))
                            [{} related]
                            selectors)
        num-selected (count-leafs selected)]
    (if (pos? num-selected)
      (merge-with concat
        selected
        (fill-related (- available-slots num-selected) selectors related))
      {})))
(def ^:private related-selectors
  {Table   (let [down     [[:indepth] [:segments :metrics] [:drilldown-fields]]
                 sideways [[:linking-to :linked-from] [:tables]]
                 compare  [[:compare]]]
             {:zoom-in [down down down down]
              :related [sideways sideways]
              :compare [compare compare]})
   Segment (let [down     [[:indepth] [:segments :metrics] [:drilldown-fields]]
                 sideways [[:linking-to] [:tables]]
                 up       [[:table]]
                 compare  [[:compare]]]
             {:zoom-in  [down down down]
              :zoom-out [up]
              :related  [sideways sideways]
              :compare  [compare compare]})
   Metric  (let [down     [[:drilldown-fields]]
                 sideways [[:metrics :segments]]
                 up       [[:table]]
                 compare  [[:compare]]]
             {:zoom-in  [down down]
              :zoom-out [up]
              :related  [sideways sideways sideways]
              :compare  [compare compare]})
   Field   (let [sideways [[:fields]]
                 up       [[:table] [:metrics :segments]]
                 compare  [[:compare]]]
             {:zoom-out [up]
              :related  [sideways sideways]
              :compare  [compare]})
   Card    (let [down     [[:drilldown-fields]]
                 sideways [[:metrics] [:similar-questions :dashboard-mates]]
                 up       [[:table]]
                 compare  [[:compare]]]
             {:zoom-in  [down down]
              :zoom-out [up]
              :related  [sideways sideways sideways]
              :compare  [compare compare]})
   Query   (let [down     [[:drilldown-fields]]
                 sideways [[:metrics] [:similar-questions]]
                 up       [[:table]]
                 compare  [[:compare]]]
             {:zoom-in  [down down]
              :zoom-out [up]
              :related  [sideways sideways sideways]
              :compare  [compare compare]})})

Build a balanced list of related X-rays. General composition of the list is determined for each root type individually via related-selectors. That recipe is then filled round-robin style.

(s/defn ^:private related
  [root
   available-dimensions
   dashboard-template :- (s/maybe dashboard-templates/DashboardTemplate)]
  (->> (merge (indepth root dashboard-template)
              (drilldown-fields root available-dimensions)
              (related-entities root)
              (comparisons root))
       (fill-related max-related (get related-selectors (-> root :entity mi/model)))))

Return a map of fields referenced in filter clause.

(defn- filter-referenced-fields
  [root filter-clause]
  (->> filter-clause
       magic.util/collect-field-references
       (map (fn [[_ id-or-name _options]]
              [id-or-name (magic.util/->field root id-or-name)]))
       (remove (comp nil? second))
       (into {})))

Produce a fully-populated dashboard from the base context for an item and a dashboard template.

(defn generate-dashboard
  [{{:keys [show url query-filter] :as root} :root :as base-context}
   {:as dashboard-template}
   {grounded-dimensions :dimensions :as grounded-values}]
  (let [show      (or show max-cards)
        dashboard (generate-base-dashboard base-context dashboard-template grounded-values)]
    (-> dashboard
        (populate/create-dashboard show)
        (assoc
          :related (related
                     root grounded-dimensions
                     dashboard-template)
          :more (when (and (not= show :all)
                           (-> dashboard :cards count (> show)))
                  (format "%s#show=all" url))
          :transient_filters query-filter
          :param_fields (filter-referenced-fields root query-filter)
          :auto_apply_filters true))))

Create dashboards for table root using the best matching heuristics.

(defn- automagic-dashboard
  [{:keys [dashboard-template dashboard-templates-prefix] :as root}]
  (let [base-context    (make-base-context root)
        {template-dimensions :dimensions
         template-metrics    :metrics
         template-filters    :filters
         :as                 template} (if dashboard-template
                                         (dashboard-templates/get-dashboard-template dashboard-template)
                                         (first (matching-dashboard-templates
                                                  (dashboard-templates/get-dashboard-templates dashboard-templates-prefix)
                                                  root)))
        grounded-values (interesting/identify
                          base-context
                          {:dimension-specs template-dimensions
                           :metric-specs    template-metrics
                           :filter-specs    template-filters})]
    (generate-dashboard base-context template grounded-values)))

Create a transient dashboard analyzing given entity.

(defmulti automagic-analysis
  {:arglists '([entity opts])}
  (fn [entity _]
    (mi/model entity)))
(defmethod automagic-analysis Table
  [table opts]
  (automagic-dashboard (merge (->root table) opts)))
(defmethod automagic-analysis Segment
  [segment opts]
  (automagic-dashboard (merge (->root segment) opts)))
(defmethod automagic-analysis Metric
  [metric opts]
  (automagic-dashboard (merge (->root metric) opts)))
(mu/defn ^:private collect-metrics :- [:maybe [:sequential (ms/InstanceOf Metric)]]
  [root question]
  (map (fn [aggregation-clause]
         (if (-> aggregation-clause
                 first
                 qp.util/normalize-token
                 (= :metric))
           (->> aggregation-clause second (t2/select-one Metric :id))
           (let [table-id (table-id question)]
             (mi/instance Metric {:definition {:aggregation  [aggregation-clause]
                                               :source-table table-id}
                                  :name       (names/metric->description root aggregation-clause)
                                  :table_id   table-id}))))
       (get-in question [:dataset_query :query :aggregation])))
(mu/defn ^:private collect-breakout-fields :- [:maybe [:sequential (ms/InstanceOf Field)]]
  [root question]
  (for [breakout     (get-in question [:dataset_query :query :breakout])
        field-clause (take 1 (magic.util/collect-field-references breakout))
        :let         [field (magic.util/->field root field-clause)]
        :when        field]
    field))
(defn- decompose-question
  [root question opts]
  (letfn [(analyze [x]
            (try
              (automagic-analysis x (assoc opts
                                           :source       (:source root)
                                           :query-filter (:query-filter root)
                                           :database     (:database root)))
              (catch Throwable e
                (throw (ex-info (tru "Error decomposing question: {0}" (ex-message e))
                                {:root root, :question question, :object x}
                                e)))))]
    (into []
          (comp cat (map analyze))
          [(collect-metrics root question)
           (collect-breakout-fields root question)])))

Ensure that elements of an original dataset query are preserved in dashcard queries.

(defn- preserve-entity-element
  [dashboard entity entity-element]
  (if-let [element-value (get-in entity [:dataset_query :query entity-element])]
    (letfn [(splice-element [dashcard]
              (cond-> dashcard
                (get-in dashcard [:card :dataset_query :query])
                (update-in [:card :dataset_query :query entity-element]
                           (fnil into (empty element-value))
                           element-value)))]
      (update dashboard :dashcards (partial map splice-element)))
    dashboard))
(defn- query-based-analysis
  [{:keys [entity] :as root} opts {:keys [cell-query cell-url]}]
  (let [transient-dash (if (table-like? entity)
                         (let [root' (merge root
                                            (when cell-query
                                              {:url                        cell-url
                                               :entity                     (:source root)
                                               :dashboard-templates-prefix ["table"]})
                                            opts)]
                           (automagic-dashboard root'))
                         (let [opts      (assoc opts :show :all)
                               root'     (merge root
                                                (when cell-query
                                                  {:url cell-url})
                                                opts)
                               base-dash (automagic-dashboard root')
                               dash      (reduce populate/merge-dashboards
                                                 base-dash
                                                 (decompose-question root entity opts))]
                           (merge dash
                                  (when cell-query
                                    (let [title (tru "A closer look at {0}" (names/cell-title root cell-query))]
                                      {:transient_name title
                                       :name           title})))))]
    (-> transient-dash
        (preserve-entity-element (:entity root) :joins)
        (preserve-entity-element (:entity root) :expressions))))
(defmethod automagic-analysis Card
  [card {:keys [cell-query] :as opts}]
  (let [root     (->root card)
        cell-url (format "%squestion/%s/cell/%s" public-endpoint
                         (u/the-id card)
                         (magic.util/encode-base64-json cell-query))]
    (query-based-analysis root opts
                          (when cell-query
                            {:cell-query cell-query
                             :cell-url   cell-url}))))
(defmethod automagic-analysis Query
  [query {:keys [cell-query] :as opts}]
  (let [root       (->root query)
        cell-query (when cell-query (mbql.normalize/normalize-fragment [:query :filter] cell-query))
        opts       (cond-> opts
                     cell-query (assoc :cell-query cell-query))
        cell-url   (format "%sadhoc/%s/cell/%s" public-endpoint
                           (magic.util/encode-base64-json (:dataset_query query))
                           (magic.util/encode-base64-json cell-query))]
    (query-based-analysis root opts
                          (when cell-query
                            {:cell-query cell-query
                             :cell-url   cell-url}))))
(defmethod automagic-analysis Field
  [field opts]
  (automagic-dashboard (merge (->root field) opts)))

Add a stats field to each provided table with the following data: - num-fields: The number of Fields in each table - list-like?: Is this field 'list like' - link-table?: Is every Field a foreign key to another table

(defn- enhance-table-stats
  [tables]
  (when (not-empty tables)
    (let [field-count (->> (mdb.query/query {:select   [:table_id [:%count.* "count"]]
                                             :from     [:metabase_field]
                                             :where    [:and [:in :table_id (map u/the-id tables)]
                                                        [:= :active true]]
                                             :group-by [:table_id]})
                           (into {} (map (juxt :table_id :count))))
          list-like?  (->> (when-let [candidates (->> field-count
                                                      (filter (comp (partial >= 2) val))
                                                      (map key)
                                                      not-empty)]
                             (mdb.query/query {:select   [:table_id]
                                               :from     [:metabase_field]
                                               :where    [:and [:in :table_id candidates]
                                                          [:= :active true]
                                                          [:or [:not= :semantic_type "type/PK"]
                                                           [:= :semantic_type nil]]]
                                               :group-by [:table_id]
                                               :having   [:= :%count.* 1]}))
                           (into #{} (map :table_id)))
          ;; Table comprised entierly of join keys
          link-table? (when (seq field-count)
                        (->> (mdb.query/query {:select   [:table_id [:%count.* "count"]]
                                               :from     [:metabase_field]
                                               :where    [:and [:in :table_id (keys field-count)]
                                                          [:= :active true]
                                                          [:in :semantic_type ["type/PK" "type/FK"]]]
                                               :group-by [:table_id]})
                             (filter (fn [{:keys [table_id count]}]
                                       (= count (field-count table_id))))
                             (into #{} (map :table_id))))]
      (for [table tables]
        (let [table-id (u/the-id table)]
          (assoc table :stats {:num-fields  (field-count table-id 0)
                               :list-like?  (boolean (contains? list-like? table-id))
                               :link-table? (boolean (contains? link-table? table-id))}))))))

Maximal number of tables per schema shown in candidate-tables.

(def ^:private ^:const ^Long max-candidate-tables
  10)

Return a list of tables in database with ID database-id for which it makes sense to generate an automagic dashboard. Results are grouped by schema and ranked acording to interestingness (both schemas and tables within each schema). Each schema contains up to max-candidate-tables tables.

Tables are ranked based on how specific dashboard template has been used, and the number of fields. Schemes are ranked based on the number of distinct entity types and the interestingness of tables they contain (see above).

(defn candidate-tables
  ([database] (candidate-tables database nil))
  ([database schema]
   (let [dashboard-templates (dashboard-templates/get-dashboard-templates ["table"])]
     (->> (apply t2/select [Table :id :schema :display_name :entity_type :db_id]
                 (cond-> [:db_id (u/the-id database)
                          :visibility_type nil
                          :active true]
                   schema (concat [:schema schema])))
          (filter mi/can-read?)
          enhance-table-stats
          (remove (comp (some-fn :link-table? (comp zero? :num-fields)) :stats))
          (map (fn [table]
                 (let [root      (->root table)
                       {:keys [dashboard-template-name]
                        :as   dashboard-template} (->> root
                                                       (matching-dashboard-templates dashboard-templates)
                                                       first)
                       dashboard (make-dashboard root dashboard-template)]
                   {:url                     (format "%stable/%s" public-endpoint (u/the-id table))
                    :title                   (:short-name root)
                    :score                   (+ (math/sq (:specificity dashboard-template))
                                                (math/log (-> table :stats :num-fields))
                                                (if (-> table :stats :list-like?)
                                                  -10
                                                  0))
                    :description             (:description dashboard)
                    :table                   table
                    :dashboard-template-name dashboard-template-name})))
          (group-by (comp :schema :table))
          (map (fn [[schema tables]]
                 (let [tables (->> tables
                                   (sort-by :score >)
                                   (take max-candidate-tables))]
                   {:id     (format "%s/%s" (u/the-id database) schema)
                    :tables tables
                    :schema schema
                    :score  (+ (math/sq (transduce (m/distinct-by :dashboard-template-name)
                                                   stats/count
                                                   tables))
                               (math/sqrt (transduce (map (comp math/sq :score))
                                                     stats/mean
                                                     tables)))})))
          (sort-by :score >)))))
 

Validation, transformation to canonical form, and loading of heuristics.

(ns metabase.automagic-dashboards.dashboard-templates
  (:gen-class)
  (:require
   [clojure.set :as set]
   [clojure.string :as str]
   [metabase.automagic-dashboards.populate :as populate]
   [metabase.query-processor.util :as qp.util]
   [metabase.util :as u]
   [metabase.util.files :as u.files]
   [metabase.util.i18n :as i18n :refer [deferred-trs LocalizedString]]
   #_{:clj-kondo/ignore [:deprecated-namespace]}
   [metabase.util.schema :as su]
   [metabase.util.yaml :as yaml]
   [schema.coerce :as sc]
   [schema.core :as s]
   [schema.spec.core :as spec])
  (:import
   (java.nio.file Files Path)))
(set! *warn-on-reflection* true)

Maximal (and default) value for heuristics scores.

(def ^Long ^:const max-score
  100)
(def ^:private Score (s/constrained s/Int #(<= 0 % max-score)
                                    (deferred-trs "0 <= score <= {0}" max-score)))
(def ^:private MBQL [s/Any])
(def ^:private Identifier s/Str)
(def ^:private Metric {Identifier {(s/required-key :metric) MBQL
                                   (s/required-key :score)  Score
                                   (s/optional-key :name)   LocalizedString}})
(def ^:private Filter {Identifier {(s/required-key :filter) MBQL
                                   (s/required-key :score)  Score}})

Does string t denote a Google Analytics dimension?

(defn ga-dimension?
  [t]
  (str/starts-with? t "ga:"))

Turn x into proper type name.

(defn ->type
  [x]
  (cond
    (keyword? x)      x
    (ga-dimension? x) x
    :else             (keyword "type" x)))

Turn x into proper entity name.

(defn ->entity
  [x]
  (cond
    (keyword? x)      x
    (ga-dimension? x) x
    :else             (keyword "entity" x)))
(defn- field-type?
  [t]
  (some
   (partial isa? t)
   [:type/* :Semantic/* :Relation/*]))
(defn- table-type?
  [t]
  (isa? t :entity/*))
(def ^:private TableType (s/constrained s/Keyword table-type?))
(def ^:private FieldType (s/cond-pre (s/constrained s/Str ga-dimension?)
                                     (s/constrained s/Keyword field-type?)))
(def ^:private AppliesTo (s/either [FieldType]
                                   [TableType]
                                   [(s/one TableType "table") FieldType]))
(def ^:private Dimension {Identifier {(s/required-key :field_type)      AppliesTo
                                      (s/required-key :score)           Score
                                      (s/optional-key :links_to)        TableType
                                      (s/optional-key :named)           s/Str
                                      (s/optional-key :max_cardinality) s/Int}})
(def ^:private OrderByPair {Identifier (s/enum "descending" "ascending")})
(def ^:private Visualization [(s/one s/Str "visualization") su/Map])
(def ^:private Width  (s/constrained s/Int #(<= 1 % populate/grid-width)
                                     (deferred-trs "1 <= width <= {0}" populate/grid-width)))
(def ^:private Height (s/constrained s/Int pos?))
(def ^:private CardDimension {Identifier {(s/optional-key :aggregation) s/Str}})
(def ^:private Card
  {Identifier {(s/required-key :title)         LocalizedString
               (s/required-key :card-score)    Score
               (s/optional-key :visualization) Visualization
               (s/optional-key :text)          LocalizedString
               (s/optional-key :dimensions)    [CardDimension]
               (s/optional-key :filters)       [s/Str]
               (s/optional-key :metrics)       [s/Str]
               (s/optional-key :limit)         su/IntGreaterThanZero
               (s/optional-key :order_by)      [OrderByPair]
               (s/optional-key :description)   LocalizedString
               (s/optional-key :query)         s/Str
               (s/optional-key :width)         Width
               (s/optional-key :height)        Height
               (s/optional-key :group)         s/Str
               (s/optional-key :y_label)       LocalizedString
               (s/optional-key :x_label)       LocalizedString
               (s/optional-key :series_labels) [LocalizedString]}})
(def ^:private Groups
  {Identifier {(s/required-key :title)            LocalizedString
               (s/required-key :score)            s/Int
               (s/optional-key :comparison_title) LocalizedString
               (s/optional-key :description)      LocalizedString}})

Return key in {key {}}.

(def ^{:arglists '([definition])} identifier
  (comp key first))
(def ^:private ^{:arglists '([definitions])} identifiers
  (partial into #{"this"} (map identifier)))
(defn- all-references
  [k cards]
  (mapcat (comp k val first) cards))
(def ^:private DimensionForm
  [(s/one (s/constrained (s/cond-pre s/Str s/Keyword) (comp #{:dimension} qp.util/normalize-token))
          "dimension")
   (s/one s/Str "identifier")
   su/Map])

Does form denote a dimension reference?

(def ^{:arglists '([form])} dimension-form?
  (complement (s/checker DimensionForm)))

Return all dimension references in form.

(defn collect-dimensions
  [form]
  (->> form
       (tree-seq (some-fn map? sequential?) identity)
       (mapcat (fn [subform]
                 (cond
                   (dimension-form? subform) [(second subform)]
                   (string? subform)         (->> subform
                                                  (re-seq #"\[\[(\w+)\]\]")
                                                  (map second)))))
       distinct))
(defn- valid-metrics-references?
  [{:keys [metrics cards]}]
  (every? (identifiers metrics) (all-references :metrics cards)))
(defn- valid-filters-references?
  [{:keys [filters cards]}]
  (every? (identifiers filters) (all-references :filters cards)))
(defn- valid-group-references?
  [{:keys [cards groups]}]
  (every? groups (keep (comp :group val first) cards)))
(defn- valid-order-by-references?
  [{:keys [dimensions metrics cards]}]
  (every? (comp (into (identifiers dimensions)
                      (identifiers metrics))
                identifier)
          (all-references :order_by cards)))
(defn- valid-dimension-references?
  [{:keys [dimensions] :as dashboard-template}]
  (every? (some-fn (identifiers dimensions) (comp table-type? ->entity))
          (collect-dimensions dashboard-template)))
(defn- valid-dashboard-filters-references?
  [{:keys [dimensions dashboard_filters]}]
  (every? (identifiers dimensions) dashboard_filters))
(defn- valid-breakout-dimension-references?
  [{:keys [cards dimensions]}]
  (->> cards
       (all-references :dimensions)
       (map identifier)
       (every? (identifiers dimensions))))
(defn- constrained-all
  [schema & constraints]
  (reduce (partial apply s/constrained)
          schema
          (partition 2 constraints)))

Specification defining an automagic dashboard.

(def DashboardTemplate
  (constrained-all
    {(s/required-key :title)                   LocalizedString
     (s/required-key :dashboard-template-name) s/Str
     (s/required-key :specificity)             s/Int
     (s/optional-key :cards)                   [Card]
     (s/optional-key :dimensions)              [Dimension]
     (s/optional-key :applies_to)              AppliesTo
     (s/optional-key :transient_title)         LocalizedString
     (s/optional-key :description)             LocalizedString
     (s/optional-key :metrics)                 [Metric]
     (s/optional-key :filters)                 [Filter]
     (s/optional-key :groups)                  Groups
     (s/optional-key :indepth)                 [s/Any]
     (s/optional-key :dashboard_filters)       [s/Str]}
    valid-metrics-references? (deferred-trs "Valid metrics references")
    valid-filters-references? (deferred-trs "Valid filters references")
    valid-group-references? (deferred-trs "Valid group references")
    valid-order-by-references? (deferred-trs "Valid order_by references")
    valid-dashboard-filters-references? (deferred-trs "Valid dashboard filters references")
    valid-dimension-references? (deferred-trs "Valid dimension references")
    valid-breakout-dimension-references? (deferred-trs "Valid card dimension references")))
(defn- with-defaults
  [defaults]
  (fn [x]
    (let [[identifier definition] (first x)]
      {identifier (merge defaults definition)})))

Expand definition of the form {identifier value} with regards to key k into {identifier {k value}}.

(defn- shorthand-definition
  [k]
  (fn [x]
    (let [[identifier definition] (first x)]
      (if (map? definition)
        x
        {identifier {k definition}}))))
(def ^:private dashboard-template-validator
  (sc/coercer!
    DashboardTemplate
    {[s/Str]         u/one-or-many
     [OrderByPair]   u/one-or-many
     OrderByPair     (fn [x]
                       (if (string? x)
                         {x "ascending"}
                         x))
     Visualization   (fn [x]
                       (if (string? x)
                         [x {}]
                         (first x)))
     Metric          (comp (with-defaults {:score max-score})
                           (shorthand-definition :metric))
     Dimension       (comp (with-defaults {:score max-score})
                           (shorthand-definition :field_type))
     Filter          (comp (with-defaults {:score max-score})
                           (shorthand-definition :filter))
     Card            (with-defaults {:card-score max-score
                                     :width      populate/default-card-width
                                     :height     populate/default-card-height})
     [CardDimension] u/one-or-many
     CardDimension   (fn [x]
                       (if (string? x)
                         {x {}}
                         x))
     TableType       ->entity
     FieldType       ->type
     Identifier      (fn [x]
                       (if (keyword? x)
                         (name x)
                         x))
     Groups          (partial apply merge)
     AppliesTo       (fn [x]
                       (let [[table-type field-type] (str/split x #"\.")]
                         (if field-type
                           [(->entity table-type) (->type field-type)]
                           [(if (-> table-type ->entity table-type?)
                              (->entity table-type)
                              (->type table-type))])))
     LocalizedString (fn [s]
                       (i18n/->UserLocalizedString s nil {}))}))
(def ^:private dashboard-templates-dir "automagic_dashboards/")
(def ^:private ^{:arglists '([f])} file->entity-type
  (comp (partial re-find #".+(?=\.yaml$)") str (memfn ^Path getFileName)))
(defn- specificity
  [dashboard-template]
  (transduce (map (comp count ancestors)) + (:applies_to dashboard-template)))
(defn- make-dashboard-template
  [entity-type {:keys [cards] :as r}]
  (-> (cond-> r
        (seq cards)
        (update :cards (partial mapv (fn [m] (update-vals m #(set/rename-keys % {:score :card-score}))))))
      (assoc :dashboard-template-name entity-type
             :specificity 0)
      (update :applies_to #(or % entity-type))
      dashboard-template-validator
      (as-> dashboard-template
            (assoc dashboard-template
              :specificity (specificity dashboard-template)))))
(defn- trim-trailing-slash
  [s]
  (if (str/ends-with? s "/")
    (subs s 0 (-> s count dec))
    s))
(defn- load-dashboard-template-dir
  ([dir] (load-dashboard-template-dir dir [] {}))
  ([dir path dashboard-templates]
   (with-open [ds (Files/newDirectoryStream dir)]
     (reduce
      (fn [acc ^Path f]
        (let [entity-type (file->entity-type f)]
          (cond
            (Files/isDirectory f (into-array java.nio.file.LinkOption []))
            (load-dashboard-template-dir f (->> f (.getFileName) str trim-trailing-slash (conj path)) acc)
            entity-type
            (assoc-in acc (concat path [entity-type ::leaf]) (yaml/load (partial make-dashboard-template entity-type) f))
            :else
            acc)))
      dashboard-templates
      ds))))
(def ^:private dashboard-templates
  (delay
    (u.files/with-open-path-to-resource [path dashboard-templates-dir]
                                        (into {} (load-dashboard-template-dir path)))))

Get all dashboard templates with prefix prefix. prefix is greedy, so ["table"] will match table/TransactionTable.yaml, but not table/TransactionTable/ByCountry.yaml

(defn get-dashboard-templates
  [prefix]
  (->> prefix
       (get-in @dashboard-templates)
       (keep (comp ::leaf val))))

Get dashboard template at path path.

(defn get-dashboard-template
  [path]
  (get-in @dashboard-templates (concat path [::leaf])))
(defn- extract-localized-strings
  [[path dashboard-template]]
  (let [strings (atom [])]
    ((spec/run-checker
       (fn [s params]
        (let [walk (spec/checker (s/spec s) params)]
          (fn [x]
            (when (= LocalizedString s)
              (swap! strings conj x))
            (walk x))))
       false
       DashboardTemplate)
     dashboard-template)
    (map vector (distinct @strings) (repeat path))))
(defn- make-pot
  [strings]
  (->> strings
       (group-by first)
       (mapcat (fn [[s ctxs]]
                 (concat (for [[_ ctx] ctxs]
                           (format "#: resources/%s%s.yaml" dashboard-templates-dir (str/join "/" ctx)))
                         [(format "msgid \"%s\"\nmsgstr \"\"\n" s)])))
       (str/join "\n")))
(defn- all-dashboard-templates
  ([]
   (all-dashboard-templates [] @dashboard-templates))
  ([path dashboard-templates]
   (when (map? dashboard-templates)
     (mapcat (fn [[k v]]
               (if (= k ::leaf)
                 [[path v]]
                 (all-dashboard-templates (conj path k) v)))
             dashboard-templates))))

Entry point for Clojure CLI task generate-automagic-dashboards-pot. Run it with

clojure -M:generate-automagic-dashboards-pot

(defn -main
  [& _]
  (->> (all-dashboard-templates)
       (mapcat extract-localized-strings)
       make-pot
       (spit "locales/metabase-automatic-dashboards.pot"))
  (System/exit 0))
 
(ns metabase.automagic-dashboards.filters
  (:require
   [metabase.automagic-dashboards.util :as magic.util]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.field :as field :refer [Field]]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date]
   [toucan2.core :as t2]))

Does field represent a temporal value, i.e. a date, time, or datetime?

(defn- temporal?
  [{base-type :base_type, effective-type :effective_type, unit :unit}]
  ;; TODO -- not sure why we're excluding year here? Is it because we normally returned it as an integer in the past?
  (and (not ((disj u.date/extract-units :year) unit))
       (isa? (or effective-type base-type) :type/Temporal)))
(defn- interestingness
  [{base-type :base_type, effective-type :effective_type, semantic-type :semantic_type, :keys [fingerprint]}]
  (cond-> 0
    (some-> fingerprint :global :distinct-count (< 10)) inc
    (some-> fingerprint :global :distinct-count (> 20)) dec
    ((descendants :type/Category) semantic-type)        inc
    (isa? (or effective-type base-type) :type/Temporal) inc
    ((descendants :type/Temporal) semantic-type)        inc
    (isa? semantic-type :type/CreationTimestamp)        inc
    (#{:type/State :type/Country} semantic-type)        inc))
(defn- interleave-all
  [& colls]
  (lazy-seq
   (when (seq colls)
     (concat (map first colls) (apply interleave-all (keep (comp seq rest) colls))))))
(defn- sort-by-interestingness
  [fields]
  (->> fields
       (map #(assoc % :interestingness (interestingness %)))
       (sort-by interestingness >)
       (partition-by :interestingness)
       (mapcat (fn [fields]
                 (->> fields
                      (group-by (juxt :base_type :semantic_type))
                      vals
                      (apply interleave-all))))))

Pick out interesting fields and sort them by interestingness.

(defn interesting-fields
  [fields]
  (->> fields
       (filter (fn [{:keys [semantic_type] :as field}]
                 (or (temporal? field)
                     (isa? semantic_type :type/Category))))
       sort-by-interestingness))
(defn- candidates-for-filtering
  [fieldset cards]
  (->> cards
       (mapcat magic.util/collect-field-references)
       (map magic.util/field-reference->id)
       distinct
       (map fieldset)
       interesting-fields))
(defn- build-fk-map
  [fks field]
  (if (:id field)
    (->> fks
         (filter (comp #{(:table_id field)} :table_id :target))
         (group-by :table_id)
         (keep (fn [[_ [fk & fks]]]
                 ;; Bail out if there is more than one FK from the same table
                 (when (empty? fks)
                   [(:table_id fk) [:field (u/the-id field) {:source-field (u/the-id fk)}]])))
         (into {(:table_id field) [:field (u/the-id field) nil]}))
    (constantly [:field (:name field) {:base-type (:base_type field)}])))
(defn- filter-for-card
  [card field]
  (some->> ((:fk-map field) (:table_id card))
           (vector :dimension)))
(defn- add-filter
  [dashcard filter-id field]
  (let [mappings (->> (conj (:series dashcard) (:card dashcard))
                      (keep (fn [card]
                              (when-let [target (filter-for-card card field)]
                                {:parameter_id filter-id
                                 :target       target
                                 :card_id      (:id card)})))
                      not-empty)]
    (cond
      (nil? (:card dashcard)) dashcard
      mappings                (update dashcard :parameter_mappings concat mappings))))

Return filter type for a given field.

(defn- filter-type
  [{:keys [semantic_type] :as field}]
  (cond
    (temporal? field)                   "date/all-options"
    (isa? semantic_type :type/State)    "location/state"
    (isa? semantic_type :type/Country)  "location/country"
    (isa? semantic_type :type/Category) "category"))
(def ^:private ^{:arglists '([dimensions])} remove-unqualified
  (partial remove (fn [{:keys [fingerprint]}]
                    (some-> fingerprint :global :distinct-count (< 2)))))

Add up to max-filters filters to dashboard dashboard. Takes an optional argument dimensions which is a list of fields for which to create filters, else it tries to infer by which fields it would be useful to filter.

(defn add-filters
  ([dashboard max-filters]
   (->> dashboard
        :orderd_cards
        (candidates-for-filtering (->> dashboard
                                       :context
                                       :tables
                                       (mapcat :fields)
                                       (map (fn [field]
                                              [((some-fn :id :name) field) field]))
                                       (into {})))
        (add-filters dashboard max-filters)))
  ([dashboard dimensions max-filters]
   (let [fks (when-let [table-ids (not-empty (set (keep (comp :table_id :card)
                                                        (:dashcards dashboard))))]
               (->> (t2/select Field :fk_target_field_id [:not= nil]
                               :table_id [:in table-ids])
                    field/with-targets))]
     (->> dimensions
          remove-unqualified
          sort-by-interestingness
          (take max-filters)
          (reduce
           (fn [dashboard candidate]
             (let [filter-id     (-> candidate ((juxt :id :name :unit)) hash str)
                   candidate     (assoc candidate :fk-map (build-fk-map fks candidate))
                   dashcards     (:dashcards dashboard)
                   dashcards-new (keep #(add-filter % filter-id candidate) dashcards)]
               ;; Only add filters that apply to all cards.
               (if (= (count dashcards) (count dashcards-new))
                 (-> dashboard
                     (assoc :dashcards dashcards-new)
                     (update :parameters conj {:id   filter-id
                                               :type (filter-type candidate)
                                               :name (:display_name candidate)
                                               :slug (:name candidate)}))
                 dashboard)))
           dashboard)))))

Returns a sequence of filter subclauses making up filter-clause by flattening :and compound filters.

(flatten-filter-clause [:and [:= [:field 1 nil] 2] [:and [:= [:field 3 nil] 4] [:= [:field 5 nil] 6]]]) ;; -> ([:= [:field 1 nil] 2] [:= [:field 3 nil] 4] [:= [:field 5 nil] 6])

(defn- flatten-filter-clause
  [[clause-name, :as filter-clause]]
  (when (seq filter-clause)
    (if (= clause-name :and)
      (rest (mbql.u/simplify-compound-filter filter-clause))
      [filter-clause])))

Inject a filter refinement into an MBQL filter clause, returning a new filter clause.

There are two reasons why we want to do this: 1) to reduce visual noise when we display applied filters; and 2) some DBs don't do this optimization or even protest (eg. GA) if there are duplicate clauses.

Assumes that any refinement sub-clauses referencing fields that are also referenced in the main clause are subsets of the latter. Therefore we can rewrite the combined clause to ommit the more broad version from the main clause. Assumes both filter clauses can be flattened by recursively merging :and claueses (ie. no :ands inside :or or :not).

(defn inject-refinement
  [filter-clause refinement]
  (let [in-refinement?   (into #{}
                               (map magic.util/collect-field-references)
                               (flatten-filter-clause refinement))
        existing-filters (->> filter-clause
                              flatten-filter-clause
                              (remove (comp in-refinement? magic.util/collect-field-references)))]
    (if (seq existing-filters)
      ;; since the filters are programatically generated they won't have passed thru normalization, so make sure we
      ;; normalize them before passing them to `combine-filter-clauses`, which validates its input
      (apply mbql.u/combine-filter-clauses (map (partial mbql.normalize/normalize-fragment [:query :filter])
                                                (cons refinement existing-filters)))
      refinement)))
 

Generate "interesting" inputs for the automatic dashboard pipeline.

In this context, "interesting" means "grounded" values. In particular, the most interesting values of all are metrics. Metrics are intrinsically interesting and can be displayed on their own. Dimensions and filters, while not interesting on their own, can be combined with metrics to add more interest to the metric. In MBQL parlance, metrics are aggregates, dimensions are breakouts, and filters are filters. However, a user-defined metric may go beyond a simple aggregate.

Our main namespace function, identify, takes an object to be analyzed for interestingness and a data structure consisting of templates for interesting combinations of metrics, dimensions, and filters. In this stage, we return grounded metrics (inherently interesting) along with grounded dimensions and filters that can be combined with our grounded metrics downstream for added interest.

The template arguments are defined in terms of Dimensions, Metrics, and Filters. These are named values, such as: - Dimension: - GenericNumber - Timestamp - Country - Longitude - Latitude - Income - Discount - Metric: - Count - Dimensionless - Sum - A metric over a single field - AverageDiscount - A metric defined by the Income and Discount fields (as an example) - Filter: - Last30Days - A named quantity that is defined by one or more constituent Dimensions

Template Metrics and Filters are made up of some combination of field references (Dimensions). These are referenced using the Dimension names (e.g. Avg of some GenericNumber) despite these constituent fields technically not being Dimensions. Metrics and Dimensions should be thought of as orthogonal concerns, but for our matching algorithm, this is how constituent fields are selected.

The "grounding" process binds individual fields to named Dimensions as well as constituent elements of Filter and Metric definitions.

Note that the binding process is 1:N, where a single dimension may match to multiple fields. A field can only bind to one dimension.

(ns metabase.automagic-dashboards.interesting
  (:require
    [clojure.math.combinatorics :as math.combo]
    [clojure.string :as str]
    [clojure.walk :as walk]
    [java-time :as t]
    [medley.core :as m]
    [metabase.automagic-dashboards.dashboard-templates :as dashboard-templates]
    [metabase.automagic-dashboards.schema :as ads]
    [metabase.automagic-dashboards.util :as magic.util]
    [metabase.mbql.normalize :as mbql.normalize]
    [metabase.mbql.util :as mbql.u]
    [metabase.models.field :as field :refer [Field]]
    [metabase.models.interface :as mi]
    [metabase.models.metric :refer [Metric]]
    [metabase.models.table :refer [Table]]
    [metabase.util :as u]
    [metabase.util.date-2 :as u.date]
    [metabase.util.malli :as mu]
    [toucan2.core :as t2]))

Code for creation of instantiated affinities

A utility function for pulling field definitions from mbql queries and return their IDs. Does something like this already exist in our utils? I was unable to find anything like it.

(defn find-field-ids
  [m]
  (let [fields (atom #{})]
    (walk/prewalk
      (fn [v]
        (when (vector? v)
          (let [[f id] v]
            (when (and id (= :field f))
              (swap! fields conj id))))
        v)
      m)
    @fields))

From a :model/Metric, construct a mapping of semantic types of linked fields to sets of fields that can satisfy that type. A linked field is one that is in the source table for the metric contribute to the metric itself, is not a PK, and has a semantictype (we assume nil semantictype fields are boring).

(defn semantic-groups
  [{:keys [table_id definition]}]
  (let [field-ids            (find-field-ids definition)
        potential-dimensions (t2/select :model/Field
                               :id [:not-in field-ids]
                               :table_id table_id
                               :semantic_type [:not-in [:type/PK]])]
    (update-vals
      (->> potential-dimensions
           (group-by :semantic_type))
      set)))

Map a metric aggregate definition from nominal types to semantic types.

(defn transform-metric-aggregate
  [m decoder]
  (walk/prewalk
    (fn [v]
      (if (vector? v)
        (let [[d n] v]
          (if (= "dimension" d)
            (decoder n)
            v))
        v))
    m))
(mu/defn ground-metric :- [:sequential ads/grounded-metric]
  "Generate \"grounded\" metrics from the mapped dimensions (dimension name -> field matches).
   Since there may be multiple matches to a dimension, this will produce a sequence of potential matches."
  [{metric-name       :metric-name
    metric-score      :score
    metric-definition :metric} :- ads/normalized-metric-template
   ground-dimensions :- ads/dim-name->matching-fields]
  (let [named-dimensions (dashboard-templates/collect-dimensions metric-definition)]
    (->> (map (comp :matches ground-dimensions) named-dimensions)
         (apply math.combo/cartesian-product)
         (map (partial zipmap named-dimensions))
         (map (fn [nm->field]
                (let [xform (update-vals nm->field (fn [{field-id :id}]
                                                     [:field field-id nil]))]
                  {:metric-name           metric-name
                   :metric-title          metric-name
                   :metric-score          metric-score
                   :metric-definition     {:aggregation
                                           [(transform-metric-aggregate metric-definition xform)]}
                   ;; Required for title interpolation in grounded-metrics->dashcards
                   :dimension-name->field nm->field}))))))
(mu/defn grounded-metrics :- [:sequential ads/grounded-metric]
  "Given a set of metric definitions and grounded (assigned) dimensions, produce a sequence of grounded metrics."
  [metric-templates :- [:sequential ads/normalized-metric-template]
   ground-dimensions :- ads/dim-name->matching-fields]
  (mapcat #(ground-metric % ground-dimensions) metric-templates))

Utility function to convert a seq of maps of one string key to another map into a simpler seq of maps.

(defn normalize-seq-of-maps
  [typename items]
  (let [kw (keyword (format "%s-name" (name typename)))]
    (->> items
         (map first)
         (map (fn [[name value]]
                (assoc value kw name))))))

dimensions

Generate a predicate of the form (f field) -> truthy value based on a fieldspec.

(defn- fieldspec-matcher
  [fieldspec]
  (if (and (string? fieldspec)
           (dashboard-templates/ga-dimension? fieldspec))
    (comp #{fieldspec} :name)
    (fn [{:keys [semantic_type target] :as field}]
      (cond
        ;; This case is mostly relevant for native queries
        (#{:type/PK :type/FK} fieldspec) (isa? semantic_type fieldspec)
        target (recur target)
        :else (and (not (magic.util/key-col? field)) (magic.util/field-isa? field fieldspec))))))

Generate a truthy predicate of the form (f field) -> truthy value based on a regex applied to the field name.

(defn- name-regex-matcher
  [name-pattern]
  (comp (->> name-pattern
             u/lower-case-en
             re-pattern
             (partial re-find))
        u/lower-case-en
        :name))

Generate a predicate of the form (f field) -> true | false based on the provided cardinality. Returns true if the distinct count of fingerprint values is less than or equal to the cardinality.

(defn- max-cardinality-matcher
  [cardinality]
  (fn [field]
    (some-> field
            (get-in [:fingerprint :global :distinct-count])
            (<= cardinality))))
(def ^:private field-filters
  {:fieldspec       fieldspec-matcher
   :named           name-regex-matcher
   :max-cardinality max-cardinality-matcher})

Find all fields belonging to table table for which all predicates in preds are true. preds is a map with keys :fieldspec, :named, and :max-cardinality.

(defn- filter-fields
  [preds fields]
  (filter (->> preds
               (keep (fn [[k v]]
                       (when-let [pred (field-filters k)]
                         (some-> v pred))))
               (apply every-pred))
          fields))

Given a context and a dimension definition, find all fields from the context that match the definition of this dimension.

(defn- matching-fields
  [{{:keys [fields]} :source :keys [tables] :as context}
   {:keys [field_type links_to named max_cardinality] :as constraints}]
  (if links_to
    (filter (comp (->> (magic.util/filter-tables links_to tables)
                       (keep :link)
                       set)
                  u/the-id)
            (matching-fields context (dissoc constraints :links_to)))
    (let [[tablespec fieldspec] field_type]
      (if fieldspec
        (mapcat (fn [table]
                  (some->> table
                           :fields
                           (filter-fields {:fieldspec       fieldspec
                                           :named           named
                                           :max-cardinality max_cardinality})
                           (map #(assoc % :link (:link table)))))
                (magic.util/filter-tables tablespec tables))
        (filter-fields {:fieldspec       tablespec
                        :named           named
                        :max-cardinality max_cardinality}
                       fields)))))

util candidate

(def ^:private ^{:arglists '([field])} id-or-name
  (some-fn :id :name))

For every field in a given context determine all potential dimensions each field may map to. This will return a map of field id (or name) to collection of potential matching dimensions.

(defn- candidate-bindings
  [context dimension-specs]
  ;; TODO - Fix this so that the intermediate representations aren't so crazy.
  ;; all-bindings a map of binding dim identifier to binding def which contains
  ;; field matches which are all the same field except they are merged with the binding.
  ;; What we want instead is just a map of field to potential bindings.
  ;; Just rack and stack the bindings then return that with the field or something.
  (let [all-bindings (for [dimension      dimension-specs
                           :let [[identifier definition] (first dimension)]
                           matching-field (matching-fields context definition)]
                       {(name identifier)
                        (assoc definition :matches [(merge matching-field definition)])})]
    (group-by (comp id-or-name first :matches val first) all-bindings)))

Assign a value to each potential binding. Takes a seq of potential bindings and returns a seq of vectors in the shape of [score binding], where score is a 3 element vector. This is computed as: 1) Number of ancestors field_type has (if field_type has a table prefix, ancestors for both table and field are counted); 2) Number of fields in the definition, which would include additional filters (named, max_cardinality, links_to, ...) etc.; 3) The manually assigned score for the binding definition

(defn- score-bindings
  [candidate-binding-values]
  (letfn [(score [a]
            (let [[_ definition] a]
              [(reduce + (map (comp count ancestors) (:field_type definition)))
               (count definition)
               (:score definition)]))]
    (map (juxt (comp score first) identity) candidate-binding-values)))

Return the most specific dimension from one or more dimensions that all match the same field. Specificity is determined based on: 1) how many ancestors field_type has (if field_type has a table prefix, ancestors for both table and field are counted); 2) if there is a tie, how many additional filters (named, max_cardinality, links_to, ...) are used; 3) if there is still a tie, score.

candidate-binding-values is a sequence of maps. Each map is a has a key of dimension spec name to potential dimension binding spec along with a collection of matches, all of which are merges of this spec with the same column.

Note that it would make a lot more sense to refactor this to return a map of column to potential binding dimensions. This return value is kind of the opposite of what makes sense.

Here's an example input with :matches updated as just the names of the columns in the matches. IRL, matches are the entire field n times, with each field a merge of the spec with the field.

({"Timestamp" {:field_type [:type/DateTime], :score 60, :matches ["CREATED_AT"]}} {"CreateTimestamp" {:field_type [:type/CreationTimestamp], :score 80 :matches ["CREATED_AT"]}})

(defn- most-specific-matched-dimension
  [candidate-binding-values]
  (let [scored-bindings (score-bindings candidate-binding-values)]
    (second (last (sort-by first scored-bindings)))))
(mu/defn find-dimensions :- ads/dim-name->dim-defs+matches
  "Bind fields to dimensions from the dashboard template and resolve overloaded cases in which multiple fields match the
  dimension specification.
   Each field will be bound to only one dimension. If multiple dimension definitions match a single field, the field
  is bound to the most specific definition used
   (see `most-specific-definition` for details).
  The context is passed in, but it only needs tables and fields in `candidate-bindings`. It is not extensively used."
  [context dimension-specs :- [:maybe [:sequential ads/dimension-template]]]
  (->> (candidate-bindings context dimension-specs)
       (map (comp most-specific-matched-dimension val))
       (apply merge-with (fn [a b]
                           (case (compare (:score a) (:score b))
                             1 a
                             0 (update a :matches concat (:matches b))
                             -1 b))
              {})))

Get a reference for a given model to be injected into a template (either MBQL, native query, or string).

(defmulti
  ^{:doc      
    :arglists '([template-type model])}
  ->reference (fn [template-type model]
                [template-type (mi/model model)]))
(defn- optimal-datetime-resolution
  [field]
  (let [[earliest latest] (some->> field
                                   :fingerprint
                                   :type
                                   :type/DateTime
                                   ((juxt :earliest :latest))
                                   (map u.date/parse))]
    (if (and earliest latest)
      ;; e.g. if 3 hours > [duration between earliest and latest] then use `:minute` resolution
      (condp u.date/greater-than-period-duration? (u.date/period-duration earliest latest)
        (t/hours 3) :minute
        (t/days 7) :hour
        (t/months 6) :day
        (t/years 10) :month
        :year)
      :day)))
(defmethod ->reference [:mbql Field]
  [_ {:keys [fk_target_field_id id link aggregation name base_type] :as field}]
  (let [reference (mbql.normalize/normalize
                    (cond
                      link [:field id {:source-field link}]
                      fk_target_field_id [:field fk_target_field_id {:source-field id}]
                      id [:field id nil]
                      :else [:field name {:base-type base_type}]))]
    (cond
      (isa? base_type :type/Temporal)
      (mbql.u/with-temporal-unit reference (keyword (or aggregation
                                                        (optimal-datetime-resolution field))))

      (and aggregation
           (isa? base_type :type/Number))
      (mbql.u/update-field-options reference assoc-in [:binning :strategy] (keyword aggregation))

      :else
      reference)))
(defmethod ->reference [:string Field]
  [_ {:keys [display_name full-name link]}]
  (cond
    full-name full-name
    link (format "%s → %s"
                 (-> (t2/select-one Field :id link) :display_name (str/replace #"(?i)\sid$" ""))
                 display_name)
    :else display_name))
(defmethod ->reference [:string Table]
  [_ {:keys [display_name full-name]}]
  (or full-name display_name))
(defmethod ->reference [:string Metric]
  [_ {:keys [name full-name]}]
  (or full-name name))
(defmethod ->reference [:mbql Metric]
  [_ {:keys [id definition]}]
  (if id
    [:metric id]
    (-> definition :aggregation first)))
(defmethod ->reference [:native Field]
  [_ field]
  (field/qualified-name field))
(defmethod ->reference [:native Table]
  [_ {:keys [name]}]
  name)
(defmethod ->reference :default
  [_ form]
  (or (cond-> form
        (map? form) ((some-fn :full-name :name) form))
      form))

TODO - Deduplicate from core

(def ^:private ^{:arglists '([source])} source->db
  (comp (partial t2/select-one :model/Database :id) (some-fn :db_id :database_id)))
(defn- enriched-field-with-sources [{:keys [tables source]} field]
  (assoc field
    :link (m/find-first (comp :link #{(:table_id field)} u/the-id) tables)
    :db (source->db source)))
(defn- add-field-links-to-definitions [dimensions field]
  (->> dimensions
       (keep (fn [[identifier definition]]
               (when-let [matches (->> definition
                                       :matches
                                       (remove (comp #{(id-or-name field)} id-or-name))
                                       not-empty)]
                 [identifier (assoc definition :matches matches)])))
       (concat [["this" {:matches [field]
                         :name    (:display_name field)
                         :score   dashboard-templates/max-score
                         :card-score   dashboard-templates/max-score}]])
       (into {})))
(defn- add-field-self-reference [{{:keys [entity]} :root :as context} dimensions]
  (cond-> dimensions
    (= Field (mi/model entity))
    (add-field-links-to-definitions (enriched-field-with-sources context entity))))

Take filter templates (as from a dashboard template's :filters) and ground dimensions and produce a map of the filter name to grounded versions of the filter.

(defn grounded-filters
  [filter-templates ground-dimensions]
  (->> filter-templates
       (keep (fn [fltr]
               (let [[fname {:keys [filter] :as v}] (first fltr)
                     dims (dashboard-templates/collect-dimensions v)
                     opts (->> (map (comp
                                      (partial map (partial ->reference :mbql))
                                      :matches
                                      ground-dimensions) dims)
                               (apply math.combo/cartesian-product)
                               (map (partial zipmap dims)))]
                 (seq (for [opt opts
                            :let [f
                                  (walk/prewalk
                                    (fn [x]
                                      (if (vector? x)
                                        (let [[ds dim-name] x]
                                          (if (and (= "dimension" ds)
                                                   (string? dim-name))
                                            (opt dim-name)
                                            x))
                                        x))
                                    filter)]]
                        (assoc v :filter f :filter-name fname))))))
       flatten))
(mu/defn identify
  :- [:map
      [:dimensions ads/dim-name->matching-fields]
      [:metrics [:sequential ads/grounded-metric]]]
  "Identify interesting metrics and dimensions of a `thing`. First identifies interesting dimensions, and then
  interesting metrics which are satisfied.
  Metrics from the template are assigned a score of 50; user defined metrics a score of 95"
  [{{:keys [linked-metrics]} :root :as context}
   {:keys [dimension-specs
           metric-specs
           filter-specs]} :- [:map
                               [:dimension-specs [:maybe [:sequential ads/dimension-template]]]
                               [:metric-specs [:maybe [:sequential ads/metric-template]]]
                               [:filter-specs [:maybe [:sequential ads/filter-template]]]]]
  (let [dims      (->> (find-dimensions context dimension-specs)
                       (add-field-self-reference context))
        metrics   (-> (normalize-seq-of-maps :metric metric-specs)
                      (grounded-metrics dims))
        set-score (fn [score metrics]
                    (map #(assoc % :metric-score score) metrics))]
    {:dimensions dims
     :metrics    (concat (set-score 50 metrics) (set-score 95 linked-metrics)
                         (let [entity (-> context :root :entity)]
                           ;; metric x-rays talk about "this" in the template
                           (when (mi/instance-of? :model/Metric entity)
                             [{:metric-name       "this"
                               :metric-title      (:name entity)
                               :metric-definition {:aggregation [(->reference :mbql entity)]}
                               :metric-score      dashboard-templates/max-score}])))
     :filters (grounded-filters filter-specs dims)}))

Convert a card to a dashboard card.

(defn card->dashcard
  [{:keys [width height] :as card}]
  {:id                     (gensym)
   :size_x                 width
   :size_y                 height
   :dashboard_tab_id       nil
   :card                   (dissoc card :width :height)
   :visualization_settings {}})

Assign :row and :col values to the provied seq of dashcards.

(defn make-layout
  [dashcards]
  (loop [[{:keys [size_x size_y] :as dashcard} & dashcards] dashcards
         [xmin ymin xmax ymax] [0 0 0 0]
         final-cards []]
    (if dashcard
      (let [dashcard (assoc dashcard :row ymin :col xmax)
            bounds   (if (> xmax 20)
                       [xmin ymax 0 (+ ymax size_y)]
                       [xmin ymin (+ xmax size_x) (max ymax (+ ymin size_y))])]
        (recur dashcards
               bounds
               (conj final-cards dashcard)))
      final-cards)))
 
(ns metabase.automagic-dashboards.names
  (:require
   [clojure.string :as str]
   [java-time.api :as t]
   [metabase.automagic-dashboards.util :as magic.util]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.util :as qp.util]
   [metabase.util.date-2 :as u.date]
   [metabase.util.i18n :refer [deferred-tru tru]]
   [toucan2.core :as t2]))

TODO - rename "minumum" to "minimum". Note that there are internationalization string implications here so make sure to do a thorough find and replace on this.

(def ^:private op->name
  {:sum       (deferred-tru "sum")
   :avg       (deferred-tru "average")
   :min       (deferred-tru "minumum")
   :max       (deferred-tru "maximum")
   :count     (deferred-tru "number")
   :distinct  (deferred-tru "distinct count")
   :stddev    (deferred-tru "standard deviation")
   :cum-count (deferred-tru "cumulative count")
   :cum-sum   (deferred-tru "cumulative sum")})

Return the name of the metric or name by describing it.

(defn metric-name
  [[op & args :as metric]]
  (cond
    (mbql.u/ga-metric-or-segment? metric) (-> args first str (subs 3) str/capitalize)
    (magic.util/adhoc-metric? metric)     (-> op qp.util/normalize-token op->name)
    (magic.util/saved-metric? metric)     (->> args first (t2/select-one :model/Metric :id) :name)
    :else                                 (second args)))

Join a sequence as [1 2 3 4] to "1, 2, 3 and 4"

(defn- join-enumeration
  [xs]
  (if (next xs)
    (tru "{0} and {1}" (str/join ", " (butlast xs)) (last xs))
    (first xs)))

Return the (display) name of the source of a given root object.

(def ^{:arglists '([root])} source-name
  (comp (some-fn :display_name :name) :source))

Return a description for the metric.

(defn metric->description
  [root aggregation-clause]
  (join-enumeration
   (for [metric (if (sequential? (first aggregation-clause))
                  aggregation-clause
                  [aggregation-clause])]
     (if (magic.util/adhoc-metric? metric)
       (tru "{0} of {1}" (metric-name metric) (or (some->> metric
                                                           second
                                                           (magic.util/->field root)
                                                           :display_name)
                                                  (source-name root)))
       (metric-name metric)))))

Generate a description for the question.

(defn question-description
  [root question]
  (let [aggregations (->> (get-in question [:dataset_query :query :aggregation])
                          (metric->description root))
        dimensions   (->> (get-in question [:dataset_query :query :breakout])
                          (mapcat magic.util/collect-field-references)
                          (map (comp :display_name
                                     (partial magic.util/->field root)))
                          join-enumeration)]
    (if dimensions
      (tru "{0} by {1}" aggregations dimensions)
      aggregations)))
(defmulti
  ^{:private true
    :arglists '([fieldset [op & args]])}
  humanize-filter-value (fn [_ [op & _args]]
                          (qp.util/normalize-token op)))
(def ^:private unit-name (comp {:minute-of-hour  (deferred-tru "minute")
                                :hour-of-day     (deferred-tru "hour")
                                :day-of-week     (deferred-tru "day of week")
                                :day-of-month    (deferred-tru "day of month")
                                :day-of-year     (deferred-tru "day of year")
                                :week-of-year    (deferred-tru "week")
                                :month-of-year   (deferred-tru "month")
                                :quarter-of-year (deferred-tru "quarter")
                                :year            (deferred-tru "year")}
                               qp.util/normalize-token))

Turn a field reference into a field.

(defn item-reference->field
  [root [item-type :as item-reference]]
  (case item-type
    (:field "field") (let [normalized-field-reference (mbql.normalize/normalize item-reference)
                           temporal-unit              (mbql.u/match-one normalized-field-reference
                                                                        [:field _ (opts :guard :temporal-unit)]
                                                                        (:temporal-unit opts))
                           {:keys [display_name] :as field-record} (cond-> (->> normalized-field-reference
                                                                                magic.util/collect-field-references
                                                                                first
                                                                                (magic.util/->field root))
                                                                     temporal-unit
                                                                     (assoc :unit temporal-unit))
                           item-name                  (cond->> display_name
                                                               (some-> temporal-unit u.date/extract-units)
                                                               (tru "{0} of {1}" (unit-name temporal-unit)))]
                       (assoc field-record :item-name item-name))
    (:expression "expression") {:item-name (second item-reference)}
    {:item-name "item"}))

Determine the right name to display from an individual humanized item.

(defn item-name
  ([root [field-type potential-name :as field-reference]]
   (case field-type
     (:field "field") (->> field-reference (item-reference->field root) item-name)
     (:expression "expression") potential-name
     "item"))
  ([{:keys [display_name unit] :as _field}]
   (cond->> display_name
     (some-> unit u.date/extract-units) (tru "{0} of {1}" (unit-name unit)))))

Add appropriate pluralization suffixes for integer numbers.

(defn pluralize
  [x]
  ;; the `int` cast here is to fix performance warnings if `*warn-on-reflection*` is enabled
  (case (int (mod x 10))
    1 (tru "{0}st" x)
    2 (tru "{0}nd" x)
    3 (tru "{0}rd" x)
    (tru "{0}th" x)))

Convert a time data type into a human friendly string.

(defn humanize-datetime
  [t-str unit]
  (let [dt (u.date/parse t-str)]
    (case unit
      :second          (tru "at {0}" (t/format "h:mm:ss a, MMMM d, YYYY" dt))
      :minute          (tru "at {0}" (t/format "h:mm a, MMMM d, YYYY" dt))
      :hour            (tru "at {0}" (t/format "h a, MMMM d, YYYY" dt))
      :day             (tru "on {0}" (t/format "MMMM d, YYYY" dt))
      :week            (tru "in {0} week - {1}"
                            (pluralize (u.date/extract dt :week-of-year))
                            (str (u.date/extract dt :year)))
      :month           (tru "in {0}" (t/format "MMMM YYYY" dt))
      :quarter         (tru "in Q{0} - {1}"
                            (u.date/extract dt :quarter-of-year)
                            (str (u.date/extract dt :year)))
      :year            (t/format "YYYY" dt)
      :day-of-week     (t/format "EEEE" dt)
      :hour-of-day     (tru "at {0}" (t/format "h a" dt))
      :month-of-year   (t/format "MMMM" dt)
      :quarter-of-year (tru "Q{0}" (u.date/extract dt :quarter-of-year))
      (:minute-of-hour
       :day-of-month
       :day-of-year
       :week-of-year)  (u.date/extract dt unit))))
(defmethod humanize-filter-value :=
  [root [_ field-reference value]]
  (let [{:keys [item-name effective_type base_type unit]} (item-reference->field root field-reference)]
    (if (isa? (or effective_type base_type) :type/Temporal)
      (tru "{0} is {1}" item-name (humanize-datetime value unit))
      (tru "{0} is {1}" item-name value))))
(defmethod humanize-filter-value :>=
  [root [_ field-reference value]]
  (let [{:keys [item-name effective_type base_type unit]} (item-reference->field root field-reference)]
    (if (isa? (or effective_type base_type) :type/Temporal)
      (tru "{0} is not before {1}" item-name (humanize-datetime value unit))
      (tru "{0} is at least {1}" item-name value))))
(defmethod humanize-filter-value :>
  [root [_ field-reference value]]
  (let [{:keys [item-name effective_type base_type unit]} (item-reference->field root field-reference)]
    (if (isa? (or effective_type base_type) :type/Temporal)
      (tru "{0} is after {1}" item-name (humanize-datetime value unit))
      (tru "{0} is greater than {1}" item-name value))))
(defmethod humanize-filter-value :<=
  [root [_ field-reference value]]
  (let [{:keys [item-name effective_type base_type unit]} (item-reference->field root field-reference)]
    (if (isa? (or effective_type base_type) :type/Temporal)
      (tru "{0} is not after {1}" item-name (humanize-datetime value unit))
      (tru "{0} is no more than {1}" item-name value))))
(defmethod humanize-filter-value :<
  [root [_ field-reference value]]
  (let [{:keys [item-name effective_type base_type unit]} (item-reference->field root field-reference)]
    (if (isa? (or effective_type base_type) :type/Temporal)
      (tru "{0} is before {1}" item-name (humanize-datetime value unit))
      (tru "{0} is less than {1}" item-name value))))
(defmethod humanize-filter-value :between
  [root [_ field-reference min-value max-value]]
  (tru "{0} is between {1} and {2}" (item-name root field-reference) min-value max-value))
(defmethod humanize-filter-value :inside
  [root [_ lat-reference lon-reference lat-max lon-min lat-min lon-max]]
  (tru "{0} is between {1} and {2}; and {3} is between {4} and {5}"
       (item-name root lon-reference) lon-min lon-max
       (item-name root lat-reference) lat-min lat-max))
(defmethod humanize-filter-value :and
  [root [_ & clauses]]
  (->> clauses
       (map (partial humanize-filter-value root))
       join-enumeration))
(defmethod humanize-filter-value :default
  [root [_ field-reference value]]
  (let [{:keys [item-name effective_type base_type unit]} (item-reference->field root field-reference)]
    (if (isa? (or effective_type base_type) :type/Temporal)
      (tru "{0} relates to {1}" item-name (humanize-datetime value unit))
      (tru "{0} relates to {1}" item-name value))))

Return a cell title given a root object and a cell query.

(defn cell-title
  [root cell-query]
  (str/join " " [(if-let [aggregation (get-in root [:entity :dataset_query :query :aggregation])]
                   (metric->description root aggregation)
                   (:full-name root))
                 (tru "where {0}" (humanize-filter-value root cell-query))]))
 

Create and save models that make up automagic dashboards.

(ns metabase.automagic-dashboards.populate
  (:require
   [clojure.string :as str]
   [medley.core :as m]
   [metabase.api.common :as api]
   [metabase.automagic-dashboards.filters :as filters]
   [metabase.automagic-dashboards.util :as magic.util]
   [metabase.models.card :as card]
   [metabase.models.collection :as collection]
   [metabase.public-settings :as public-settings]
   [metabase.query-processor.util :as qp.util]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

Total grid width.

(def ^Long grid-width
  18)

Default card width.

(def ^Long default-card-width
  6)

Default card height

(def ^Long default-card-height
  4)

Create and return a new collection.

(defn create-collection!
  [title description parent-collection-id]
  (first (t2/insert-returning-instances!
           'Collection
           (merge
             {:name        title
              :description description}
             (when parent-collection-id
               {:location (collection/children-location (t2/select-one ['Collection :location :id]
                                                                       :id parent-collection-id))})))))

Get or create container collection for automagic dashboards in the root collection.

(defn get-or-create-root-container-collection
  []
  (or (t2/select-one 'Collection
        :name     "Automatically Generated Dashboards"
        :location "/")
      (create-collection! "Automatically Generated Dashboards" nil nil)))

A vector of colors used for coloring charts. Uses [[public-settings/application-colors]] for user choices.

(defn colors
  []
  (let [order [:brand :accent1 :accent2 :accent3 :accent4 :accent5 :accent6 :accent7]
        colors-map (merge {:brand   "#509EE3"
                           :accent1 "#88BF4D"
                           :accent2 "#A989C5"
                           :accent3 "#EF8C8C"
                           :accent4 "#F9D45C"
                           :accent5 "#F2A86F"
                           :accent6 "#98D9D9"
                           :accent7 "#7172AD"}
                          (public-settings/application-colors))]
    (into [] (map colors-map) order)))
(defn- ensure-distinct-colors
  [candidates]
  (->> candidates
       frequencies
       (reduce-kv
        (fn [acc color count]
          (if (= count 1)
            (conj acc color)
            (concat acc [color (first (drop-while (conj (set acc) color) (colors)))])))
        [])))

Map given objects to distinct colors.

(defn map-to-colors
  [objs]
  (->> objs
       (map (comp (colors) #(mod % (count (colors))) hash))
       ensure-distinct-colors))

Pick the chart colors acording to the following rules: * If there is more than one breakout dimension let the frontend do it as presumably the second dimension will be used as color key and we can't know the values it will take at this stage. * If the visualization is a bar or row chart with count as the aggregation (ie. a frequency chart), use field IDs referenced in :breakout as color key. * Else use :aggregation as color key.

Colors are then determined by using the hashs of color keys to index into the vector of available colors.

(defn- colorize
  [{:keys [visualization dataset_query]}]
  (let [display     (first visualization)
        breakout    (-> dataset_query :query :breakout)
        aggregation (-> dataset_query :query :aggregation)]
    (when (and (#{"line" "row" "bar" "scatter" "area"} display)
               (= (count breakout) 1))
      (let [color-keys (if (and (#{"bar" "row"} display)
                                (some->> aggregation
                                         flatten
                                         first
                                         qp.util/normalize-token
                                         (= :count)))
                         (->> breakout
                              magic.util/collect-field-references
                              (map magic.util/field-reference->id))
                         aggregation)]
        {:graph.colors (map-to-colors color-keys)}))))
(defn- visualization-settings
  [{:keys [metrics x_label y_label series_labels visualization dimensions] :as card}]
  (let [[display visualization-settings] visualization]
    {:display                display
     :visualization_settings (-> visualization-settings
                                 (assoc :graph.series_labels (map :name metrics)
                                        :graph.metrics       (map :op metrics)
                                        :graph.dimensions    dimensions)
                                 (merge (colorize card))
                                 (cond->
                                     series_labels (assoc :graph.series_labels series_labels)
                                     x_label       (assoc :graph.x_axis.title_text x_label)
                                     y_label       (assoc :graph.y_axis.title_text y_label)))}))

Default properties for a dashcard on magic dashboard.

(defn card-defaults
  []
  {:id                     (gensym)
   :dashboard_tab_id       nil
   :visualization_settings {}})

Add a card to dashboard dashboard at position [x, y].

(defn- add-card
  [dashboard {:keys [title description dataset_query width height id] :as card} [x y]]
  (let [card (-> {:creator_id    api/*current-user-id*
                  :dataset_query dataset_query
                  :description   description
                  :name          title
                  :collection_id nil
                  :id            (or id (gensym))}
                 (merge (visualization-settings card))
                 card/populate-query-fields)]
    (update dashboard :dashcards conj
            (merge (card-defaults)
             {:col                    y
              :row                    x
              :size_x                 width
              :size_y                 height
              :card                   card
              :card_id                (:id card)
              :visualization_settings {}}))))

Add a text card to dashboard dashboard at position [x, y].

(defn add-text-card
  [dashboard {:keys [text width height visualization-settings]} [x y]]
  (update dashboard :dashcards conj
          (merge (card-defaults)
                 {:creator_id             api/*current-user-id*
                  :visualization_settings (merge
                                            {:text         text
                                             :virtual_card {:name                   nil
                                                            :display                :text
                                                            :dataset_query          {}
                                                            :visualization_settings {}}}
                                            visualization-settings)
                  :col                    y
                  :row                    x
                  :size_x                 width
                  :size_y                 height
                  :card                   nil})))
(defn- make-grid
  [width height]
  (vec (repeat height (vec (repeat width false)))))

Mark a rectangular area starting at [x, y] of size [width, height] as occupied.

(defn- fill-grid
  [grid [x y] {:keys [width height]}]
  (reduce (fn [grid xy]
            (assoc-in grid xy true))
          grid
          (for [x (range x (+ x height))
                y (range y (+ y width))]
            [x y])))

Can we place card on grid starting at [x y] (top left corner)? Since we are filling the grid top to bottom and the cards are rectangulard, it suffices to check just the first (top) row.

(defn- accomodates?
  [grid [x y] {:keys [width height]}]
  (and (<= (+ x height) (count grid))
       (<= (+ y width) (-> grid first count))
       (every? false? (subvec (grid x) y (+ y width)))))

Find position on the grid where to put the card. We use the dumbest possible algorithm (the grid size is relatively small, so we should be fine): startting at top left move along the grid from left to right, row by row and try to place the card at each position until we find an unoccupied area. Mark the area as occupied.

(defn- card-position
  [grid start-row card]
  (reduce (fn [grid xy]
            (if (accomodates? grid xy card)
              (reduced xy)
              grid))
          grid
          (for [x (range start-row (count grid))
                y (range (count (first grid)))]
            [x y])))

Find the bottom of the grid. Bottom is the first completely empty row with another empty row below it.

(defn- bottom-row
  [grid]
  (let [row {:height 0, :width grid-width}]
    (loop [bottom (long 0)]
      (let [[bottom _]      (card-position grid bottom row)
            [next-bottom _] (card-position grid (inc bottom) row)]
        (if (= (inc bottom) next-bottom)
          bottom
          (recur (long next-bottom)))))))
(def ^:private ^{:arglists '([card])} text-card?
  :text)
(def ^:private ^Long ^:const group-heading-height 2)
(defn- add-group
  [dashboard grid group cards]
  (let [start-row (bottom-row grid)
        start-row (cond-> start-row
                    group (+ group-heading-height))]
    (reduce (fn [[dashboard grid] card]
              (let [xy (card-position grid start-row card)]
                [(if (text-card? card)
                   (add-text-card dashboard card xy)
                   (add-card dashboard card xy))
                 (fill-grid grid xy card)]))
            (if group
              (let [xy   [(- start-row 2) 0]
                    card {:text                   (format "# %s" (:title group))
                          :width                  grid-width
                          :height                 group-heading-height
                          :visualization-settings {:dashcard.background false
                                                   :text.align_vertical :bottom}}]
                [(add-text-card dashboard card xy)
                 (fill-grid grid xy card)])
              [dashboard grid])
            cards)))

Pick up to max-cards with the highest :card-score. Keep groups together if possible by pulling all the cards within together and using the same (highest) card-score for all. Among cards with the same card-score those beloning to the largest group are favourized, but it is still possible that not all cards in a group make it (consider a group of 4 cards which starts as 7/9; in that case only 2 cards from the group will be picked).

(defn- shown-cards
  [max-cards cards]
  (->> cards
       (sort-by :card-score >)
       (take max-cards)
       (group-by (some-fn :group hash))
       (map (fn [[_ group]]
              {:cards    (sort-by :position group)
               :position (apply min (map :position group))}))
       (sort-by :position)
       (mapcat :cards)))
(def ^:private ^:const ^Long max-filters 4)

A seq from a group-by in a particular order. If you don't need the map itself, just to get the key value pairs in a particular order. Clojure's sorted-map-by doesn't handle distinct keys with the same score. So this just iterates over the groupby in a reasonable order.

(defn ordered-group-by-seq
  [f key-order coll]
  (letfn [(access [ks grouped]
            (if (seq ks)
              (let [k (first ks)]
                (lazy-seq
                 (if-let [x (find grouped k)]
                   (cons x (access (next ks) (dissoc grouped k)))
                   (access (next ks) grouped))))
              (seq grouped)))]
    (let [g (group-by f coll)]
      (access key-order g))))

Create dashboard and populate it with cards.

(defn create-dashboard
  ([dashboard] (create-dashboard dashboard :all))
  ([{:keys [title transient_title description groups filters cards]} n]
   (let [n             (cond
                         (= n :all)   (count cards)
                         (keyword? n) (Integer/parseInt (name n))
                         :else        n)
         dashboard     {:name           title
                        :transient_name (or transient_title title)
                        :description    description
                        :creator_id     api/*current-user-id*
                        :parameters     []}
         cards         (shown-cards n cards)
         [dashboard _] (->> cards
                            (ordered-group-by-seq :group
                                                  (when groups
                                                    (sort-by (comp (fnil - 0) :score groups)
                                                             (keys groups))))
                            (reduce (fn [[dashboard grid] [group-name cards]]
                                      (let [group (get groups group-name)]
                                        (add-group dashboard grid group cards)))
                                    [dashboard
                                     ;; Height doesn't need to be precise, just some
                                     ;; safe upper bound.
                                     (make-grid grid-width (* n grid-width))]))]
     (log/debug (trs "Adding {0} cards to dashboard {1}:\n{2}"
                     (count cards)
                     title
                     (str/join "; " (map :title cards))))
     (cond-> (update dashboard :dashcards (partial sort-by (juxt :row :col)))
       (not-empty filters) (filters/add-filters filters max-filters)))))
(defn- downsize-titles
  [markdown]
  (->> markdown
       str/split-lines
       (map (fn [line]
              (if (str/starts-with? line "#")
                (str "#" line)
                line)))
       str/join))
(defn- merge-filters
  [ds]
  (when (->> ds
             (mapcat :dashcards)
             (keep (comp :table_id :card))
             distinct
             count
             (= 1))
   [(->> ds (mapcat :parameters) distinct)
    (->> ds
         (mapcat :dashcards)
         (mapcat :parameter_mappings)
         (map #(dissoc % :card_id))
         distinct)]))

Merge dashboards dashboard into dashboard target.

(defn merge-dashboards
  ([target dashboard] (merge-dashboards target dashboard {}))
  ([target dashboard {:keys [skip-titles?]}]
   (let [[parameters parameter-mappings] (merge-filters [target dashboard])
         offset                         (->> target
                                             :dashcards
                                             (map #(+ (:row %) (:size_y %)))
                                             (apply max -1) ; -1 so it neturalizes +1 for spacing
                                                            ; if the target dashboard is empty.
                                             inc)
         cards                        (->> dashboard
                                           :dashcards
                                           (map #(-> %
                                                     (update :row + offset (if skip-titles?
                                                                             0
                                                                             group-heading-height))
                                                     (m/update-existing-in [:visualization_settings :text]
                                                                           downsize-titles)
                                                     (assoc :parameter_mappings
                                                       (when-let [card-id (:card_id %)]
                                                         (for [mapping parameter-mappings]
                                                           (assoc mapping :card_id card-id)))))))]
     (-> target
         (assoc :parameters parameters)
         (cond->
           (not skip-titles?)
           (add-text-card {:width                  grid-width
                           :height                 group-heading-height
                           :text                   (format "# %s" (:name dashboard))
                           :visualization-settings {:dashcard.background false
                                                    :text.align_vertical :bottom}}
                          [offset 0]))
         (update :dashcards concat cards)))))
 
(ns metabase.automagic-dashboards.schema
  (:require [malli.core :as mc]
            [malli.util :as mut]))

The big ball of mud data object from which we generate x-rays

(def context
  (mc/schema
    [:map
     [:source any?]
     [:root any?]
     [:tables {:optional true} any?]
     [:query-filter {:optional true} any?]]))

The base unit thing we are trying to produce in x-rays

(def dashcard
  ;; TODO - Beef these specs up, esp. the any?s
  (mc/schema
    [:map
     [:dataset_query {:optional true}
      [:map
       [:database {:optional true} [:maybe nat-int?]]
       [:type :keyword]
       [:query [:map
                [:aggregation [:sequential any?]]
                [:breakout {:optional true} [:sequential any?]]
                [:source-table [:or :int :string]]]]]]
     [:dimensions {:optional true} [:sequential string?]]
     [:group {:optional true} string?]
     [:height pos-int?]
     [:metrics {:optional true} any?]
     [:position {:optional true} nat-int?]
     [:card-score {:optional true} number?]
     [:total-score {:optional true} nat-int?]
     [:metric-score {:optional true} nat-int?]
     [:score-components {:optional true} [:sequential nat-int?]]
     [:title {:optional true} string?]
     [:visualization {:optional true} any?]
     [:width pos-int?]
     [:x_label {:optional true} string?]]))

A bunch of dashcards

(def dashcards
  (mc/schema [:maybe [:sequential dashcard]]))

A dimension reference, as either a semantic type or entity type and semantic type.

(def field-type
  (mc/schema
    [:or
     [:tuple :keyword]
     [:tuple :keyword :keyword]]))

A specification for the basic keys in the value of a dimension template.

(def dimension-value
  (mc/schema
    [:map
     [:field_type field-type]
     [:score {:optional true} nat-int?]
     [:max_cardinality {:optional true} nat-int?]
     [:named {:optional true} [:string {:min 1}]]]))

A specification for the basic keys in a dimension template.

(def dimension-template
  (mc/schema
    [:map-of
     {:min 1 :max 1}
     [:string {:min 1}]
     dimension-value]))

A specification for the basic keys in the value of a metric template.

(def metric-value
  (mc/schema
    [:map
     [:metric [:vector some?]]
     [:score {:optional true} nat-int?]
     ;[:name some?]
     ]))

A specification for the basic keys in a metric template.

(def metric-template
  (mc/schema
    [:map-of
     {:min 1 :max 1}
     [:string {:min 1}]
     metric-value]))

A specification for the basic keys in the value of a filter template.

(def filter-value
  (mc/schema
    [:map
     [:filter [:vector some?]]
     [:score nat-int?]]))

A specification for the basic keys in a filter template.

(def filter-template
  (mc/schema
    [:map-of
     {:min 1 :max 1}
     [:string {:min 1}]
     filter-value]))

A specification for the basic keys in the value of a card template.

(def card-value
  (mc/schema
    [:map
     [:dimensions {:optional true} [:vector (mc/schema
                                              [:map-of
                                               {:min 1 :max 1}
                                               [:string {:min 1}]
                                               [:map
                                                [:aggregation {:optional true} string?]]])]]
     [:metrics {:optional true} [:vector string?]]
     [:filters {:optional true} [:vector string?]]
     [:card-score {:optional true} nat-int?]]))

A specification for the basic keys in a card template.

(def card-template
  (mc/schema
    [:map-of
     {:min 1 :max 1}
     [:string {:min 1}]
     card-value]))

A specification for the basic keys in a dashboard template.

(def dashboard-template
  (mc/schema
    [:map
     [:dimensions {:optional true} [:vector dimension-template]]
     [:metrics {:optional true} [:vector metric-template]]
     [:filters {:optional true} [:vector filter-template]]
     [:cards {:optional true} [:vector card-template]]]))

Available values schema -- These are items for which fields have been successfully bound

Specify the shape of things that are available after dimension to field matching for affinity matching

(def available-values
  (mc/schema
    [:map
     [:available-dimensions [:map-of [:string {:min 1}] any?]]
     [:available-metrics [:map-of [:string {:min 1}] any?]]
     [:available-filters {:optional true} [:map-of [:string {:min 1}] any?]]]))

Schemas for "affinity" functions as these can be particularly confusing

A set of dimensions that belong together. This is the basic unity of affinity.

(def dimension-set
  [:set string?])

A set of sematic types that belong together. This is the basic unity of semantic affinity.

(def semantic-affinity-set
  [:set :keyword])

A collection of things that go together. In this case, we're a bit specialized on card affinity, but the key element in the structure is :base-dims, which are a set of dimensions which, when satisfied, enable this affinity object.

(def affinity
  (mc/schema
    [:map
     [:affinity-name :string]
     [:affinity-set [:set :keyword]]
     [:card-template card-value]
     [:metric-constituent-names [:sequential :string]]
     [:metric-field-types [:set :keyword]]
     [:named-dimensions [:sequential :string]]
     [:score {:optional true} nat-int?]]))

A sequence of affinity objects.

(def affinities
  (mc/schema
    [:sequential affinity]))

A collection of things that go together. In this case, we're a bit specialized on card affinity, but the key element in the structure is :base-dims, which are a set of dimensions which, when satisfied, enable this affinity object.

(def affinity-old
  (mc/schema
    [:map
     [:dimensions {:optional true} [:vector string?]]
     [:metrics {:optional true} [:vector string?]]
     [:filters {:optional true} [:vector string?]]
     [:score {:optional true} nat-int?]
     [:affinity-name string?]
     [:base-dims dimension-set]]))

A sequence of affinity objects.

(def affinities-old
  (mc/schema
    [:sequential affinity-old]))

A map of named affinities to all dimension sets that are associated with this name.

(def affinity-matches
  (mc/schema
    [:map-of
     :string
     [:vector dimension-set]]))

A "thing" that we bind to, consisting, generally, of at least a name and id

(def item
  (mc/schema
    [:map
     [:id {:optional true} nat-int?]
     [:name {:optional true} string?]]))

A map of dimension name to dimension definition.

(def dim-name->dim-def
  (mc/schema
    [:map-of :string dimension-value]))

A map of named dimensions to a map containing the dimension data and a sequence of matching items satisfying this dimension

(def dim-name->matching-fields
  (mc/schema
    [:map-of :string
     [:map
      [:matches [:sequential item]]]]))

The "full" grounded dimensions which matches dimension names to the dimension definition combined with matching fields.

(def dim-name->dim-defs+matches
  (mut/merge
    dim-name->dim-def
    dim-name->matching-fields))

A map of dimension names to item satisfying that dimensions

(def dimension-map
  (mc/schema
    [:map-of :string item]))

A sequence of dimension maps

(def dimension-maps
  (mc/schema
    [:sequential dimension-map]))

A "normalized" metric template is a map containing the metric name as a key rather than a map of metric name to the map.

(def normalized-metric-template
  (mc/schema
    [:map
     [:metric-name :string]
     [:score nat-int?]
     [:metric vector?]]))

A metric containing a definition with actual field references/ids rather than dimension references.

(def grounded-metric
  (mc/schema
    [:map
     [:metric-name :string]
     [:metric-title :string]
     [:metric-score nat-int?]
     [:metric-definition
      [:map
       [:aggregation [:sequential any?]]]]]))

A grounded metric in which the metric has been augmented with breakouts.

(def combined-metric
  (mut/merge
    grounded-metric
    (mc/schema
      [:map
       [:metric-definition
        [:map
         [:aggregation [:sequential any?]]
         [:breakout [:sequential any?]]]]])))
(comment
  (require '[malli.generator :as mg])
  (mg/sample dashboard-template)
  (mg/sample affinities)
  (mg/sample affinity-matches)
  (mg/sample grounded-metric))
 
(ns metabase.automagic-dashboards.util
  (:require
   [buddy.core.codecs :as codecs]
   [cheshire.core :as json]
   [clojure.string :as str]
   [medley.core :as m]
   [metabase.mbql.predicates :as mbql.preds]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.field :refer [Field]]
   [metabase.models.interface :as mi]
   [metabase.sync.analyze.classify :as classify]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   #_{:clj-kondo/ignore [:deprecated-namespace]}
   [metabase.util.schema :as su]
   [ring.util.codec :as codec]
   [schema.core :as s]
   [toucan2.core :as t2]))

isa? on a field, checking semantictype and then basetype

(defn field-isa?
  [{:keys [base_type semantic_type]} t]
  (or (isa? (keyword semantic_type) t)
      (isa? (keyword base_type) t)))

Workaround for our leaky type system which conflates types with properties.

(defn key-col?
  [{:keys [base_type semantic_type name]}]
  (and (isa? base_type :type/Number)
       (or (#{:type/PK :type/FK} semantic_type)
           (let [name (u/lower-case-en name)]
             (or (= name "id")
                 (str/starts-with? name "id_")
                 (str/ends-with? name "_id"))))))

filter tables by tablespec, which is just an entity type (eg. :entity/GenericTable)

(defn filter-tables
  [tablespec tables]
  (filter #(-> % :entity_type (isa? tablespec)) tables))

Is metric a saved metric?

(def ^{:arglists '([metric]) :doc } saved-metric?
  (every-pred (partial mbql.u/is-clause? :metric)
              (complement mbql.u/ga-metric-or-segment?)))

Is this a custom expression?

(def ^{:arglists '([metric]) :doc } custom-expression?
  (partial mbql.u/is-clause? :aggregation-options))

Is this an adhoc metric?

(def ^{:arglists '([metric]) :doc } adhoc-metric?
  (complement (some-fn saved-metric? custom-expression?)))

Encode given object as base-64 encoded JSON.

(def ^{:arglists '([x]) :doc "Base64 encode"} encode-base64-json
  (comp codec/base64-encode codecs/str->bytes json/encode))

Is this a google analytics (ga) table?

(defn ga-table?
  [table]
  (isa? (:entity_type table) :entity/GoogleAnalyticsTable))
(s/defn field-reference->id :- (s/maybe (s/cond-pre su/NonBlankString su/IntGreaterThanZero))
  "Extract field ID from a given field reference form."
  [clause]
  (mbql.u/match-one clause [:field id _] id))
(mu/defn collect-field-references :- [:maybe [:sequential mbql.s/field]]
  "Collect all `:field` references from a given form."
  [form]
  (mbql.u/match form :field &match))
(mu/defn ->field :- [:maybe (ms/InstanceOf Field)]
  "Return `Field` instance for a given ID or name in the context of root."
  [{{result-metadata :result_metadata} :source, :as root}
   field-id-or-name-or-clause :- [:or ms/PositiveInt ms/NonBlankString [:fn mbql.preds/Field?]]]
  (let [id-or-name (if (sequential? field-id-or-name-or-clause)
                     (field-reference->id field-id-or-name-or-clause)
                     field-id-or-name-or-clause)]
    (or
     ;; Handle integer Field IDs.
     (when (integer? id-or-name)
       (t2/select-one Field :id id-or-name))
     ;; handle field string names. Only if we have result metadata. (Not sure why)
     (when (string? id-or-name)
       (when-not result-metadata
         (log/warn (trs "Warning: Automagic analysis context is missing result metadata. Unable to resolve Fields by name.")))
       (when-let [field (m/find-first #(= (:name %) id-or-name)
                                      result-metadata)]
         (as-> field field
           (update field :base_type keyword)
           (update field :semantic_type keyword)
           (mi/instance Field field)
           (classify/run-classifiers field {}))))
     ;; otherwise this isn't returning something, and that's probably an error. Log it.
     (log/warn (str (trs "Cannot resolve Field {0} in automagic analysis context" field-id-or-name-or-clause)
                    \newline
                    (u/pprint-to-str root))))))
 
(ns metabase.automagic-dashboards.visualization-macros)

Expand visualization macro.

(defmulti expand-visualization
  (fn [card _ _]
    (-> card :visualization first)))
(def ^:private ^:const ^Long smart-row-table-threshold 10)
(defmethod expand-visualization "smart-row"
  [card dimensions metrics]
  (let [[_display settings] (:visualization card)]
    (-> card
        (assoc :visualization (if (->> dimensions
                                       (keep #(get-in % [:fingerprint :global :distinct-count]))
                                       (apply max 0)
                                       (>= smart-row-table-threshold))
                                ["row" settings]
                                ["table" (merge {:column_settings {(->> metrics
                                                                        first
                                                                        :op
                                                                        (format "[\"name\",\"%s\"]")
                                                                        keyword) {:show_mini_bar true}}}
                                                settings)]))
        (update :order_by #(or % [{(-> card :metrics first) "descending"}])))))
(defmethod expand-visualization :default
  [card _ _]
  card)
 
(ns metabase.bootstrap
  (:gen-class)
  (:require [clojure.java.io :as io]))
(set! *warn-on-reflection* true)

athena includes log4j2.properties which is the first location checked for config. This takes precedence over our own log4j2.xml and dynamically reloads and kills useful logging. Should we move our log4j2.xml into metabase/metabase/log4j2.xml and refer to it that way so presumably no jar could add another log4j2.xml that we accidentally pick up?

(when-not (or (System/getProperty "log4j2.configurationFile")
              (System/getProperty "log4j.configurationFile"))
  ;; if the test config file from `test_resources` is on the claspath, e.g. in `clj -X:dev:test`, use that.
  (let [^String filename (if (io/resource "log4j2-test.xml")
                           "log4j2-test.xml"
                           "log4j2.xml")]
    (System/setProperty "log4j2.configurationFile" filename)))

ensure we use a BasicContextSelector instead of a ClassLoaderContextSelector for log4j2. Ensures there is only one LoggerContext instead of one per classpath root. Practical effect is that now (LogManager/getContext true) and (LogManager/getContext false) will return the same (and only) LoggerContext. https://logging.apache.org/log4j/2.x/manual/logsep.html

(System/setProperty "log4j2.contextSelector" "org.apache.logging.log4j.core.selector.BasicContextSelector")

ensure the [[clojure.tools.logging]] logger factory is the log4j2 version (slf4j is far slower and identified first)

(System/setProperty "clojure.tools.logging.factory" "clojure.tools.logging.impl/log4j2-factory")

Main entrypoint. Invokes [[metabase.core/entrypoint]]

(defn -main
  [& args]
  (apply (requiring-resolve 'metabase.core/entrypoint) args))
 

Functions for commands that can be ran from the command-line with the Clojure CLI or the Metabase JAR. These are ran as follows:

for example, running the migrate command and passing it force can be done using one of the following ways:

clojure -M:run migrate force java -jar metabase.jar migrate force

Logic below translates resolves the command itself to a function marked with ^:command metadata and calls the function with arguments as appropriate.

You can see what commands are available by running the command help. This command uses the docstrings and arglists associated with each command's entrypoint function to generate descriptions for each command.

(ns metabase.cmd
  (:refer-clojure :exclude [load import])
  (:require
   [clojure.string :as str]
   [clojure.tools.cli :as cli]
   [environ.core :as env]
   [metabase.config :as config]
   [metabase.mbql.util :as mbql.u]
   [metabase.plugins.classloader :as classloader]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]))
(set! *warn-on-reflection* true)

Command processing and option parsing utilities, etc.

Proxy function to System/exit to enable the use of with-redefs.

(defn- system-exit!
  [return-code]
  (System/exit return-code))

Looks up a command var by name

(defn- cmd->var
  [command-name]
  (ns-resolve 'metabase.cmd (symbol command-name)))

Resolves enterprise command by symbol and calls with args, or else throws error if not EE

(defn- call-enterprise
  [symb & args]
  (let [f (try
            (classloader/require (symbol (namespace symb)))
            (or (resolve symb)
                (throw (ex-info (trs "{0} does not exist" symb) {})))
            (catch Throwable e
              (throw (ex-info (trs "The ''{0}'' command is only available in Metabase Enterprise Edition." (name symb))
                              {:command symb}
                              e))))]
    (apply f args)))
(defn- get-parsed-options
  [iref options]
  (:options (cli/parse-opts options (:arg-spec (meta iref)))))

Command implementations

Run database migrations. Valid options for direction are up, force, down, print, or release-locks.

(defn ^:command migrate
  [direction]
  (classloader/require 'metabase.cmd.migrate)
  ((resolve 'metabase.cmd.migrate/migrate!) direction))

Transfer data from existing H2 database to the newly created MySQL or Postgres DB specified by env vars.

(defn ^:command load-from-h2
  ([]
   (load-from-h2 nil))
  ([h2-connection-string]
   (classloader/require 'metabase.cmd.load-from-h2)
   ((resolve 'metabase.cmd.load-from-h2/load-from-h2!) h2-connection-string)))
(defn ^:command dump-to-h2
  {:doc "Transfer data from existing database to newly created H2 DB with specified filename.
         Target H2 file is deleted before dump, unless the --keep-existing flag is given."
   :arg-spec [["-k" "--keep-existing" "Do not delete target H2 file if it exists."
               :id :keep-existing?]
              ["-p" "--dump-plaintext" "Do not encrypt dumped contents."
               :id :dump-plaintext?]]}
  [h2-filename & opts]
  (classloader/require 'metabase.cmd.dump-to-h2)
  (try
    (let [options (get-parsed-options #'dump-to-h2 opts)]
      ((resolve 'metabase.cmd.dump-to-h2/dump-to-h2!) h2-filename options)
      (println "Dump complete")
      (system-exit! 0))
    (catch Throwable e
      (log/error e "Failed to dump application database to H2 file")
      (system-exit! 1))))

Start Metabase the usual way and exit. Useful for profiling Metabase launch time.

(defn ^:command profile
  []
  ;; override env var that would normally make Jetty block forever
  (alter-var-root #'env/env assoc :mb-jetty-join "false")
  (u/profile "start-normally" ((resolve 'metabase.core/start-normally))))

Reset the password for a user with email-address.

(defn ^:command reset-password
  [email-address]
  (classloader/require 'metabase.cmd.reset-password)
  ((resolve 'metabase.cmd.reset-password/reset-password!) email-address))

Show this help message listing valid Metabase commands.

(defn ^:command help
  ([command-name]
   (let [{:keys [doc arg-spec arglists]} (meta (cmd->var command-name))]
     (doseq [arglist arglists]
       (apply println command-name arglist))
     (when doc
       (doseq [doc-line (str/split doc #"\n\s+")]
         (println "\t" doc-line)))
     (when arg-spec
       (println "\t" "Options:")
       (doseq [opt-line (str/split (:summary (cli/parse-opts [] arg-spec)) #"\n")]
         (println "\t" opt-line)))))
  ([]
   (println "Valid commands are:")
   (doseq [[symb varr] (sort (ns-interns 'metabase.cmd))
           :when       (:command (meta varr))]
     (help symb)
     (println))
   (println "\nSome other commands you might find useful:\n")
   (println "java -cp metabase.jar org.h2.tools.Shell -url jdbc:h2:/path/to/metabase.db")
   (println "\tOpen an SQL shell for the Metabase H2 DB")))

Print version information about Metabase and the current system.

(defn ^:command version
  []
  (println "Metabase version:" config/mb-version-info)
  (println "\nOS:"
           (System/getProperty "os.name")
           (System/getProperty "os.version")
           (System/getProperty "os.arch"))
  (println "\nJava version:"
           (System/getProperty "java.vm.name")
           (System/getProperty "java.version"))
  (println "\nCountry:"       (System/getProperty "user.country"))
  (println "System timezone:" (System/getProperty "user.timezone"))
  (println "Language:"        (System/getProperty "user.language"))
  (println "File encoding:"   (System/getProperty "file.encoding")))

Generate a markdown file containing documentation for all API endpoints. This is written to a file called docs/api-documentation.md.

(defn ^:command api-documentation
  []
  (classloader/require 'metabase.cmd.endpoint-dox)
  ((resolve 'metabase.cmd.endpoint-dox/generate-dox!)))

Generates a markdown file containing documentation for environment variables relevant to configuring Metabase. The command only includes environment variables registered as defsettings. For a full list of environment variables, see https://www.metabase.com/docs/latest/configuring-metabase/environment-variables.

(defn ^:command environment-variables-documentation
  []
  (classloader/require 'metabase.cmd.env-var-dox)
  ((resolve 'metabase.cmd.env-var-dox/generate-dox!)))

Print a list of all multimethods available for a driver to implement, optionally with their docstrings.

(defn ^:command driver-methods
  ([]
   (classloader/require 'metabase.cmd.driver-methods)
   ((resolve 'metabase.cmd.driver-methods/print-available-multimethods) false))
  ([_docs]
   (classloader/require 'metabase.cmd.driver-methods)
   ((resolve 'metabase.cmd.driver-methods/print-available-multimethods) true)))
(defn ^:command load
  {:doc "Note: this command is deprecated. Use `import` instead.
         Load serialized Metabase instance as created by [[dump]] command from directory `path`."
   :arg-spec [["-m" "--mode (skip|update)" "Update or skip on conflicts."
               :default      :skip
               :default-desc "skip"
               :parse-fn     mbql.u/normalize-token
               :validate     [#{:skip :update} "Must be 'skip' or 'update'"]]
              ["-e" "--on-error (continue|abort)"  "Abort or continue on error."
               :default      :continue
               :default-desc "continue"
               :parse-fn     mbql.u/normalize-token
               :validate     [#{:continue :abort} "Must be 'continue' or 'abort'"]]]}
  [path & options]
  (log/warn (u/colorize :red (trs "''load'' is deprecated and will be removed in a future release. Please migrate to ''import''.")))
  (call-enterprise 'metabase-enterprise.serialization.cmd/v1-load! path (get-parsed-options #'load options)))
(defn ^:command import
  {:doc "Load serialized Metabase instance as created by the [[export]] command from directory `path`."
   :arg-spec [["-e" "--abort-on-error" "Stops import on any errors, default is to continue."]]}
  [path & options]
  (call-enterprise 'metabase-enterprise.serialization.cmd/v2-load! path (get-parsed-options #'import options)))
(defn ^:command dump
  {:doc "Note: this command is deprecated. Use `export` instead.
         Serializes Metabase instance into directory `path`."
   :arg-spec [["-u" "--user EMAIL"         "Export collections owned by the specified user"]
              ["-s" "--state (active|all)" "When set to `active`, do not dump archived entities. Default behavior is `all`."
               :default      :all
               :default-desc "all"
               :parse-fn     mbql.u/normalize-token
               :validate     [#{:active :all} "Must be 'active' or 'all'"]]]}
  [path & options]
  (log/warn (u/colorize :red (trs "''dump'' is deprecated and will be removed in a future release. Please migrate to ''export''.")))
  (call-enterprise 'metabase-enterprise.serialization.cmd/v1-dump! path (get-parsed-options #'dump options)))
(defn ^:command export
  {:doc "Serialize Metabase instance into directory at `path`."
   :arg-spec [["-c" "--collection ID"            "Export only specified ID(s). Use commas to separate multiple IDs."
               :id        :collection-ids
               :parse-fn  (fn [raw-string] (map parse-long (str/split raw-string #"\s*,\s*")))]
              ["-C" "--no-collections"           "Do not export any content in collections."]
              ["-S" "--no-settings"              "Do not export settings.yaml"]
              ["-D" "--no-data-model"            "Do not export any data model entities; useful for subsequent exports."]
              ["-f" "--include-field-values"     "Include field values along with field metadata."]
              ["-s" "--include-database-secrets" "Include database connection details (in plain text; use caution)."]]}
  [path & options]
  (call-enterprise 'metabase-enterprise.serialization.cmd/v2-dump! path (get-parsed-options #'export options)))

Add entity IDs for instances of serializable models that don't already have them.

(defn ^:command seed-entity-ids
  []
  (when-not (call-enterprise 'metabase-enterprise.serialization.cmd/seed-entity-ids!)
    (throw (Exception. "Error encountered while seeding entity IDs"))))

Drop entity IDs for instances of serializable models. Useful for migrating from v1 serialization (x.46 and earlier) to v2 (x.47+).

(defn ^:command drop-entity-ids
  []
  (when-not (call-enterprise 'metabase-enterprise.serialization.cmd/drop-entity-ids!)
    (throw (Exception. "Error encountered while dropping entity IDs"))))

Rotate the encryption key of a metabase database. The MBENCRYPTIONSECRET_KEY environment variable has to be set to the current key, and the parameter new-key has to be the new key. new-key has to be at least 16 chars.

(defn ^:command rotate-encryption-key
  [new-key]
  (classloader/require 'metabase.cmd.rotate-encryption-key)
  (try
    ((resolve 'metabase.cmd.rotate-encryption-key/rotate-encryption-key!) new-key)
    (log/info "Encryption key rotation OK.")
    (system-exit! 0)
    (catch Throwable _e
      (log/error "ERROR ROTATING KEY.")
      (system-exit! 1))))

------------------------------------------------ Validate Commands ----------------------------------------------

(defn- arg-list-count-ok? [arg-list arg-count]
  (if (some #{'&} arg-list)
    ;; subtract 1 for the & and 1 for the symbol after &
    ;; e.g. [a b & c] => 2
    (>= arg-count (- (count arg-list) 2))
    (= arg-count (count arg-list))))
(defn- arg-count-errors
  [command-name args]
  (let [arg-lists (-> command-name cmd->var meta :arglists)]
    (when-not (some #(arg-list-count-ok? % (count args)) arg-lists)
      (str "The '" command-name "' command requires "
           (when (> 1 (count arg-lists)) "one of ")
           "the following arguments: "
           (str/join " | " (map pr-str arg-lists))
           ", but received: " (pr-str (vec args)) "."))))

------------------------------------------------ Running Commands ------------------------------------------------

Returns [error-message] if there is an error, otherwise [nil command-fn]

(defn- validate
  [command-name args]
  (let [varr (cmd->var command-name)
        {:keys [command arg-spec]} (meta varr)
        err  (arg-count-errors command-name args)]
    (cond
      (not command)
      [(str "Unrecognized command: '" command-name "'")
       (str "Valid commands: " (str/join ", " (map key (filter (comp :command meta val) (ns-interns 'metabase.cmd)))))]
      err
      [err]
      arg-spec
      (:errors (cli/parse-opts args arg-spec)))))
(defn- fail!
  [& messages]
  (doseq [msg messages]
    (println (u/format-color 'red msg)))
  (System/exit 1))

Run cmd with args. This is a function above. e.g. clojure -M:run metabase migrate force becomes (migrate "force").

(defn run-cmd
  [command-name args]
  (if-let [errors (validate command-name args)]
    (do
      (when (cmd->var command-name)
        (println "Usage:")
        (help command-name))
      (apply fail! errors))
    (try
      (apply @(cmd->var command-name) args)
      (catch Throwable e
        (.printStackTrace e)
        (fail! (str "Command failed with exception: " (.getMessage e))))))
  (System/exit 0))
 

Shared lower-level implementation of the [[metabase.cmd.dump-to-h2/dump-to-h2!]] and [[metabase.cmd.load-from-h2/load-from-h2!]] commands. The [[copy!]] function implemented here supports loading data from an application database to any empty application database for all combinations of supported application database types.

(ns metabase.cmd.copy
  (:require
   [clojure.java.jdbc :as jdbc]
   [honey.sql :as sql]
   [metabase.config :as config]
   [metabase.db.connection :as mdb.connection]
   #_{:clj-kondo/ignore [:deprecated-namespace]}
   [metabase.db.setup :as mdb.setup]
   [metabase.plugins.classloader :as classloader]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [schema.core :as s]
   [toucan2.core :as t2])
  (:import
   (java.sql SQLException)))
(set! *warn-on-reflection* true)
(defn- log-ok []
  (log/info (u/colorize 'green "[OK]")))
(defn- do-step [msg f]
  (log/info (str (u/colorize 'blue msg) " "))
  (try
    (f)
    (catch Throwable e
      (log/error (u/colorize 'red "[FAIL]\n"))
      (throw (ex-info (trs "ERROR {0}: {1}" msg (ex-message e))
                      {}
                      e))))
  (log-ok))

Convenience for executing body with some extra logging.

(defmacro ^:private step
  {:style/indent 1}
  [msg & body]
  `(do-step ~msg (fn [] ~@body)))

Entities in the order they should be serialized/deserialized. This is done so we make sure that we load instances of entities before others that might depend on them, e.g. Databases before Tables before Fields.

(def entities
  (concat
   [:model/Database
    :model/User
    :model/Setting
    :model/Table
    :model/Field
    :model/FieldValues
    :model/Segment
    :model/Metric
    :model/MetricImportantField
    :model/ModerationReview
    :model/Revision
    :model/ViewLog
    :model/Session
    :model/Collection
    :model/CollectionPermissionGraphRevision
    :model/Dashboard
    :model/Card
    :model/CardBookmark
    :model/DashboardBookmark
    :model/CollectionBookmark
    :model/BookmarkOrdering
    :model/DashboardCard
    :model/DashboardCardSeries
    :model/Activity
    :model/Pulse
    :model/PulseCard
    :model/PulseChannel
    :model/PulseChannelRecipient
    :model/PermissionsGroup
    :model/PermissionsGroupMembership
    :model/Permissions
    :model/PermissionsRevision
    :model/PersistedInfo
    :model/ApplicationPermissionsRevision
    :model/Dimension
    :model/NativeQuerySnippet
    :model/LoginHistory
    :model/Timeline
    :model/TimelineEvent
    :model/Secret
    :model/ParameterCard
    :model/Action
    :model/ImplicitAction
    :model/HTTPAction
    :model/QueryAction
    :model/DashboardTab
    :model/ModelIndex
    :model/ModelIndexValue
    ;; 48+
    :model/TablePrivileges
    :model/AuditLog
    :model/RecentViews]
   (when config/ee-available?
     [:model/GroupTableAccessPolicy
      :model/ConnectionImpersonation])))

Given a sequence of objects/rows fetched from the H2 DB, return a the columns that should be used in the INSERT statement, and a sequence of rows (as sequences).

(defn- objects->colums+values
  [target-db-type objs]
  ;; Need to wrap the column names in quotes because Postgres automatically lowercases unquoted identifiers. (This
  ;; should be ok now that #16344 is resolved -- we might be able to remove this code entirely now. Quoting identifiers
  ;; is still a good idea tho.)
  (let [source-keys (keys (first objs))
        quote-fn    (partial mdb.setup/quote-for-application-db (mdb.connection/quoting-style target-db-type))
        dest-keys   (for [k source-keys]
                      (quote-fn (name k)))]
    {:cols dest-keys
     :vals (for [row objs]
             (map row source-keys))}))
(def ^:private chunk-size 100)

Insert of chunkk of rows into the target database table with table-name.

(defn- insert-chunk!
  [target-db-type target-db-conn-spec table-name chunkk]
  (log/debugf "Inserting chunk of %d rows" (count chunkk))
  (try
    (let [{:keys [cols vals]} (objects->colums+values target-db-type chunkk)]
      (jdbc/insert-multi! target-db-conn-spec table-name cols vals {:transaction? false}))
    (catch SQLException e
      (log/error (with-out-str (jdbc/print-sql-exception-chain e)))
      (throw e))))

Whether [[copy-data!]] (and thus [[metabase.cmd.load-from-h2/load-from-h2!]]) should copy connection details for H2 Databases from the source application database. Normally disabled for security reasons. This is only here so we can disable this check for tests.

(def ^:dynamic *copy-h2-database-details*
  false)
(defn- model-select-fragment
  [model]
  (case model
    :model/Field {:order-by [[:id :asc]]}
    nil))
(defn- sql-for-selecting-instances-from-source-db [model]
  (first
   (sql/format
    (merge {:select [[:*]]
            :from   [[(t2/table-name model)]]}
           (model-select-fragment model))
    {:quoted false})))
(defn- model-results-xform [model]
  (case model
    :model/Database
    ;; For security purposes, do NOT copy connection details for H2 Databases by default; replace them with an empty map.
    ;; Why? Because this is a potential pathway to injecting sneaky H2 connection parameters that cause RCEs. For the
    ;; Sample Database, the correct details are reset automatically on every
    ;; launch (see [[metabase.sample-data/update-sample-database-if-needed!]]), and we don't support connecting other H2
    ;; Databases in prod anyway, so this ultimately shouldn't cause anyone any problems.
    (if *copy-h2-database-details*
      identity
      (map (fn [database]
             (cond-> database
               (= (:engine database) "h2") (assoc :details "{}")))))
    ;; else
    identity))
(defn- copy-data! [^javax.sql.DataSource source-data-source target-db-type target-db-conn-spec]
  (with-open [source-conn (.getConnection source-data-source)]
    (doseq [model entities
            :let  [table-name (t2/table-name model)
                   sql        (sql-for-selecting-instances-from-source-db model)
                   results    (jdbc/reducible-query {:connection source-conn} sql)]]
      (transduce
       (comp (model-results-xform model)
             (partition-all chunk-size))
       ;; cnt    = the total number we've inserted so far
       ;; chunkk = current chunk to insert
       (fn
         ([cnt]
          (when (pos? cnt)
            (log/info (str " " (u/colorize 'green (trs "copied {0} instances." cnt))))))
         ([cnt chunkk]
          (when (seq chunkk)
            (when (zero? cnt)
              (log/info (u/colorize 'blue (trs "Copying instances of {0}..." (name model)))))
            (try
              (insert-chunk! target-db-type target-db-conn-spec table-name chunkk)
              (catch Throwable e
                (throw (ex-info (trs "Error copying instances of {0}" (name model))
                                {:model (name model)}
                                e)))))
          (+ cnt (count chunkk))))
       0
       results))))

Make sure [target] application DB is empty before we start copying data.

(defn- assert-db-empty
  [data-source]
  ;; check that there are no Users yet
  (let [[{:keys [cnt]}] (jdbc/query {:datasource data-source} "SELECT count(*) AS cnt FROM core_user;")]
    (assert (integer? cnt))
    (when (pos? cnt)
      (throw (ex-info (trs "Target DB is already populated!")
                      {})))))
(defn- do-with-connection-rollback-only [conn f]
  (jdbc/db-set-rollback-only! conn)
  (f)
  (jdbc/db-unset-rollback-only! conn))

Make database transaction connection conn rollback-only until body completes successfully; then and only then disable rollback-only. This basically makes the load data operation an all-or-nothing affair (if it fails at some point, the whole transaction will rollback).

(defmacro ^:private with-connection-rollback-only
  {:style/indent 1}
  [conn & body]
  `(do-with-connection-rollback-only ~conn (fn [] ~@body)))
(defmulti ^:private disable-db-constraints!
  {:arglists '([db-type conn-spec])}
  (fn [db-type _]
    db-type))
(defmethod disable-db-constraints! :postgres
  [_ conn]
  ;; make all of our FK constraints deferrable. This only works on Postgres 9.4+ (December 2014)! (There's no pressing
  ;; reason to turn these back on at the conclusion of this script. It makes things more complicated since it doesn't
  ;; work if done inside the same transaction.)
  (doseq [{constraint :constraint_name, table :table_name} (jdbc/query
                                                            conn
                                                            [(str "SELECT * "
                                                                  "FROM information_schema.table_constraints "
                                                                  "WHERE constraint_type = 'FOREIGN KEY'")])]
    (jdbc/execute! conn [(format "ALTER TABLE \"%s\" ALTER CONSTRAINT \"%s\" DEFERRABLE" table constraint)]))
  ;; now enable constraint deferring for the duration of the transaction
  (jdbc/execute! conn ["SET CONSTRAINTS ALL DEFERRED"]))
(defmethod disable-db-constraints! :mysql
  [_ conn]
  (jdbc/execute! conn ["SET FOREIGN_KEY_CHECKS=0"]))
(defmethod disable-db-constraints! :h2
  [_ conn]
  (jdbc/execute! conn "SET REFERENTIAL_INTEGRITY FALSE"))
(defmulti ^:private reenable-db-constraints!
  {:arglists '([db-type conn-spec])}
  (fn [db-type _]
    db-type))
(defmethod reenable-db-constraints! :default [_ _]) ; no-op

For MySQL we need to re-enable FK checks when we're done

(defmethod reenable-db-constraints! :mysql
  [_ conn]
  (jdbc/execute! conn ["SET FOREIGN_KEY_CHECKS=1"]))
(defmethod reenable-db-constraints! :h2
  [_ conn]
  (jdbc/execute! conn "SET REFERENTIAL_INTEGRITY TRUE"))
(defn- do-with-disabled-db-constraints [db-type conn f]
  (step (trs "Temporarily disabling DB constraints...")
    (disable-db-constraints! db-type conn))
  (try
    (f)
    (finally
      (step (trs "Re-enabling DB constraints...")
        (reenable-db-constraints! db-type conn)))))

Disable foreign key constraints for the duration of body.

(defmacro ^:private with-disabled-db-constraints
  {:style/indent 2}
  [db-type conn & body]
  `(do-with-disabled-db-constraints ~db-type ~conn (fn [] ~@body)))

Make sure the target database is empty -- rows created by migrations (such as the magic permissions groups and default perms entries) need to be deleted so we can copy everything over from the source DB without running into conflicts.

(defn- clear-existing-rows!
  [target-db-type ^javax.sql.DataSource target-data-source]
  (with-open [conn (.getConnection target-data-source)
              stmt (.createStatement conn)]
    (with-disabled-db-constraints target-db-type {:connection conn}
      (try
        (.setAutoCommit conn false)
        (let [save-point (.setSavepoint conn)]
          (try
            (letfn [(add-batch! [^String sql]
                      (log/debug (u/colorize :yellow sql))
                      (.addBatch stmt sql))]
              ;; do these in reverse order so child rows get deleted before parents
              (doseq [table-name (map t2/table-name (reverse entities))]
                (add-batch! (format (if (= target-db-type :postgres)
                                      "TRUNCATE TABLE %s CASCADE;"
                                      "TRUNCATE TABLE %s;")
                                    (name table-name)))))
            (.executeBatch stmt)
            (.commit conn)
            (catch Throwable e
              (try
                (.rollback conn save-point)
                (catch Throwable e2
                  (throw (Exception. (ex-message e2) e))))
              (throw e))))
        (finally
          (.setAutoCommit conn true))))))

Entities that do NOT use an auto incrementing ID column.

(def ^:private entities-without-autoinc-ids
  #{:model/Setting
    :model/Session
    :model/ImplicitAction
    :model/HTTPAction
    :model/QueryAction
    :model/ModelIndexValue
    :model/TablePrivileges})
(defmulti ^:private postgres-id-sequence-name
  {:arglists '([model])}
  keyword)
(defmethod postgres-id-sequence-name :default
  [model]
  (str (name (t2/table-name model)) "_id_seq"))

we changed the table name to sandboxes but never updated the underlying ID sequences or constraint names.

(defmethod postgres-id-sequence-name :model/GroupTableAccessPolicy
  [_model]
  "group_table_access_policy_id_seq")
(defmulti ^:private update-sequence-values!
  {:arglists '([db-type data-source])}
  (fn [db-type _]
    db-type))
(defmethod update-sequence-values! :default [_ _]) ; no-op

Update the sequence nextvals.

(defmethod update-sequence-values! :postgres
  [_db-type data-source]
  #_{:clj-kondo/ignore [:discouraged-var]}
  (jdbc/with-db-transaction [target-db-conn {:datasource data-source}]
    (step (trs "Setting Postgres sequence ids to proper values...")
      (doseq [model entities
              :when (not (contains? entities-without-autoinc-ids model))
              :let  [table-name (name (t2/table-name model))
                     seq-name   (postgres-id-sequence-name model)
                     sql        (format "SELECT setval('%s', COALESCE((SELECT MAX(id) FROM %s), 1), true) as val"
                                        seq-name (name table-name))]]
        (try
          (jdbc/db-query-with-resultset target-db-conn [sql] :val)
          (catch Throwable e
            (throw (ex-info (format "Error updating sequence values for %s: %s" model (ex-message e))
                            {:model model}
                            e))))))))
(defmethod update-sequence-values! :h2
  [_db-type data-source]
  #_{:clj-kondo/ignore [:discouraged-var]}
  (jdbc/with-db-transaction [target-db-conn {:datasource data-source}]
    (step (trs "Setting H2 sequence ids to proper values...")
      (doseq [e     entities
              :when (not (contains? entities-without-autoinc-ids e))
              :let  [table-name (name (t2/table-name e))
                     sql        (format "ALTER TABLE %s ALTER COLUMN ID RESTART WITH COALESCE((SELECT MAX(ID) + 1 FROM %s), 1)"
                                        table-name table-name)]]
        (jdbc/execute! target-db-conn sql)))))

Copy data from a source application database into an empty destination application database.

(s/defn copy!
  [source-db-type     :- (s/enum :h2 :postgres :mysql)
   source-data-source :- javax.sql.DataSource
   target-db-type     :- (s/enum :h2 :postgres :mysql)
   target-data-source :- javax.sql.DataSource]
  ;; make sure the entire system is loaded before running this test, to make sure we account for all the models.
  (doseq [ns-symb u/metabase-namespace-symbols]
    (classloader/require ns-symb))
  ;; make sure the source database is up-do-date
  (step (trs "Set up {0} source database and run migrations..." (name source-db-type))
    (mdb.setup/setup-db! source-db-type source-data-source true))
  ;; make sure the dest DB is up-to-date
  ;;
  ;; don't need or want to run data migrations in the target DB, since the data is already migrated appropriately
  (step (trs "Set up {0} target database and run migrations..." (name target-db-type))
    (mdb.setup/setup-db! target-db-type target-data-source true))
  ;; make sure target DB is empty
  (step (trs "Testing if target {0} database is already populated..." (name target-db-type))
    (assert-db-empty target-data-source))
  ;; clear any rows created by the Liquibase migrations.
  (step (trs "Clearing default entries created by Liquibase migrations...")
    (clear-existing-rows! target-db-type target-data-source))
  ;; create a transaction and load the data.
  #_{:clj-kondo/ignore [:discouraged-var]}
  (jdbc/with-db-transaction [target-conn-spec {:datasource target-data-source}]
    ;; transaction should be set as rollback-only until it completes. Only then should we disable rollback-only so the
    ;; transaction will commit (i.e., only commit if the whole thing succeeds)
    (with-connection-rollback-only target-conn-spec
      ;; disable FK constraints for the duration of loading data.
      (with-disabled-db-constraints target-db-type target-conn-spec
        (copy-data! source-data-source target-db-type target-conn-spec))))
  ;; finally, update sequence values (if needed)
  (update-sequence-values! target-db-type target-data-source))
 

Functions for working with H2 databases shared between the load-from-h2 and dump-to-h2 commands.

(ns metabase.cmd.copy.h2
  (:require
   [clojure.java.io :as io]
   [clojure.string :as str]
   [metabase.db.data-source :as mdb.data-source]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]))
(set! *warn-on-reflection* true)
(defn- add-file-prefix-if-needed [h2-filename]
  (letfn [(prepend-protocol [s]
            (str "file:" (.getAbsolutePath (io/file s))))
          (remove-extension [s]
            (str/replace s #"\.mv\.db$" ))]
    (cond-> h2-filename
      (not (str/starts-with? h2-filename "file:"))
      prepend-protocol
      (str/ends-with? h2-filename ".mv.db")
      remove-extension)))

Create a [[javax.sql.DataSource]] for the H2 database with h2-filename.

(defn h2-data-source
  ^javax.sql.DataSource [h2-filename]
  (let [h2-filename (add-file-prefix-if-needed h2-filename)]
    (mdb.data-source/broken-out-details->DataSource :h2 {:db h2-filename})))

Delete existing h2 database files.

(defn delete-existing-h2-database-files!
  [h2-filename]
  (doseq [filename [h2-filename
                    (str h2-filename ".mv.db")]]
    (when (.exists (io/file filename))
      (io/delete-file filename)
      (log/warn (u/format-color 'red (trs "Output H2 database already exists: %s, removing.") filename)))))
 
(ns metabase.cmd.driver-methods
  (:require
   [clojure.java.classpath :as classpath]
   [clojure.string :as str]
   [clojure.tools.namespace.find :as ns.find]
   [metabase.plugins.classloader :as classloader]
   [metabase.util :as u]))
(defn- driver-ns-symbs []
  (sort
   (for [ns-symb (ns.find/find-namespaces (classpath/system-classpath))
         :let    [starts-with? (partial str/starts-with? (name ns-symb))]
         :when   (and (or (starts-with? "metabase.driver")
                          (starts-with? "metabase.test.data"))
                      (do
                        (u/ignore-exceptions (classloader/require ns-symb))
                        (find-ns ns-symb)))]
     ns-symb)))
(defn- available-multimethods
  ([]
   (for [ns-symb (driver-ns-symbs)
         :let    [multimethods (available-multimethods ns-symb)]
         :when   (seq multimethods)]
     [(ns-name ns-symb) multimethods]))
  ([ns-symb]
   (sort
    (for [[symb varr] (ns-publics ns-symb)
          :when       (instance? clojure.lang.MultiFn @varr)]
      [symb varr]))))

Print a list of all multimethods available for a driver to implement, and maybe their docstrings.

(defn print-available-multimethods
  [docstring]
  (doseq [[namespc multimethods] (available-multimethods)]
    (println (u/format-color 'blue namespc))
    (doseq [[symb varr] multimethods]
      (println (str/join " " (cons (u/format-color 'green symb) (:arglists (meta varr)))))
      (when docstring (println (:doc (meta varr)) "\n")))))
 

Commands for dumping data to an H2 file from app database.

Run this as follows (h2 filename is optional):

clojure -M:run dump-to-h2 '/path/to/metabase.db/'

or

java -jar metabase.jar dump-to-h2

Validate with:

clojure -M:run load-from-h2 '"/path/to/metabase.db"'

(ns metabase.cmd.dump-to-h2
  (:require
   [metabase.cmd.copy :as copy]
   [metabase.cmd.copy.h2 :as copy.h2]
   [metabase.cmd.rotate-encryption-key :as rotate-encryption]
   [metabase.db.connection :as mdb.connection]
   [metabase.util.log :as log]))

Transfer data from existing database specified by connection string to the H2 DB specified by env vars. Intended as a tool for migrating from one instance to another using H2 as serialization target.

Defaults to using [[metabase.db.env/db-file]] as the connection string.

Target H2 DB will be deleted if it exists, unless keep-existing? is truthy.

(defn dump-to-h2!
  ([h2-filename]
   (dump-to-h2! h2-filename nil))
  ([h2-filename {:keys [keep-existing? dump-plaintext?]
                 :or   {keep-existing? false dump-plaintext? false}}]
   (let [h2-filename    (or h2-filename "metabase_dump.h2")
         h2-data-source (copy.h2/h2-data-source h2-filename)]
     (log/infof "Dumping from configured Metabase db to H2 file %s" h2-filename)
     (when-not keep-existing?
       (copy.h2/delete-existing-h2-database-files! h2-filename))
     (copy/copy! (mdb.connection/db-type) (mdb.connection/data-source) :h2 h2-data-source)
     (when dump-plaintext?
       (binding [mdb.connection/*application-db* (mdb.connection/application-db :h2 h2-data-source)]
         (rotate-encryption/rotate-encryption-key! nil))))))
 

Implementation for the api-documentation command, which generates doc pages for API endpoints.

(ns metabase.cmd.endpoint-dox
  (:require
   [clojure.java.classpath :as classpath]
   [clojure.java.io :as io]
   [clojure.string :as str]
   [clojure.tools.namespace.find :as ns.find]
   [metabase.config :as config]
   [metabase.plugins.classloader :as classloader]
   [metabase.util :as u]))

API docs intro

Exists just so we can write the intro in Markdown.

(defn- api-docs-intro
  []
  (str (slurp "src/metabase/cmd/resources/api-intro.md") "\n\n"))

API docs page title

Some paid endpoints have different formatting. This way we don't combine the api/table endpoint with sandbox.api.table, for example.

(defn- handle-enterprise-ns
  [endpoint]
  (if (str/includes? endpoint "metabase-enterprise")
    (str/split endpoint #"metabase-enterprise.")
    (str/split endpoint #"\.")))

Used to format initialisms/acronyms in generated docs.

(def initialisms  '["SSO" "SAML" "GTAP" "LDAP" "SQL" "JSON"])

Converts initialisms to upper case.

(defn capitalize-initialisms
  [name initialisms]
  (let [re (re-pattern (str "(?i)(?:" (str/join "|" initialisms) ")"))
        matches (re-seq re name)]
    (if matches
      (reduce (fn [n m] (str/replace n m (u/upper-case-en m))) name matches)
      name)))

Creates a name for endpoints in a namespace, like all the endpoints for Alerts. Handles some edge cases for enterprise endpoints.

(defn- endpoint-ns-name
  [endpoint]
  (-> (:ns endpoint)
      ns-name
      name
      handle-enterprise-ns
      last
      u/capitalize-first-char
      (str/replace #"(.api.|-)" " ")
      (capitalize-initialisms initialisms)
      (str/replace "SSO SSO" "SSO")))

Used for formatting YAML string punctuation for frontmatter descriptions.

(defn- handle-quotes
  [s]
  (-> s
      (str/replace #"\"" "'")
      str/split-lines
      (#(str/join "\n  " %))))

Formats description for YAML frontmatter.

(defn- format-frontmatter-description
  [desc]
  (str "|\n  " (handle-quotes desc)))

Used to grab namespace description, if it exists.

(defn- get-description
  [ep ep-data]
  (let [desc (-> ep-data
                 first
                 :ns
                 meta
                 :doc
                 u/add-period)]
    (if (str/blank? desc)
      (u/add-period (str "API endpoints for " ep))
      desc)))

Formats frontmatter, which includes title and summary, if any.

(defn- endpoint-page-frontmatter
  [ep ep-data]
  (let [desc (format-frontmatter-description (get-description ep ep-data))]
    (str "---\ntitle: \"" ep "\""
         "\nsummary: " desc "\n---\n\n")))

Creates a page title for a set of endpoints, e.g., # Card.

(defn- endpoint-page-title
  [ep-title]
  (str "# " ep-title "\n\n"))

API endpoint description

If there is a namespace docstring, include the docstring with a paragraph break.

(defn- endpoint-page-description
  [ep ep-data]
  (let [desc (get-description ep ep-data)]
    (if (str/blank? desc)
      desc
      (str desc "\n\n"))))

API endpoints

Creates a name for an endpoint: VERB /path/to/endpoint. Used to build anchor links in the table of contents.

(defn- endpoint-str
  [endpoint]
  (-> (:doc endpoint)
      (str/split #"\n")
      first
      str/trim))

Decorates endpoints with strings for building API endpoint pages.

(defn- process-endpoint
  [endpoint]
  (assoc endpoint
         :endpoint-str (endpoint-str endpoint)
         :ns-name (endpoint-ns-name endpoint)))
(defn- api-namespaces []
  (for [ns-symb (ns.find/find-namespaces (classpath/system-classpath))
        :when   (and (re-find #"^metabase(?:-enterprise\.[\w-]+)?\.api\." (name ns-symb))
                     (not (str/includes? (name ns-symb) "test")))]
    ns-symb))

Gets a list of all API endpoints.

(defn- collect-endpoints
  []
  (for [ns-symb     (api-namespaces)
        [_sym varr] (do (classloader/require ns-symb)
                        (sort (ns-interns ns-symb)))
        :when       (:is-endpoint? (meta varr))]
    (meta varr)))

Builds a list of endpoints and their parameters. Relies on docstring generation in /api/common/internal.clj.

(defn- endpoint-docs
  [ep-data]
  (str/join "\n\n" (map #(str/trim (:doc %)) ep-data)))

Is the endpoint a paid feature?

(defn- paid?
  [ep-data]
  (or (str/includes? (:endpoint-str (first ep-data)) "/api/ee")
      ;; some ee endpoints are inconsistent in naming, see #22687
      (str/includes? (:endpoint-str (first ep-data)) "/api/mt")
      (= 'metabase-enterprise.sandbox.api.table (ns-name (:ns (first ep-data))))
      (str/includes? (:endpoint-str (first ep-data)) "/auth/sso")
      (str/includes? (:endpoint-str (first ep-data)) "/api/moderation-review")))

Adds a footer with a link back to the API index.

(defn endpoint-footer
  [ep-data]
  (let [level (if (paid? ep-data) "../../" "../")]
    (str "\n\n---\n\n[<< Back to API index](" level "api-documentation.md)")))

Build API pages

Builds a page with the name, description, table of contents for endpoints in a namespace, followed by the endpoint and their parameter descriptions.

(defn endpoint-page
  [ep ep-data]
  (apply str
         (endpoint-page-frontmatter ep ep-data)
         (endpoint-page-title ep)
         (endpoint-page-description ep ep-data)
         (endpoint-docs ep-data)
         (endpoint-footer ep-data)))

Creates a filepath from an endpoint.

(defn- build-filepath
  [dir endpoint-name ext]
  (let [file (-> endpoint-name
                 str/trim
                 (str/split #"\s+")
                 (#(str/join "-" %))
                 u/lower-case-en)]
    (str dir file ext)))

Creates a link to the page for each endpoint. Used to build links on the API index page at docs/api-documentation.md.

(defn build-endpoint-link
  [ep ep-data]
  (let [filepath (build-filepath (if (paid? ep-data) "api/ee/" "api/") ep ".md")]
    (str "- [" ep (when (paid? ep-data) "*") "](" filepath ")")))

Creates a string that lists links to all endpoint groups, e.g., - Activity.

(defn- build-index
  [endpoints]
  (str/join "\n" (map (fn [[ep ep-data]] (build-endpoint-link ep ep-data)) endpoints)))

Creates a sorted map of API endpoints. Currently includes some endpoints for paid features.

(defn- map-endpoints
  []
  (->> (collect-endpoints)
       (map process-endpoint)
       (group-by :ns-name)
       (into (sorted-map))))

Page generators

Creates an index page that lists links to all endpoint pages.

(defn- generate-index-page!
  [endpoint-map]
  (let [endpoint-index (str
                        (api-docs-intro)
                        (build-index endpoint-map))]
    (spit (io/file "docs/api-documentation.md") endpoint-index)))

Takes a map of endpoint groups and generates markdown pages for all API endpoint groups.

(defn- generate-endpoint-pages!
  [endpoints]
  (doseq [[ep ep-data] endpoints]
    (let [file (build-filepath (str "docs/" (if (paid? ep-data) "api/ee/" "api/")) ep ".md")
          contents (endpoint-page ep ep-data)]
      (io/make-parents file)
      (spit file contents))))

Is it a markdown file?

(defn- md?
  [file]
  (= "md"
     (-> file
         str
         (str/split #"\.")
         last)))

Used to clear the API directory for rebuilding docs from scratch so we don't orphan files as the API changes.

(defn- reset-dir
  [file]
  (let [files (filter md? (file-seq file))]
    (doseq [f files]
      (try (io/delete-file f)
           (catch Exception e
             (println "File:" f "not deleted")
             (println e))))))

Builds an index page and sub-pages for groups of endpoints. Index page is docs/api-documentation.md. Endpoint pages are in /docs/api/{endpoint}.md

(defn generate-dox!
  []
  (when-not config/ee-available?
    (println (u/colorize
              :red (str "Warning: EE source code not available. EE endpoints will not be included. "
                        "If you want to include them, run the command with"
                        \newline
                        \newline
                        "clojure -M:ee:run api-documentation"))))
  (let [endpoint-map (map-endpoints)]
    (reset-dir (io/file "docs/api"))
    (generate-index-page! endpoint-map)
    (println "API doc index generated at docs/api-documentation.md.")
    (generate-endpoint-pages! endpoint-map)
    (println "API endpoint docs generated in docs/api/{endpoint}.")))
 

Code to generate docs for environment variables. You can generate docs by running: clojure -M:ee:run environment-variables-documentation

(ns metabase.cmd.env-var-dox
  (:require
   [clojure.java.classpath :as classpath]
   [clojure.java.io :as io]
   [clojure.string :as str]
   [clojure.tools.namespace.find :as ns.find]
   [clojure.tools.reader.edn :as edn]
   [metabase.models.setting :as setting]
   [metabase.util :as u]))

Flamber advises that people avoid touching these environment variables.

(def env-vars-not-to-mess-with
  (set (edn/read-string (slurp (io/resource "metabase/cmd/resources/env-vars-to-avoid.edn")))))

Loads all of the metabase namespaces, which loads all of the defsettings, which are registered in an atom in the settings namespace. Once settings are registered, This function derefs that atom and puts the settings into a sorted map for processing.

(defn get-settings
  []
  (doseq [ns-symb (ns.find/find-namespaces (classpath/system-classpath))
          :when (and
                 (str/includes? (name ns-symb) "metabase")
                 (not (str/includes? (name ns-symb) "test")))]
    (require ns-symb))
  (->> @setting/registered-settings
       (into (sorted-map))
       seq
       (map (fn [[_ v]] v))))

Formatting functions

Helper function to specify the format of an environment variable's type for its documentation.

(defn- format-type
  [env-var]
  (str "Type: " (name (:type env-var))))

Helper function to specify how to format the default value of an enviromnent variable. for use in the environment variable docs.

(defn- format-default
  [env-var]
  (let [d (:default env-var)]
    (str "Default: "
         (if (false? d) "`false`"
             (if (:default env-var)
               (str "`" (:default env-var) "`")
               "`null`")))))

Used to build an environment variable.

(defn- format-prefix
  [env-var]
  (str "MB_" (u/->SCREAMING_SNAKE_CASE_EN (name (:name env-var)))))

Takes an integer and a string and creates a Markdown heading of level n.

(defn- format-heading
  [n s]
  (str (apply str (take n (repeat "#"))) " `" s "`"))

Helper function to specify description format for enviromnent variable docs.

(defn- format-description
  [env-var]
  (->> (:description env-var)
       u/add-period
       ;; Drop brackets used to create source code links
       (#(str/replace % #"\[\[|\]\]" ""))))

Used to specify when the environment variable was added, if that info exists.

(defn format-added
  [env-var]
  (when-let [a (:added (:doc env-var))]
    (str "Added: " a)))

Includes additional documentation for an environment variable (:commentary), if it exists.

(defn- format-doc
  [env-var]
  (when-let [d (:doc env-var)]
    (:commentary d)))

Preps a doc entry for an environment variable as a Markdown section.

(defn format-env-var-entry
  [env-var]
  (str/join "\n\n" (remove str/blank?
                           [(format-heading 3 (format-prefix env-var))
                            (format-type env-var)
                            (format-default env-var)
                            (format-added env-var)
                            (format-description env-var)
                            (format-doc env-var)])))

Filter functions

Used to filter out environment variables with high foot-gun indices.

(defn- avoid?
  [env-var]
  (or (false? (:doc env-var))
              ;; Ideally, we'd move off of this list completely, but not all environment variables
              ;; are defsettings.
      (contains? env-vars-not-to-mess-with (format-prefix env-var))))

Used to filter out environment variables that cannot be set.

(defn- setter?
  [env-var]
  (not= :none (:setter env-var)))

Used to filter our deprecated enviroment variables.

(defn- active?
  [env-var]
  (nil? (:deprecated env-var)))

Preps relevant environment variable docs as a Markdown string.

(defn format-env-var-docs
  [settings]
  (->> settings
       (filter setter?)
       (filter active?)
       (remove avoid?)
       (map format-env-var-entry)))

Exists just so we can write the intro in Markdown.

(defn- format-intro
  []
  (str (slurp "src/metabase/cmd/resources/env-var-intro.md") "\n\n"))

Prints the generated environment variable docs to a file.

(defn generate-dox!
  []
  (println "Generating docs for environment variables...")
  (spit (io/file "docs/configuring-metabase/environment-variables.md") (apply str (format-intro)
                                                                              (str/join "\n\n" (format-env-var-docs (get-settings)))))
  (println "Done."))
 

Commands for loading data from an H2 file into another database. Run this with

clojure -M:run load-from-h2

or

java -jar metabase.jar load-from-h2

Test this as follows:

# Postgres psql -c 'DROP DATABASE IF EXISTS metabase;' psql -c 'CREATE DATABASE metabase;' MBDBTYPE=postgres MBDBHOST=localhost MBDBPORT=5432 MBDBUSER=camsaul MBDBDBNAME=metabase clojure -M:run load-from-h2

# MySQL mysql -u root -e 'DROP DATABASE IF EXISTS metabase; CREATE DATABASE metabase;' MBDBTYPE=mysql MBDBHOST=localhost MBDBPORT=3305 MBDBUSER=root MBDBDBNAME=metabase clojure -M:run load-from-h2

(ns metabase.cmd.load-from-h2
  (:require
   [metabase.cmd.copy :as copy]
   [metabase.cmd.copy.h2 :as copy.h2]
   [metabase.db.connection :as mdb.connection]
   [metabase.db.env :as mdb.env]))

Transfer data from existing H2 database to a newly created (presumably MySQL or Postgres) DB. Intended as a tool for upgrading from H2 to a 'real' database.

Defaults to using [[metabase.db.env/db-file]] as the source H2 database if h2-filename is nil.

(defn load-from-h2!
  ([]
   (load-from-h2! (mdb.env/db-file)))
  ([h2-filename]
   (let [h2-filename    (str h2-filename ";IFEXISTS=TRUE")
         h2-data-source (copy.h2/h2-data-source h2-filename)]
     (copy/copy! :h2 h2-data-source (mdb.connection/db-type) (mdb.connection/data-source)))))
 
(ns metabase.cmd.migrate
  (:require
   [metabase.db.connection :as mdb.connection]
   [metabase.db.setup :as mdb.setup]))

Migrate the Metabase application DB.

(defn migrate!
  [direction]
  (mdb.setup/migrate! (mdb.connection/db-type) (mdb.connection/data-source) (keyword direction)))
 
(ns metabase.cmd.reset-password
  (:require
   [metabase.db :as mdb]
   [metabase.models.user :as user :refer [User]]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-trs trs]]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

Set and return a new reset_token for the user with EMAIL-ADDRESS.

(defn- set-reset-token!
  [email-address]
  (let [user-id (or (t2/select-one-pk User, :%lower.email (u/lower-case-en email-address))
                    (throw (Exception. (str (deferred-trs "No user found with email address ''{0}''. " email-address)
                                            (deferred-trs "Please check the spelling and try again.")))))]
    (user/set-password-reset-token! user-id)))

Reset the password for EMAIL-ADDRESS, and return the reset token in a format that can be understood by the Mac App.

(defn reset-password!
  [email-address]
  (mdb/setup-db!)
  (println (str (deferred-trs "Resetting password for {0}..." email-address)
                "\n"))
  (try
    (println (trs "OK [[[{0}]]]" (set-reset-token! email-address)))
    (System/exit 0)
    (catch Throwable e
      (println (trs "FAIL [[[{0}]]]" (.getMessage e)))
      (System/exit -1))))
 
(ns metabase.cmd.rotate-encryption-key
  (:require
   [cheshire.core :as json]
   [metabase.db :as mdb]
   [metabase.db.connection :as mdb.connection]
   [metabase.db.env :as mdb.env]
   [metabase.models :refer [Database Secret Setting]]
   [metabase.models.setting.cache :as setting.cache]
   [metabase.util.encryption :as encryption]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [toucan2.core :as t2]))

Rotate the current configured db using the current MB_ENCRYPTION_SECRET_KEY env var and to-key argument.

(defn rotate-encryption-key!
  [to-key]
  (when-not (mdb/db-is-set-up?)
    (log/warnf "Database not found. Metabase will create a new database at %s and proceeed encrypting." "2")
    (mdb/setup-db!))
  (log/infof "%s: %s | %s" (trs "Connected to") mdb.env/db-type (mdb.env/db-file))
  (let [make-encrypt-fn  (fn [maybe-encrypt-fn]
                           (if to-key
                             (partial maybe-encrypt-fn (encryption/validate-and-hash-secret-key to-key))
                             identity))
        encrypt-str-fn   (make-encrypt-fn encryption/maybe-encrypt)
        encrypt-bytes-fn (make-encrypt-fn encryption/maybe-encrypt-bytes)]
    (t2/with-transaction [t-conn {:datasource (mdb.connection/data-source)}]
      (doseq [[id details] (t2/select-pk->fn :details Database)]
        (when (encryption/possibly-encrypted-string? details)
          (throw (ex-info (trs "Can''t decrypt app db with MB_ENCRYPTION_SECRET_KEY") {:database-id id})))
        (t2/update! :conn t-conn :metabase_database
                    {:id id}
                    {:details (encrypt-str-fn (json/encode details))}))
      (doseq [[key value] (t2/select-fn->fn :key :value Setting)]
        (if (= key "settings-last-updated")
          (setting.cache/update-settings-last-updated!)
          (t2/update! :conn t-conn :setting
                      {:key key}
                      {:value (encrypt-str-fn value)})))
      ;; update all secret values according to the new encryption key
      ;; fortunately, we don't need to fetch the latest secret instance per ID, as we would need to in order to update
      ;; a secret value through the regular database save API path; instead, ALL secret values in the app DB (regardless
      ;; of whether they are the "current version" or not), should be updated with the new key
      (doseq [[id value] (t2/select-pk->fn :value Secret)]
        (when (encryption/possibly-encrypted-string? value)
          (throw (ex-info (trs "Can''t decrypt secret value with MB_ENCRYPTION_SECRET_KEY") {:secret-id id})))
        (t2/update! :conn t-conn :secret
                    {:id id}
                    {:value (encrypt-bytes-fn value)})))))
 
(ns metabase.config
  (:require
   [cheshire.core :as json]
   [clojure.java.io :as io]
   [clojure.string :as str]
   [environ.core :as env]
   [metabase.plugins.classloader :as classloader])
  (:import
   (clojure.lang Keyword)))
(set! *warn-on-reflection* true)

Indicates whether Enterprise Edition extensions are available

this existed long before 0.39.0, but that's when it was made public

(def ^{:doc  :added "0.39.0"} ee-available?
  (try
    (classloader/require 'metabase-enterprise.core)
    true
    (catch Throwable _
      false)))

Whether code from ./test is available. This is mainly to facilitate certain things like test QP middleware that we want to load only when test code is present.

(def tests-available?
  (try
    (classloader/require 'metabase.test.core)
    true
    (catch Throwable _
      false)))

Are we running on a Windows machine?

(def ^Boolean is-windows?
  #_{:clj-kondo/ignore [:discouraged-var]}
  (str/includes? (str/lower-case (System/getProperty "os.name")) "win"))

Global application defaults

(def ^:private app-defaults
  {:mb-run-mode            "prod"
   ;; DB Settings
   :mb-db-type             "h2"
   :mb-db-file             "metabase.db"
   :mb-db-automigrate      "true"
   :mb-db-logging          "true"
   ;; Jetty Settings. Full list of options is available here: https://github.com/ring-clojure/ring/blob/master/ring-jetty-adapter/src/ring/adapter/jetty.clj
   :mb-jetty-port          "3000"
   :mb-jetty-join          "true"
   ;; other application settings
   :mb-password-complexity "normal"
   :mb-version-info-url    "https://static.metabase.com/version-info.json"
   :mb-version-info-ee-url "https://static.metabase.com/version-info-ee.json"
   :mb-ns-trace            ""                                             ; comma-separated namespaces to trace
   :max-session-age        "20160"                                        ; session length in minutes (14 days)
   :mb-colorize-logs       (str (not is-windows?))                        ; since PowerShell and cmd.exe don't support ANSI color escape codes or emoji,
   :mb-emoji-in-logs       (str (not is-windows?))                        ; disable them by default when running on Windows. Otherwise they're enabled
   :mb-qp-cache-backend    "db"})

separate map for EE stuff so merge conflicts aren't annoying.

(def ^:private ee-app-defaults
  {:embed-max-session-age "1440"}) ; how long a FULL APP EMBED session is valid for. One day, by default
(alter-var-root #'app-defaults merge ee-app-defaults)

Retrieve value for a single configuration key. Accepts either a keyword or a string.

We resolve properties from these places:

  1. environment variables (ex: MBDBTYPE -> :mb-db-type)
  2. jvm options (ex: -Dmb.db.type -> :mb-db-type)
  3. hard coded app-defaults
(defn config-str
  [k]
  (let [k       (keyword k)
        env-val (k env/env)]
    (or (when-not (str/blank? env-val) env-val)
        (k app-defaults))))

Fetch a configuration key and parse it as an integer.

These are convenience functions for accessing config values that ensures a specific return type

TODO - These names are bad. They should be something like int, boolean, and keyword, respectively. See https://github.com/metabase/metabase/wiki/Metabase-Clojure-Style-Guide#dont-repeat-namespace-alias-in-function-names for discussion

Fetch a configuration key and parse it as a boolean.

Fetch a configuration key and parse it as a keyword.

(defn config-int   ^Integer [k] (some-> k config-str Integer/parseInt))
(defn config-bool   ^Boolean [k] (some-> k config-str Boolean/parseBoolean))
(defn config-kw     ^Keyword [k] (some-> k config-str keyword))

Are we running in dev mode (i.e. in a REPL or via clojure -M:run)?

Are we running in prod mode (i.e. from a JAR)?

Are we running in test mode (i.e. via clojure -X:test)?

(def ^Boolean is-dev?   (= :dev  (config-kw :mb-run-mode)))
(def ^Boolean is-prod?                        (= :prod (config-kw :mb-run-mode)))
(def ^Boolean is-test?             (= :test (config-kw :mb-run-mode)))

Version stuff

(defn- version-info-from-properties-file []
  (when-let [props-file (io/resource "version.properties")]
    (with-open [reader (io/reader props-file)]
      (let [props (java.util.Properties.)]
        (.load props reader)
        (into {} (for [[k v] props]
                   [(keyword k) v]))))))

Information about the current version of Metabase. Comes from version.properties which is generated by the build script.

mb-version-info -> {:tag: "v0.11.1", :hash: "afdf863", :date: "2015-10-05"}

TODO - Can we make this ^:const, so we don't have to read the file at launch when running from the uberjar?

(def mb-version-info
  (or (version-info-from-properties-file)
      ;; if version info is not defined for whatever reason
      {:tag "vLOCAL_DEV"
       :hash "06d1ba2ae111e66253209c01c244d6379acfc6dcb1911fa9ab6012cec9ce52e5"}))

A formatted version string representing the currently running application. Looks something like v0.25.0-snapshot (1de6f3f nested-queries-icon).

(def ^String mb-version-string
  (let [{:keys [tag hash]} mb-version-info]
    (format "%s (%s)" tag hash)))

A formatted version string including the word 'Metabase' appropriate for passing along with database connections so admins can identify them as Metabase ones. Looks something like Metabase v0.25.0.RC1.

(def ^String mb-app-id-string
  (str "Metabase " (mb-version-info :tag)))

Returns the major version of the running Metabase JAR. When the version.properties file is missing (e.g., running in local dev), returns nil.

(defn current-major-version
  []
  (some-> (second (re-find #"\d+\.(\d+)" (:tag mb-version-info)))
          parse-long))

This UUID is randomly-generated upon launch and used to identify this specific Metabase instance during this specifc run. Restarting the server will change this UUID, and each server in a horizontal cluster will have its own ID, making this different from the site-uuid Setting.

(defonce 
  local-process-uuid
  (str (random-uuid)))

A string that contains identifying information about the Metabase version and the local process.

(defonce
  mb-version-and-process-identifier
  (format "%s [%s]" mb-app-id-string local-process-uuid))

Default user details provided as a JSON string at launch time for first-user setup flow.

(defn mb-user-defaults
  []
  (when-let [user-json (env/env :mb-user-defaults)]
    (json/parse-string user-json true)))

The user-id of the internal metabase user. This is needed in the OSS edition to filter out users for setup/has-user-setup.

(def ^:const internal-mb-user-id
   13371338)
 
(ns metabase.core
  (:require
   [clojure.string :as str]
   [clojure.tools.trace :as trace]
   [java-time.api :as t]
   [metabase.analytics.prometheus :as prometheus]
   [metabase.config :as config]
   [metabase.core.config-from-file :as config-from-file]
   [metabase.core.initialization-status :as init-status]
   [metabase.db :as mdb]
   [metabase.driver.h2]
   [metabase.driver.mysql]
   [metabase.driver.postgres]
   [metabase.events :as events]
   [metabase.logger :as mb.logger]
   [metabase.plugins :as plugins]
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings :as public-settings]
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.sample-data :as sample-data]
   [metabase.server :as server]
   [metabase.server.handler :as handler]
   [metabase.setup :as setup]
   [metabase.task :as task]
   [metabase.troubleshooting :as troubleshooting]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-trs trs]]
   [metabase.util.log :as log])
  (:import
   (java.lang.management ManagementFactory)))
(set! *warn-on-reflection* true)
(comment
  ;; Load up the drivers shipped as part of the main codebase, so they will show up in the list of available DB types
  metabase.driver.h2/keep-me
  metabase.driver.mysql/keep-me
  metabase.driver.postgres/keep-me
  ;; Make sure the custom Metabase logger code gets loaded up so we use our custom logger for performance reasons.
  mb.logger/keep-me)

don't i18n this, it's legalese

(log/info
 (format "\nMetabase %s" config/mb-version-string)

 (format "\n\nCopyright © %d Metabase, Inc." (.getYear (java.time.LocalDate/now)))

 (str "\n\n"
      (if config/ee-available?
        (str (deferred-trs "Metabase Enterprise Edition extensions are PRESENT.")
             "\n\n"
             (deferred-trs "Usage of Metabase Enterprise Edition features are subject to the Metabase Commercial License.")
             " "
             (deferred-trs "See {0} for details." "https://www.metabase.com/license/commercial/"))
        (deferred-trs "Metabase Enterprise Edition extensions are NOT PRESENT."))))

--------------------------------------------------- Lifecycle ----------------------------------------------------

Print the setup url during instance initialization.

(defn- print-setup-url
  []
  (let [hostname  (or (config/config-str :mb-jetty-host) "localhost")
        port      (config/config-int :mb-jetty-port)
        site-url  (or (public-settings/site-url)
                      (str "http://"
                           hostname
                           (when-not (= 80 port) (str ":" port))))
        setup-url (str site-url "/setup/")]
    (log/info (u/format-color 'green
                              (str (deferred-trs "Please use the following URL to setup your Metabase installation:")
                                   "\n\n"
                                   setup-url
                                   "\n\n")))))

Create and set a new setup token and log it.

(defn- create-setup-token-and-log-setup-url!
  []
  (setup/create-token!)   ; we need this here to create the initial token
  (print-setup-url))

General application shutdown function which should be called once at application shuddown.

(defn- destroy!
  []
  (log/info (trs "Metabase Shutting Down ..."))
  ;; TODO - it would really be much nicer if we implemented a basic notification system so these things could listen
  ;; to a Shutdown hook of some sort instead of having here
  (task/stop-scheduler!)
  (server/stop-web-server!)
  (prometheus/shutdown!)
  (log/info (trs "Metabase Shutdown COMPLETE")))

OSS implementation of audit-db/ensure-db-installed!, which is an enterprise feature, so does nothing in the OSS version.

(defenterprise ensure-audit-db-installed!
  metabase-enterprise.audit-db [] ::noop)

General application initialization function which should be run once at application startup.

(defn- init!*
  []
  (log/info (trs "Starting Metabase version {0} ..." config/mb-version-string))
  (log/info (trs "System info:\n {0}" (u/pprint-to-str (troubleshooting/system-info))))
  (init-status/set-progress! 0.1)
  ;; First of all, lets register a shutdown hook that will tidy things up for us on app exit
  (.addShutdownHook (Runtime/getRuntime) (Thread. ^Runnable destroy!))
  (init-status/set-progress! 0.2)
  ;; load any plugins as needed
  (plugins/load-plugins!)
  (init-status/set-progress! 0.3)
  ;; startup database.  validates connection & runs any necessary migrations
  (log/info (trs "Setting up and migrating Metabase DB. Please sit tight, this may take a minute..."))
  (mdb/setup-db!)
  (init-status/set-progress! 0.5)
  ;; Set up Prometheus
  (when (prometheus/prometheus-server-port)
    (log/info (trs "Setting up prometheus metrics"))
    (prometheus/setup!)
    (init-status/set-progress! 0.6))
  ;; run a very quick check to see if we are doing a first time installation
  ;; the test we are using is if there is at least 1 User in the database
  (let [new-install? (not (setup/has-user-setup))]
    ;; initialize Metabase from an `config.yml` file if present (Enterprise Edition™ only)
    (config-from-file/init-from-file-if-code-available!)
    (init-status/set-progress! 0.7)
    (when new-install?
      (log/info (trs "Looks like this is a new installation ... preparing setup wizard"))
      ;; create setup token
      (create-setup-token-and-log-setup-url!)
      ;; publish install event
      (events/publish-event! :event/install {}))
    (init-status/set-progress! 0.8)
    ;; deal with our sample database as needed
    (if new-install?
      ;; add the sample database DB for fresh installs
      (sample-data/add-sample-database!)
      ;; otherwise update if appropriate
      (sample-data/update-sample-database-if-needed!))
    (init-status/set-progress! 0.9))
  (ensure-audit-db-installed!)
  (init-status/set-progress! 0.95)
  ;; start scheduler at end of init!
  (task/start-scheduler!)
  (init-status/set-complete!)
  (let [start-time (.getStartTime (ManagementFactory/getRuntimeMXBean))
        duration   (- (System/currentTimeMillis) start-time)]
    (log/info (trs "Metabase Initialization COMPLETE in {0}" (u/format-milliseconds duration)))))

General application initialization function which should be run once at application startup. Calls `[[init!*]] and records the duration of startup.

(defn init!
  []
  (let [start-time (t/zoned-date-time)]
    (init!*)
    (public-settings/startup-time-millis!
     (.toMillis (t/duration start-time (t/zoned-date-time))))))

-------------------------------------------------- Normal Start --------------------------------------------------

(defn- start-normally []
  (log/info (trs "Starting Metabase in STANDALONE mode"))
  (try
    ;; launch embedded webserver async
    (server/start-web-server! handler/app)
    ;; run our initialization process
    (init!)
    ;; Ok, now block forever while Jetty does its thing
    (when (config/config-bool :mb-jetty-join)
      (.join (server/instance)))
    (catch Throwable e
      (log/error e (trs "Metabase Initialization FAILED"))
      (System/exit 1))))
(defn- run-cmd [cmd args]
  (classloader/require 'metabase.cmd)
  ((resolve 'metabase.cmd/run-cmd) cmd args))

-------------------------------------------------- Tracing -------------------------------------------------------

(defn- maybe-enable-tracing
  []
  (let [mb-trace-str (config/config-str :mb-ns-trace)]
    (when (not-empty mb-trace-str)
      (log/warn (trs "WARNING: You have enabled namespace tracing, which could log sensitive information like db passwords."))
      (doseq [namespace (map symbol (str/split mb-trace-str #",\s*"))]
        (try (require namespace)
             (catch Throwable _
               (throw (ex-info "A namespace you specified with MB_NS_TRACE could not be required" {:namespace namespace}))))
        (trace/trace-ns namespace)))))

------------------------------------------------ App Entry Point -------------------------------------------------

Launch Metabase in standalone mode. (Main application entrypoint is [[metabase.bootstrap/-main]].)

(defn entrypoint
  [& [cmd & args]]
  (maybe-enable-tracing)
  (if cmd
    (run-cmd cmd args) ; run a command like `java -jar metabase.jar migrate release-locks` or `clojure -M:run migrate release-locks`
    (start-normally))) ; with no command line args just start Metabase normally
 
(ns metabase.core.config-from-file
  (:require
   [metabase.plugins.classloader :as classloader]
   [metabase.util.log :as log]))

Shim for running the config-from-file code, used by [[metabase.core]]. The config-from-file code only ships in the Enterprise Edition™ JAR, so this checks whether the namespace exists, and if it does, invokes [[metabase-enterprise.advanced-config.file/initialize!]]; otherwise, this no-ops.

(defn init-from-file-if-code-available!
  []
  (when (try
          (classloader/require 'metabase-enterprise.advanced-config.file)
          :ok
          (catch Throwable _
            (log/debug "metabase-enterprise.advanced-config.file not available; cannot initialize from file.")
            nil))
    ((resolve 'metabase-enterprise.advanced-config.file/initialize!))))
 

Code related to tracking the progress of metabase initialization. This is kept in a separate, tiny namespace so it can be loaded right away when the application launches (and so we don't need to wait for metabase.core to load to check the status).

(ns metabase.core.initialization-status)
(defonce ^:private progress-atom
  (atom 0))

Is Metabase initialized and ready to be served?

(defn complete?
  []
  (= @progress-atom 1.0))

Get the current progress of Metabase initialization.

(defn progress
  []
  @progress-atom)

Update the Metabase initialization progress to a new value, a floating-point value between 0 and 1.

(defn set-progress!
  [^Float new-progress]
  {:pre [(float? new-progress) (<= 0.0 new-progress 1.0)]}
  (reset! progress-atom new-progress))

Complete the Metabase initialization by setting its progress to 100%.

(defn set-complete!
  []
  (set-progress! 1.0))
 

High-level functions for setting up the Metabase application database. Additional functions can be found in sub-namespaces:

  • [[metabase.db.connection]] - functions for getting the application database type (e.g. :h2) and a [[clojure.java.jdbc]] spec for it; dynamic variable for rebinding it

  • [[metabase.db.connection-pool-setup]] - functions for creating a connection pool for the application database

  • [[metabase.db.custom-migrations]] - Clojure-land data migration definitions and functions for running them

  • [[metabase.db.data-source]] - Implementations of [[javax.sql.DataSource]] for raw connection strings and broken-out db details. See [[metabase.db.env/broken-out-details]] for more details about what 'broken-out details' means.

  • [[metabase.db.env]] - functions for getting application database connection information from environment variables

  • [[metabase.db.jdbc-protocols]] - implementations of [[clojure.java.jdbc]] protocols for the Metabase application database

  • [[metabase.db.liquibase]] - high-level Clojure wrapper around relevant parts of the Liquibase API

  • [[metabase.db.setup]] - code related to setting up the application DB -- verifying the connection and running migrations -- and for setting it up as the default Toucan connection

  • [[metabase.db.spec]] - util functions for creating JDBC specs for supported application DB types from connection details maps

  • [[metabase.db.util]] - general util functions for Toucan/HoneySQL queries against the application DB

(ns metabase.db
  (:require
   [clojure.core.async.impl.dispatch :as a.impl.dispatch]
   [metabase.config :as config]
   [metabase.db.connection :as mdb.connection]
   [metabase.db.setup :as mdb.setup]
   [methodical.core :as methodical]
   [potemkin :as p]
   [toucan2.pipeline :as t2.pipeline]))

TODO - determine if we actually need to import any of these

These are mostly here as a convenience to avoid having to rework a bunch of existing code. It's better to use these functions directly where applicable.

(p/import-vars
 [mdb.connection
  db-type
  quoting-style])

True if the Metabase DB is setup and ready.

TODO -- consider whether we can just do this automatically when getConnection is called on [[mdb.connection/application-db]] (or its data source)

(defn db-is-set-up?
  []
  (= @(:status mdb.connection/*application-db*) ::setup-finished))

Do general preparation of database by validating that we can connect. Caller can specify if we should run any pending database migrations. If DB is already set up, this function will no-op. Thread-safe.

(defn setup-db!
  []
  (when-not (db-is-set-up?)
    ;; It doesn't really matter too much what we lock on, as long as the lock is per-application-DB e.g. so we can run
    ;; setup for DIFFERENT application DBs at the same time, but CAN NOT run it for the SAME application DB. We can just
    ;; use the application DB object itself to lock on since that will be a different object for different application
    ;; DBs.
    (locking mdb.connection/*application-db*
      (when-not (db-is-set-up?)
        (let [db-type       (mdb.connection/db-type)
              data-source   (mdb.connection/data-source)
              auto-migrate? (config/config-bool :mb-db-automigrate)]
          (mdb.setup/setup-db! db-type data-source auto-migrate?))
        (reset! (:status mdb.connection/*application-db*) ::setup-finished))))
  :done)
(methodical/defmethod t2.pipeline/transduce-query :before :default
  "Make sure application database calls are not done inside core.async dispatch pool threads. This is done relatively
  early in the pipeline so the stacktrace when this fails isn't super enormous."
  [_rf _query-type₁ _model₂ _parsed-args resolved-query]
  (when (a.impl.dispatch/in-dispatch-thread?)
    (throw (ex-info "Application database calls are not allowed inside core.async dispatch pool threads."
                    {})))
  resolved-query)
 

Functions for getting the application database connection type and JDBC spec, or temporarily overriding them. TODO - consider renaming this namespace metabase.db.config.

(ns metabase.db.connection
  (:require
   [metabase.db.connection-pool-setup :as connection-pool-setup]
   [metabase.db.env :as mdb.env]
   [methodical.core :as methodical]
   [potemkin :as p]
   [toucan2.connection :as t2.conn]
   [toucan2.jdbc.connection :as t2.jdbc.conn])
  (:import
   (java.util.concurrent.locks ReentrantReadWriteLock)))
(set! *warn-on-reflection* true)

Counter for [[unique-identifier]] -- this is a simple counter rather that [[java.util.UUID/randomUUID]] so we don't waste precious entropy on launch generating something that doesn't need to be random (it just needs to be unique)

(defonce 
  application-db-counter
  (atom 0))
(p/defrecord+ ApplicationDB [^clojure.lang.Keyword db-type
                             ^javax.sql.DataSource data-source
                             ;; used by [[metabase.db/setup-db!]] and [[metabase.db/db-is-set-up?]] to record whether
                             ;; the usual setup steps have been performed (i.e., running Liquibase and Clojure-land data
                             ;; migrations).
                             ^clojure.lang.Atom    status
                             ;; A unique identifier generated for this specific application DB. Use this as a
                             ;; memoization/cache key. See [[unique-identifier]] for more information.
                             id
                             ;; Reentrant read-write lock for GETTING new connections. Lock doesn't track whether any
                             ;; existing connections are open! Holding the write lock will however prevent any NEW
                             ;; connections from being acquired.
                             ;;
                             ;; This is a reentrant read-write lock, which means any number of read locks are allowed at
                             ;; the same time, but the write lock is exclusive. So if you want to prevent anyone from
                             ;; getting new connections, lock the write lock.
                             ;;
                             ;; The main purpose of this is to power [[metabase.api.testing]] which allows you to reset
                             ;; the application DB with data from a SQL dump -- during the restore process it is
                             ;; important that we do not allow anyone to access the DB.
                             ^ReentrantReadWriteLock lock]
  javax.sql.DataSource
  (getConnection [_]
    (try
      (.. lock readLock lock)
      (.getConnection data-source)
      (finally
        (.. lock readLock unlock))))
  (getConnection [_ user password]
    (try
      (.. lock readLock lock)
      (.getConnection data-source user password)
      (finally
        (.. lock readLock unlock)))))
(alter-meta! #'->ApplicationDB assoc :private true)
(alter-meta! #'map->ApplicationDB assoc :private true)

Create a new Metabase application database (type and [[javax.sql.DataSource]]). For use in combination with [[application-db]]:

(binding [mdb.connection/application-db (mdb.connection/application-db :h2 my-data-source)] ...)

Options:

  • :create-pool? -- whether to create a c3p0 connection pool data source for this application database if data-source is not already a pooled data source. Default: false. You should only do this for application DBs that are expected to be long-lived; for test DBs that will be destroyed at the end of the test it's hardly worth it.
(defn application-db
  ^ApplicationDB [db-type data-source & {:keys [create-pool?], :or {create-pool? false}}]
  ;; this doesn't use [[schema.core/defn]] because [[schema.core/defn]] doesn't like optional keyword args
  {:pre [(#{:h2 :mysql :postgres} db-type)
         (instance? javax.sql.DataSource data-source)]}
  (map->ApplicationDB
   {:db-type     db-type
    :data-source (if create-pool?
                   (connection-pool-setup/connection-pool-data-source db-type data-source)
                   data-source)
    :status      (atom nil)
    ;; for memoization purposes. See [[unique-identifier]] for more information.
    :id          (swap! application-db-counter inc)
    :lock        (ReentrantReadWriteLock.)}))

Type info and [[javax.sql.DataSource]] for the current Metabase application database. Create a new instance with [[application-db]].

(def ^:dynamic ^ApplicationDB *application-db*
  (application-db mdb.env/db-type mdb.env/data-source :create-pool? true))

Keyword type name of the application DB. Matches corresponding db-type name e.g. :h2, :mysql, or :postgres.

(defn db-type
  []
  (.db-type *application-db*))

HoneySQL quoting style to use for application DBs of the given type. Note for H2 application DBs we automatically uppercase all identifiers (since this is H2's default behavior) whereas in the SQL QP we stick with the case we got when we synced the DB.

(defn quoting-style
  [db-type]
  (case db-type
    :postgres :ansi
    :h2       :h2
    :mysql    :mysql))

Get a data source for the application DB, derived from environment variables. Usually this should be a pooled data source (i.e. a c3p0 pool) -- but in test situations it might not be.

TODO -- you can just use [[application-db]] directly, we can probably get rid of this and use that directly instead

(defn data-source
  ^javax.sql.DataSource []
  (.data-source *application-db*))

Unique identifier for the Metabase application DB. This value will stay the same as long as the application DB stays the same; if the application DB is dynamically rebound, this will return a new value.

For normal memoization you can use [[memoize-for-application-db]]; you should only need to use this directly for TTL memoization with [[clojure.core.memoize]] or other special cases. See [[metabase.driver.util/database->driver*]] for an example of using this for TTL memoization.

I didn't call this id so there's no confusing this with a data warehouse [[metabase.models.database]] instance -- it's a number that I don't want getting mistaken for an Database id. Also the fact that it's an Integer is not something callers of this function really need to be concerned about

(defn unique-identifier
  []
  (.id *application-db*))

Like [[clojure.core/memoize]], but only memoizes for the current application database; memoized values will be ignored if the app DB is dynamically rebound. For TTL memoization with [[clojure.core.memoize]], set :clojure.core.memoize/args-fn instead; see [[metabase.driver.util/database->driver*]] for an example of how to do this.

(defn memoize-for-application-db
  [f]
  (let [f* (memoize (fn [_application-db-id & args]
                      (apply f args)))]
    (fn [& args]
      (apply f* (unique-identifier) args))))
(methodical/defmethod t2.conn/do-with-connection :default
  [_connectable f]
  (t2.conn/do-with-connection *application-db* f))
(def ^:private ^:dynamic *transaction-depth* 0)
(defn- do-transaction [^java.sql.Connection connection f]
  (letfn [(thunk []
            (let [savepoint (.setSavepoint connection)]
              (try
                (let [result (f connection)]
                  (when (= *transaction-depth* 1)
                    ;; top-level transaction, commit
                    (.commit connection))
                  result)
                (catch Throwable e
                  (.rollback connection savepoint)
                  (throw e)))))]
    ;; optimization: don't set and unset autocommit if it's already false
    (if (.getAutoCommit connection)
      (try
        (.setAutoCommit connection false)
        (thunk)
        (finally
          (.setAutoCommit connection true)))
      (thunk))))
(comment
 ;; in toucan2.jdbc.connection, there is a 'defmethod' for t2.conn/do-with-transaction java.sql.Connection
 ;; since we don't want our implementation to be overwritten, we need to require it here first before defininng ours
 t2.jdbc.conn/keepme)
(methodical/defmethod t2.conn/do-with-transaction java.sql.Connection
  "Support nested transactions without introducing a lock like `next.jdbc` does, as that can cause deadlocks -- see
  https://github.com/seancorfield/next-jdbc/issues/244. Use `Savepoint`s because MySQL only supports nested
  transactions when done this way.
  See also https://metaboat.slack.com/archives/CKZEMT1MJ/p1694103570500929
  Note that these \"nested transactions\" are not the real thing (e.g., as in Oracle):
    - there is only one commit, meaning that every transaction in a tree of transactions can see the changes
      other transactions have made,
    - in the presence of unsynchronized concurrent threads running nested transactions, the effects of rollback
      are not well defined - a rollback will undo all work done by other transactions in the same tree that
      started later."
  [^java.sql.Connection connection {:keys [nested-transaction-rule] :or {nested-transaction-rule :allow} :as options} f]
  (assert (#{:allow :ignore :prohibit} nested-transaction-rule))
  (cond
   (and (pos? *transaction-depth*)
        (= nested-transaction-rule :ignore))
   (f connection)
   (and (pos? *transaction-depth*)
        (= nested-transaction-rule :prohibit))
   (throw (ex-info "Attempted to create nested transaction with :nested-transaction-rule set to :prohibit"
                   {:options options}))
   :else
   (binding [*transaction-depth* (inc *transaction-depth*)]
     (do-transaction connection f))))
 

Code for creating the connection pool for the application DB and setting it as the default Toucan connection.

(ns metabase.db.connection-pool-setup
  (:require
   [java-time.api :as t]
   [metabase.config :as config]
   [metabase.connection-pool :as connection-pool]
   [schema.core :as s])
  (:import
   (com.mchange.v2.c3p0 ConnectionCustomizer PoolBackedDataSource)))
(set! *warn-on-reflection* true)
(def ^:private latest-activity (atom nil))
(def ^:private ^java.time.Duration recent-window-duration (t/seconds 15))
(defn- recent-activity?*
  [activity duration]
  (when activity
    (t/after? activity (t/minus (t/offset-date-time) duration))))

Returns true if there has been recent activity. Define recent activity as an application db connection checked in, checked out, or acquired within [[recent-window-duration]]. Check-in means a query succeeded and the db connection is no longer needed.

(defn recent-activity?
  []
  (recent-activity?* @latest-activity recent-window-duration))
(defrecord DbActivityTracker []
  ConnectionCustomizer
  (onAcquire [_ _connection _identity-token]
    (reset! latest-activity (t/offset-date-time)))
  (onCheckIn [_ _connection _identity-token]
    (reset! latest-activity (t/offset-date-time)))
  (onCheckOut [_ _connection _identity-token]
    (reset! latest-activity (t/offset-date-time)))
  (onDestroy [_ _connection _identity-token]))

c3p0 allows for hooking into lifecycles with its interface ConnectionCustomizer. https://www.mchange.com/projects/c3p0/apidocs/com/mchange/v2/c3p0/ConnectionCustomizer.html. But Clojure defined code is in memory in a dynamic class loader not available to c3p0's use of Class/forName. Luckily it looks up the instances in a cache which I pre-seed with out impl here. Issue for better access here: https://github.com/swaldman/c3p0/issues/166

(defn- register-customizer!
  [^Class klass]
  (let [field (doto (.getDeclaredField com.mchange.v2.c3p0.C3P0Registry "classNamesToConnectionCustomizers")
                (.setAccessible true))]
    (.put ^java.util.HashMap (.get field com.mchange.v2.c3p0.C3P0Registry)
          (.getName klass) (.newInstance klass))))
(register-customizer! DbActivityTracker)

Options for c3p0 connection pool for the application DB. These are set in code instead of a properties file because we use separate options for data warehouse DBs. See https://www.mchange.com/projects/c3p0/#configuringconnectiontesting for an overview of the options used below (jump to the 'Simple advice on Connection testing' section.)

(def ^:private application-db-connection-pool-props
  (merge
   {"idleConnectionTestPeriod" 60
    "connectionCustomizerClassName" (.getName DbActivityTracker)}
   ;; only merge in `max-pool-size` if it's actually set, this way it doesn't override any things that may have been
   ;; set in `c3p0.properties`
   (when-let [max-pool-size (config/config-int :mb-application-db-max-connection-pool-size)]
     {"maxPoolSize" max-pool-size})))
(s/defn connection-pool-data-source :- PoolBackedDataSource
  "Create a connection pool [[javax.sql.DataSource]] from an unpooled [[javax.sql.DataSource]] `data-source`. If
  `data-source` is already pooled, this will return `data-source` as-is."
  [db-type     :- s/Keyword
   data-source :- javax.sql.DataSource]
  (if (instance? PoolBackedDataSource data-source)
    data-source
    (let [ds-name    (format "metabase-%s-app-db" (name db-type))
          pool-props (assoc application-db-connection-pool-props "dataSourceName" ds-name)]
      (com.mchange.v2.c3p0.DataSources/pooledDataSource
       data-source
       (connection-pool/map->properties pool-props)))))
 

Custom liquibase migrations, so we can manipulate data with Clojure. We prefer to use SQL migrations in most cases because they are likely to be more performant and stable. However, there are some cases where we need to do something that is not possible or very difficult with SQL, such as JSON manipulation.

Migrations demand a higher level of reliability than normal code, so be careful about what these migrations depend on. If the code the migration depends on changes, the migration could corrupt app dbs and be very difficult to recover from.

If you need to use code from elsewhere, consider copying it into this namespace to minimize risk of the code changing behaviour.

(ns metabase.db.custom-migrations
  (:require
   [cheshire.core :as json]
   [clojure.core.match :refer [match]]
   [clojure.set :as set]
   [clojure.walk :as walk]
   [clojurewerkz.quartzite.jobs :as jobs]
   [clojurewerkz.quartzite.scheduler :as qs]
   [clojurewerkz.quartzite.triggers :as triggers]
   [medley.core :as m]
   [metabase.db.connection :as mdb.connection]
   [metabase.models.interface :as mi]
   [metabase.plugins.classloader :as classloader]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.log :as log]
   [toucan2.core :as t2]
   [toucan2.execute :as t2.execute])
  (:import
   (liquibase Scope)
   (liquibase.change Change)
   (liquibase.change.custom CustomTaskChange CustomTaskRollback)
   (liquibase.exception ValidationErrors)
   (liquibase.util BooleanUtil)))
(set! *warn-on-reflection* true)

Check if the change is supposed to be executed. This is a work around. The rollback method is called twice: once for generating MDC data and once for actually making the change. The same problem has been fixed for forward changes in Liquibase but for rollback it has not.

(defn should-execute-change?
  []
  (BooleanUtil/isTrue (.get (Scope/getCurrentScope) Change/SHOULD_EXECUTE true)))

Define a reversible custom migration. Both the forward and reverse migrations are defined using the same structure, similar to the bodies of multi-arity Clojure functions.

Example:

```clj (define-reversible-migration ExampleMigrationName (migration-body) (reverse-migration-body))) ```

(defmacro define-reversible-migration
  [name migration-body reverse-migration-body]
  `(defrecord ~name []
     CustomTaskChange
     (execute [_# database#]
       (t2/with-transaction [_conn#]
         ~migration-body))
     (getConfirmationMessage [_#]
       (str "Custom migration: " ~name))
     (setUp [_#])
     (validate [_# _database#]
       (ValidationErrors.))
     (setFileOpener [_# _resourceAccessor#])
     CustomTaskRollback
     (rollback [_# database#]
       (t2/with-transaction [_conn#]
         (when (should-execute-change?)
           ~reverse-migration-body)))))

No-op logging rollback function

(defn no-op
  [n]
  (log/info "No rollback for: " n))

Define a custom migration without a reverse migration.

(defmacro define-migration
  [name & migration-body]
  `(define-reversible-migration ~name (do ~@migration-body) (no-op ~(str name))))

+----------------------------------------------------------------------------------------------------------------+ | MIGRATIONS | +----------------------------------------------------------------------------------------------------------------+

(def ^:private base-path-regex
  #"^(/db/\d+(?:/schema/(?:(?:[^\\/])|(?:\\/)|(?:\\\\))*(?:/table/\d+?)?)?/)((native/)|(query/(segmented/)?))?$")

Converts v1 data permission paths into v2 data and query permissions paths. This is similar to ->v2-path in metabase.models.permissions but somewhat simplified for the migration use case.

(defn- ->v2-paths
  [v1-path]
  (if-let [base-path (second (re-find base-path-regex v1-path))]
    ;; For (almost) all v1 data paths, we simply extract the base path (e.g. "/db/1/schema/PUBLIC/table/1/")
    ;; and construct new v2 paths by adding prefixes to the base path.
    [(str "/data" base-path) (str "/query" base-path)]
    ;; For the specific v1 path that grants full data access but no native query access, we add a
    ;; /schema/ suffix to the corresponding v2 query permission path.
    (when-let [db-id (second (re-find #"^/db/(\d+)/schema/$" v1-path))]
      [(str "/data/db/" db-id "/") (str "/query/db/" db-id "/schema/")])))
(define-reversible-migration SplitDataPermissions
  (let [current-perms-set (t2/select-fn-set
                           (juxt :object :group_id)
                           :permissions
                           {:where [:or
                                    [:like :object (h2x/literal "/db/%")]
                                    [:like :object (h2x/literal "/data/db/%")]
                                    [:like :object (h2x/literal "/query/db/%")]]})
        v2-perms-set      (into #{} (mapcat
                                     (fn [[v1-path group-id]]
                                       (for [v2-path (->v2-paths v1-path)]
                                         [v2-path group-id]))
                                     current-perms-set))
        new-v2-perms      (into [] (set/difference v2-perms-set current-perms-set))]
    (when (seq new-v2-perms)
      (t2.execute/query-one {:insert-into :permissions
                             :columns     [:object :group_id]
                             :values      new-v2-perms})))
  (t2.execute/query-one {:delete-from :permissions
                         :where [:or [:like :object (h2x/literal "/data/db/%")]
                                 [:like :object (h2x/literal "/query/db/%")]]}))

+----------------------------------------------------------------------------------------------------------------+ | Quartz Scheduler Helpers | +----------------------------------------------------------------------------------------------------------------+

This section of code's purpose is to avoid the migration depending on the [[metabase.task]] namespace, which is likely to change, and might not have as tight test coverage as needed for custom migrations.

(defn- load-class ^Class [^String class-name]
  (Class/forName class-name true (classloader/the-classloader)))
(defrecord ^:private ClassLoadHelper []
  org.quartz.spi.ClassLoadHelper
  (initialize [_])
  (getClassLoader [_]
    (classloader/the-classloader))
  (loadClass [_ class-name]
    (load-class class-name))
  (loadClass [_ class-name _]
    (load-class class-name)))
(when-not *compile-files*
  (System/setProperty "org.quartz.scheduler.classLoadHelper.class" (.getName ClassLoadHelper)))

Set the appropriate system properties needed so Quartz can connect to the JDBC backend. (Since we don't know our DB connection properties ahead of time, we'll need to set these at runtime rather than Setting them in the quartz.properties file.)

(defn- set-jdbc-backend-properties!
  []
  (when (= (mdb.connection/db-type) :postgres)
    (System/setProperty "org.quartz.jobStore.driverDelegateClass" "org.quartz.impl.jdbcjobstore.PostgreSQLDelegate")))

+----------------------------------------------------------------------------------------------------------------+

(define-migration DeleteAbandonmentEmailTask
  (classloader/the-classloader)
  (set-jdbc-backend-properties!)
  (let [scheduler (qs/initialize)]
    (qs/start scheduler)
    (qs/delete-trigger scheduler (triggers/key "metabase.task.abandonment-emails.trigger"))
    (qs/delete-job scheduler (jobs/key "metabase.task.abandonment-emails.job"))
    (qs/shutdown scheduler)))
(define-migration FillJSONUnfoldingDefault
  (let [db-ids-to-not-update (->> (t2/query {:select [:id :details]
                                             :from   [:metabase_database]})
                                  ;; if json-unfolding is nil it's treated as if it were true
                                  ;; so we need to remove databases that have it set to false
                                  (filter (fn [{:keys [details]}]
                                            (when details
                                              (false? (:json-unfolding (json/parse-string details true))))))
                                  (map :id))
        field-ids-to-update  (->> (t2/query {:select [:f.id]
                                             :from   [[:metabase_field :f]]
                                             :join   [[:metabase_table :t] [:= :t.id :f.table_id]]
                                             :where  (if (seq db-ids-to-not-update)
                                                       [:and
                                                        [:not-in :t.db_id db-ids-to-not-update]
                                                        [:= :f.base_type "type/JSON"]]
                                                       [:= :f.base_type "type/JSON"])})
                                  (map :id))]
    (when (seq field-ids-to-update)
      (t2/query-one {:update :metabase_field
                     :set    {:json_unfolding true}
                     :where  [:in :metabase_field.id field-ids-to-update]}))))
(defn- update-legacy-field-refs-in-viz-settings [viz-settings]
  (let [old-to-new (fn [old]
                     (match old
                       ["ref" ref] ["ref" (match ref
                                            ["field-id" x] ["field" x nil]
                                            ["field-literal" x y] ["field" x {"base-type" y}]
                                            ["fk->" x y] (let [x (match x
                                                                   [_x0 x1] x1
                                                                   x x)
                                                               y (match y
                                                                   [_y0 y1] y1
                                                                   y y)]
                                                           ["field" y {:source-field x}])
                                            ref ref)]
                       k k))]
    (m/update-existing viz-settings "column_settings" update-keys
                       (fn [k]
                         (-> k
                             json/parse-string
                             vec
                             old-to-new
                             json/generate-string)))))
(define-migration MigrateLegacyColumnSettingsFieldRefs
  (let [update! (fn [{:keys [id visualization_settings]}]
                  (t2/query-one {:update :report_card
                                 :set    {:visualization_settings visualization_settings}
                                 :where  [:= :id id]}))]
    (run! update! (eduction (keep (fn [{:keys [id visualization_settings]}]
                                    (let [parsed  (json/parse-string visualization_settings)
                                          updated (update-legacy-field-refs-in-viz-settings parsed)]
                                      (when (not= parsed updated)
                                        {:id                     id
                                         :visualization_settings (json/generate-string updated)}))))
                            (t2/reducible-query {:select [:id :visualization_settings]
                                                 :from   [:report_card]
                                                 :where  [:or
                                                          ;; these match legacy field refs in column_settings
                                                          [:like :visualization_settings "%ref\\\\\",[\\\\\"field-id%"]
                                                          [:like :visualization_settings "%ref\\\\\",[\\\\\"field-literal%"]
                                                          [:like :visualization_settings "%ref\\\\\",[\\\\\"fk->%"]
                                                          ;; MySQL with NO_BACKSLASH_ESCAPES disabled:
                                                          [:like :visualization_settings "%ref\\\\\\\",[\\\\\\\"field-id%"]
                                                          [:like :visualization_settings "%ref\\\\\\\",[\\\\\\\"field-literal%"]
                                                          [:like :visualization_settings "%ref\\\\\\\",[\\\\\\\"fk->%"]]})))))
(defn- update-legacy-field-refs-in-result-metadata [result-metadata]
  (let [old-to-new (fn [ref]
                     (match ref
                       ["field-id" x] ["field" x nil]
                       ["field-literal" x y] ["field" x {"base-type" y}]
                       ["fk->" x y] (let [x (match x
                                              [_x0 x1] x1
                                              x x)
                                          y (match y
                                              [_y0 y1] y1
                                              y y)]
                                      ["field" y {:source-field x}])
                       _ ref))]
    (->> result-metadata
         json/parse-string
         (map #(m/update-existing % "field_ref" old-to-new))
         json/generate-string)))
(define-migration MigrateLegacyResultMetadataFieldRefs
  (let [update! (fn [{:keys [id result_metadata]}]
                  (t2/query-one {:update :report_card
                                 :set    {:result_metadata result_metadata}
                                 :where  [:= :id id]}))]
    (run! update! (eduction (keep (fn [{:keys [id result_metadata]}]
                                    (let [updated (update-legacy-field-refs-in-result-metadata result_metadata)]
                                      (when (not= result_metadata updated)
                                        {:id                     id
                                         :result_metadata updated}))))
                            (t2/reducible-query {:select [:id :result_metadata]
                                                 :from   [:report_card]
                                                 :where  [:or
                                                           [:like :result_metadata "%field-id%"]
                                                           [:like :result_metadata "%field-literal%"]
                                                           [:like :result_metadata "%fk->%"]]})))))

Removes options from the field_ref options map. If the resulting map is empty, it's replaced it with nil.

(defn- remove-opts
  [field_ref & opts-to-remove]
  (match field_ref
    ["field" id opts] ["field" id (not-empty (apply dissoc opts opts-to-remove))]
    _ field_ref))
(defn- remove-join-alias-from-column-settings-field-refs [visualization_settings]
  (update visualization_settings "column_settings"
          (fn [column_settings]
            (into {}
                  (map (fn [[k v]]
                         (match (vec (json/parse-string k))
                           ["ref" ["field" id opts]]
                           [(json/generate-string ["ref" (remove-opts ["field" id opts] "join-alias")]) v]
                           _ [k v]))
                       column_settings)))))
(defn- add-join-alias-to-column-settings-refs [{:keys [visualization_settings result_metadata]}]
  (let [result_metadata        (json/parse-string result_metadata)
        visualization_settings (json/parse-string visualization_settings)
        column-key->metadata   (group-by #(-> (get % "field_ref")
                                              ;; like the FE's `getColumnKey` function, remove "join-alias",
                                              ;; "temporal-unit" and "binning" options from the field_ref
                                              (remove-opts "join-alias" "temporal-unit" "binning"))
                                         result_metadata)]
    (json/generate-string
     (update visualization_settings "column_settings"
             (fn [column_settings]
               (into {}
                     (mapcat (fn [[k v]]
                               (match (vec (json/parse-string k))
                                 ["ref" ["field" id opts]]
                                 (for [column-metadata (column-key->metadata ["field" id opts])
                                       ;; remove "temporal-unit" and "binning" options from the matching field refs,
                                       ;; but not "join-alias" as before.
                                       :let [field-ref (-> (get column-metadata "field_ref")
                                                           (remove-opts "temporal-unit" "binning"))]]
                                   [(json/generate-string ["ref" field-ref]) v])
                                 _ [[k v]]))
                             column_settings)))))))
(define-reversible-migration AddJoinAliasToVisualizationSettingsFieldRefs
  (let [update-one! (fn [{:keys [id visualization_settings] :as card}]
                      (let [updated (add-join-alias-to-column-settings-refs card)]
                        (when (not= visualization_settings updated)
                          (t2/query-one {:update :report_card
                                         :set    {:visualization_settings updated}
                                         :where  [:= :id id]}))))]
    (run! update-one! (t2/reducible-query {:select [:id :visualization_settings :result_metadata]
                                           :from   [:report_card]
                                           :where  [:and
                                                    [:or
                                                     [:= :query_type nil]
                                                     [:= :query_type "query"]]
                                                    [:or
                                                     [:like :visualization_settings "%ref\\\\\",[\\\\\"field%"]
                                                     ; MySQL with NO_BACKSLASH_ESCAPES disabled
                                                     [:like :visualization_settings "%ref\\\\\\\",[\\\\\\\"field%"]]
                                                    [:like :result_metadata "%join-alias%"]]})))
  (let [update! (fn [{:keys [id visualization_settings]}]
                  (let [updated (-> visualization_settings
                                    json/parse-string
                                    remove-join-alias-from-column-settings-field-refs
                                    json/generate-string)]
                    (when (not= visualization_settings updated)
                      (t2/query-one {:update :report_card
                                     :set    {:visualization_settings updated}
                                     :where  [:= :id id]}))))]
    (run! update! (t2/reducible-query {:select [:id :visualization_settings]
                                       :from   [:report_card]
                                       :where  [:and
                                                [:or
                                                 [:= :query_type nil]
                                                 [:= :query_type "query"]]
                                                [:or
                                                 [:like :visualization_settings "%ref\\\\\",[\\\\\"field%"]
                                                 [:like :visualization_settings "%ref\\\\\\\",[\\\\\\\"field%"]]
                                                [:like :visualization_settings "%join-alias%"]]}))))
(defn- update-card-row-on-downgrade-for-dashboard-tab
  [dashboard-id]
  (let [tab+cards (->> (t2/query {:select    [:report_dashboardcard.* [:dashboard_tab.position :tab_position]]
                                  :from      [:report_dashboardcard]
                                  :where     [:= :report_dashboardcard.dashboard_id dashboard-id]
                                  :left-join [:dashboard_tab [:= :dashboard_tab.id :report_dashboardcard.dashboard_tab_id]]})
                       (group-by :tab_position)
                               ;; sort by tab position
                       (sort-by first))
        cards->max-height (fn [cards] (apply max (map #(+ (:row %) (:size_y %)) cards)))]
    (loop [position+cards tab+cards
           next-tab-row   0]
      (when-let [[tab-pos cards] (first position+cards)]
        (if (zero? tab-pos)
          (recur (rest position+cards) (long (cards->max-height cards)))
          (do
            (t2/query {:update :report_dashboardcard
                       :set    {:row [:+ :row next-tab-row]}
                       :where  [:= :dashboard_tab_id (:dashboard_tab_id (first cards))]})
            (recur (rest position+cards) (long (+ next-tab-row (cards->max-height cards))))))))))
(define-reversible-migration DowngradeDashboardTab
  (log/info "No forward migration for DowngradeDashboardTab")
  (run! update-card-row-on-downgrade-for-dashboard-tab
        (eduction (map :dashboard_id) (t2/reducible-query {:select-distinct [:dashboard_id]
                                                           :from            [:dashboard_tab]}))))

Perform the best effort to destructure card sizes in revision. The card in revision contains legacy field name and maybe even lacking fields.

(defn- destructure-revision-card-sizes
  [card]
  {:size_x (or (get card :size_x)
               (get card :sizeX)
               4)
   :size_y (or (get card :size_y)
               (get card :sizeY)
               4)
   :row    (or (get card :row) 0)
   :col    (or (get card :col) 0)})

Mirror of the forward algorithm we have in sql.

(defn- migrate-dashboard-grid-from-18-to-24
  [card]
  (let [{:keys [row col size_x size_y]} (destructure-revision-card-sizes card)]
    ;; new_size_x = size_x + ((col + size_x + 1) // 3) - ((col + 1) // 3)
    ;; new_col = col + ((col + 1) // 3)
    ;; need to wrap it a try catch in case anything weird could go wrong, for example
    ;; sizes are string
    (try
     (merge
       (dissoc card :sizeX :sizeY) ;; remove those legacy keys if exists
       {:size_x (- (+ size_x
                      (quot (+ col size_x 1) 3))
                   (quot (+ col 1) 3))
        :col    (+ col (quot (+ col 1) 3))
        :size_y size_y
        :row    row})
     (catch Throwable _
       card))))

Mirror of the rollback algorithm we have in sql.

(defn- migrate-dashboard-grid-from-24-to-18
  [card]
  (let [{:keys [row col size_x size_y]} (destructure-revision-card-sizes card)]
    ;; new_size_x = size_x - ((size_x + col + 1) // 4 - (col + 1) // 4)
    ;; new_col = col - (col + 1) // 4
    (try
     (merge
       card
       {:size_x (if (= size_x 1)
                  1
                  (- size_x
                     (-
                      (quot (+ size_x col 1) 4)
                      (quot (+ col 1) 4))))
        :col    (- col (quot (+ col 1) 4))
        :size_y size_y
        :row    row})
     (catch Throwable _
       card))))
(define-reversible-migration RevisionDashboardMigrateGridFrom18To24
  (let [migrate! (fn [revision]
                   (let [object (json/parse-string (:object revision) keyword)]
                     (when (seq (:cards object))
                       (t2/query {:update :revision
                                  :set {:object (json/generate-string (update object :cards #(map migrate-dashboard-grid-from-18-to-24 %)))}
                                  :where [:= :id (:id revision)]}))))]
    (run! migrate! (t2/reducible-query {:select [:*]
                                        :from   [:revision]
                                        :where  [:= :model "Dashboard"]})))
  (let [roll-back! (fn [revision]
                     (let [object (json/parse-string (:object revision) keyword)]
                       (when (seq (:cards object))
                         (t2/query {:update :revision
                                     :set {:object (json/generate-string (update object :cards #(map migrate-dashboard-grid-from-24-to-18 %)))}
                                     :where [:= :id (:id revision)]}))))]
    (run! roll-back! (t2/reducible-query {:select [:*]
                                          :from   [:revision]
                                          :where  [:= :model "Dashboard"]}))))
(define-migration RevisionMigrateLegacyColumnSettingsFieldRefs
  (let [update-one! (fn [{:keys [id object]}]
                      (let [object  (json/parse-string object)
                            updated (update object "visualization_settings" update-legacy-field-refs-in-viz-settings)]
                        (when (not= updated object)
                          (t2/query-one {:update :revision
                                         :set    {:object (json/generate-string updated)}
                                         :where  [:= :id id]}))))]
    (run! update-one! (t2/reducible-query {:select [:id :object]
                                           :from   [:revision]
                                           :where  [:and
                                                    [:= :model "Card"]
                                                    [:or
                                                     ;; these match legacy field refs in column_settings
                                                     [:like :object "%ref\\\\\",[\\\\\"field-id%"]
                                                     [:like :object "%ref\\\\\",[\\\\\"field-literal%"]
                                                     [:like :object "%ref\\\\\",[\\\\\"fk->%"]
                                                     ;; MySQL with NO_BACKSLASH_ESCAPES disabled:
                                                     [:like :object "%ref\\\\\\\",[\\\\\\\"field-id%"]
                                                     [:like :object "%ref\\\\\\\",[\\\\\\\"field-literal%"]
                                                     [:like :object "%ref\\\\\\\",[\\\\\\\"fk->%"]]]}))))
(define-reversible-migration RevisionAddJoinAliasToColumnSettingsFieldRefs
  ;; This migration is essentially the same as `AddJoinAliasToColumnSettingsFieldRefs`, but for card revisions.
  ;; We can't use the same migration because cards in the revision table don't always have `result_metadata`.
  ;; So instead, we use the join aliases from card's `dataset_query` to create field refs in visualization_settings.
  ;; There will inevitably be extra entries in visualization_settings.column_settings that don't match field refs in result_metadata, but that's ok.
  (let [add-join-aliases
        (fn [card]
          (let [join-aliases (->> (get-in card ["dataset_query" "query" "joins"])
                                  (map #(get % "alias"))
                                  set)]
            (if (seq join-aliases)
              (update (get card "visualization_settings") "column_settings"
                      (fn [column_settings]
                        (let [copies-with-join-alias (into {}
                                                           (mapcat (fn [[k v]]
                                                                     (match (vec (json/parse-string k))
                                                                       ["ref" ["field" id opts]]
                                                                       (for [alias join-aliases]
                                                                         [(json/generate-string ["ref" ["field" id (assoc opts "join-alias" alias)]]) v])
                                                                       _ '()))
                                                                   column_settings))]
                          ;; existing column settings should take precedence over the copies in case there is a conflict
                          (merge copies-with-join-alias column_settings))))
              card)))
        update-one!
        (fn [revision]
          (let [card (json/parse-string (:object revision))]
            (when (not= (get card "query_type") "native") ; native queries won't have join aliases, so we can exclude them straight away
              (let [updated (add-join-aliases card)]
                (when (not= updated (get "visualization_settings" card))
                  (t2/query {:update :revision
                             :set {:object (json/generate-string (assoc card "visualization_settings" updated))}
                             :where [:= :id (:id revision)]}))))))]
    (run! update-one! (t2/reducible-query {:select [:*]
                                           :from   [:revision]
                                           :where  [:and
                                                 ;; only include cards with field refs in column_settings
                                                    [:or
                                                     [:like :object "%ref\\\\\",[\\\\\"field%"]
                                                     [:like :object "%ref\\\\\\\",[\\\\\\\"field%"]]
                                                 ;; only include cards with joins
                                                    [:like :object "%joins%"]
                                                    [:= :model "Card"]]})))
  ;; Reverse migration
  (let [update-one!
        (fn [revision]
          (let [card (json/parse-string (:object revision))]
            (when (not= (get card "query_type") "native")
              (let [viz-settings (get card "visualization_settings")
                    updated      (remove-join-alias-from-column-settings-field-refs viz-settings)]
                (when (not= updated viz-settings)
                  (t2/query {:update :revision
                             :set {:object (json/generate-string (assoc card "visualization_settings" updated))}
                             :where [:= :id (:id revision)]}))))))]
    (run! update-one! (t2/reducible-query {:select [:*]
                                           :from   [:revision]
                                           :where  [:and
                                                    [:or
                                                     [:like :object "%ref\\\\\",[\\\\\"field%"]
                                                     [:like :object "%ref\\\\\\\",[\\\\\\\"field%"]]
                                                    [:like :object "%join-alias%"]
                                                    [:= :model "Card"]]}))))
(define-migration MigrateLegacyDashboardCardColumnSettingsFieldRefs
  (let [update-one! (fn [{:keys [id visualization_settings]}]
                      (let [parsed  (json/parse-string visualization_settings)
                            updated (update-legacy-field-refs-in-viz-settings parsed)]
                        (when (not= parsed updated)
                          (t2/query-one {:update :report_dashboardcard
                                         :set    {:visualization_settings (json/generate-string updated)}
                                         :where  [:= :id id]}))))]
    (run! update-one! (t2/reducible-query
                       {:select [:id :visualization_settings]
                        :from   [:report_dashboardcard]
                        :where  [:and
                                 [:<> :card_id nil]
                                 [:or
                                  ;; these match legacy field refs in column_settings
                                  [:like :visualization_settings "%ref\\\\\",[\\\\\"field-id%"]
                                  [:like :visualization_settings "%ref\\\\\",[\\\\\"field-literal%"]
                                  [:like :visualization_settings "%ref\\\\\",[\\\\\"fk->%"]
                                  ;; MySQL with NO_BACKSLASH_ESCAPES disabled:
                                  [:like :visualization_settings "%ref\\\\\\\",[\\\\\\\"field-id%"]
                                  [:like :visualization_settings "%ref\\\\\\\",[\\\\\\\"field-literal%"]
                                  [:like :visualization_settings "%ref\\\\\\\",[\\\\\\\"fk->%"]]]}))))
(define-reversible-migration AddJoinAliasToDashboardCardColumnSettingsFieldRefs
  (let [update-one! (fn [{:keys [id visualization_settings result_metadata]}]
                      (let [updated (add-join-alias-to-column-settings-refs {:visualization_settings visualization_settings
                                                                             :result_metadata        result_metadata})]
                        (when (not= visualization_settings updated)
                          (t2/query-one {:update :report_dashboardcard
                                         :set    {:visualization_settings updated}
                                         :where  [:= :id id]}))))]
    (run! update-one! (t2/reducible-query {:select [:dc.id :dc.visualization_settings :c.result_metadata]
                                           :from   [[:report_card :c]]
                                           :join   [[:report_dashboardcard :dc] [:= :dc.card_id :c.id]]
                                           :where  [:and
                                                    [:or
                                                     [:= :c.query_type nil]
                                                     [:= :c.query_type "query"]]
                                                    [:or
                                                     [:like :dc.visualization_settings "%ref\\\\\",[\\\\\"field%"]
                                                     ; MySQL with NO_BACKSLASH_ESCAPES disabled
                                                     [:like :dc.visualization_settings "%ref\\\\\\\",[\\\\\\\"field%"]]
                                                    [:like :c.result_metadata "%join-alias%"]]})))
  (let [update! (fn [{:keys [id visualization_settings]}]
                  (let [parsed  (json/parse-string visualization_settings)
                        updated (remove-join-alias-from-column-settings-field-refs parsed)]
                    (when (not= parsed updated)
                      (t2/query-one {:update :report_dashboardcard
                                     :set    {:visualization_settings (json/generate-string updated)}
                                     :where  [:= :id id]}))))]
    (run! update! (t2/reducible-query {:select [:dc.id :dc.visualization_settings]
                                       :from   [[:report_card :c]]
                                       :join   [[:report_dashboardcard :dc] [:= :dc.card_id :c.id]]
                                       :where  [:and
                                                [:or
                                                 [:= :c.query_type nil]
                                                 [:= :c.query_type "query"]]
                                                [:or
                                                 [:like :dc.visualization_settings "%ref\\\\\",[\\\\\"field%"]
                                                 [:like :dc.visualization_settings "%ref\\\\\\\",[\\\\\\\"field%"]]
                                                [:like :dc.visualization_settings "%join-alias%"]]}))))
(define-migration RevisionMigrateLegacyDashboardCardColumnSettingsFieldRefs
  (let [update-one! (fn [{:keys [id object]}]
                      (let [object  (json/parse-string object)
                            updated (update object "cards" (fn [cards]
                                                             (map #(update % "visualization_settings" update-legacy-field-refs-in-viz-settings) cards)))]
                        (when (not= updated object)
                          (t2/query-one {:update :revision
                                         :set    {:object (json/generate-string updated)}
                                         :where  [:= :id id]}))))]
    (run! update-one! (t2/reducible-query {:select [:id :object]
                                           :from   [:revision]
                                           :where  [:and
                                                    [:= :model "Dashboard"]
                                                    [:or
                                                     ;; these match legacy field refs in column_settings
                                                     [:like :object "%ref\\\\\",[\\\\\"field-id%"]
                                                     [:like :object "%ref\\\\\",[\\\\\"field-literal%"]
                                                     [:like :object "%ref\\\\\",[\\\\\"fk->%"]
                                                     ;; MySQL with NO_BACKSLASH_ESCAPES disabled:
                                                     [:like :object "%ref\\\\\\\",[\\\\\\\"field-id%"]
                                                     [:like :object "%ref\\\\\\\",[\\\\\\\"field-literal%"]
                                                     [:like :object "%ref\\\\\\\",[\\\\\\\"fk->%"]]]}))))
(define-reversible-migration RevisionAddJoinAliasToDashboardCardColumnSettingsFieldRefs
  (let [add-join-aliases
        (fn [dashcard]
          (if-let [{:keys [dataset_query]} (t2/query-one {:select [:dataset_query]
                                                          :from   [:report_card]
                                                          :where  [:and
                                                                   [:or
                                                                    ;; native queries won't have join aliases, so we can exclude them
                                                                    [:= :query_type nil]
                                                                    [:= :query_type "query"]]
                                                                   [:= :id (get dashcard "card_id")]
                                                                   ;; only include cards with joins
                                                                   [:like :dataset_query "%joins%"]]})]
            (if-let [join-aliases (->> (get-in (json/parse-string dataset_query) ["query" "joins"])
                                       (map #(get % "alias"))
                                       set
                                       seq)]
              (m/update-existing-in dashcard ["visualization_settings" "column_settings"]
                                    (fn [column_settings]
                                      (let [copies-with-join-alias (into {}
                                                                         (mapcat (fn [[k v]]
                                                                                   (match (vec (json/parse-string k))
                                                                                     ["ref" ["field" id opts]]
                                                                                     (for [alias join-aliases]
                                                                                       [(json/generate-string ["ref" ["field" id (assoc opts "join-alias" alias)]]) v])
                                                                                     _ '()))
                                                                                 column_settings))]
                                        ;; existing column settings should take precedence over the copies in case there is a conflict
                                        (merge copies-with-join-alias column_settings))))
              dashcard)
            dashcard))
        update-one!
        (fn [revision]
          (let [dashboard (json/parse-string (:object revision))
                updated   (update dashboard "cards" (fn [dashcards]
                                                      (map add-join-aliases dashcards)))]
            (when (not= updated dashboard)
              (t2/query {:update :revision
                         :set    {:object (json/generate-string updated)}
                         :where  [:= :id (:id revision)]}))))]
    (run! update-one! (t2/reducible-query {:select [:*]
                                           :from   [:revision]
                                           :where  [:and
                                                    [:= :model "Dashboard"]
                                                    ;; only include cards with field refs in column_settings
                                                    [:or
                                                     [:like :object "%ref\\\\\",[\\\\\"field%"]
                                                     [:like :object "%ref\\\\\\\",[\\\\\\\"field%"]]]})))
  ;; Reverse migration
  (let [update-one!
        (fn [revision]
          (let [dashboard (json/parse-string (:object revision))
                updated   (update dashboard "cards"
                                  (fn [dashcards]
                                    (map #(update % "visualization_settings" remove-join-alias-from-column-settings-field-refs)
                                         dashcards)))]
            (when (not= updated dashboard)
              (t2/query {:update :revision
                         :set    {:object (json/generate-string updated)}
                         :where  [:= :id (:id revision)]}))))]
    (run! update-one! (t2/reducible-query {:select [:*]
                                           :from   [:revision]
                                           :where  [:and
                                                    [:= :model "Dashboard"]
                                                    [:or
                                                     [:like :object "%ref\\\\\",[\\\\\"field%"]
                                                     [:like :object "%ref\\\\\\\",[\\\\\\\"field%"]]
                                                    [:like :object "%join-alias%"]]}))))
(define-reversible-migration MigrateDatabaseOptionsToSettings
  (let [update-one! (fn [{:keys [id settings options]}]
                      (let [settings     (mi/encrypted-json-out settings)
                            options      (mi/json-out-with-keywordization options)
                            new-settings (mi/encrypted-json-in (merge settings options))]
                        (t2/query {:update :metabase_database
                                   :set    {:settings new-settings}
                                   :where  [:= :id id]})))]
    (run! update-one! (t2/reducible-query {:select [:id :settings :options]
                                           :from   [:metabase_database]
                                           :where  [:and
                                                    [:not= :options ]
                                                    [:not= :options "{}"]
                                                    [:not= :options nil]]})))
  (let [rollback-one! (fn [{:keys [id settings options]}]
                        (let [settings (mi/encrypted-json-out settings)
                              options  (mi/json-out-with-keywordization options)]
                          (when (some? (:persist-models-enabled settings))
                            (t2/query {:update :metabase_database
                                       :set    {:options (json/generate-string (select-keys settings [:persist-models-enabled]))
                                                :settings (mi/encrypted-json-in (dissoc settings :persist-models-enabled))}
                                       :where  [:= :id id]}))))]
    (run! rollback-one! (t2/reducible-query {:select [:id :settings :options]
                                             :from   [:metabase_database]}))))

Fix click through migration

Fixes click behavior settings on dashcards, returns nil if no fix available. Format changed from:

{... click click_link_template ...} to {... click_behavior { type linkType linkTemplate } ...}

at the top level and {... viewas linktemplate link_text ...} to { ... click_behavior { type linkType linkTemplate linkTextTemplate } ...}

at the column_settings level. Scours the card to find all click behavior, reshapes it, and deep merges it into the reshapen dashcard. scour for all links in the card, fixup the dashcard and then merge in any new click_behaviors from the card. See extensive tests for different scenarios.

We are in a migration so this returns nil if there is nothing to do so that it is filtered and we aren't running sql statements that are replacing data for no purpose.

Merging the following click behaviors in order (later merges on top of earlier): - fixed card click behavior - fixed dash click behavior - existing new style dash click behavior

(defn- fix-click-through
  [{id :id card :card_visualization dashcard :dashcard_visualization}]
  (let [remove-nil-keys (fn [m]
                          (into {} (remove #(nil? (val %)) m)))
        existing-fixed  (fn [settings]
                         (-> settings
                             (m/update-existing "column_settings"
                                                (fn [column_settings]
                                                  (m/map-vals
                                                   #(select-keys % ["click_behavior"])
                                                   column_settings)))
                             ;; select click behavior top level and in column settings
                             (select-keys ["column_settings" "click_behavior"])
                             (remove-nil-keys)))
        fix-top-level   (fn [toplevel]
                         (if (= (get toplevel "click") "link")
                           (assoc toplevel
                                  ;; add new shape top level
                                  "click_behavior"
                                  {"type"         (get toplevel "click")
                                   "linkType"     "url"
                                   "linkTemplate" (get toplevel "click_link_template")})
                           toplevel))
        fix-cols        (fn [column-settings]
                         (reduce-kv
                          (fn [m col field-settings]
                            (assoc m col
                                   ;; add the click stuff under the new click_behavior entry or keep the
                                   ;; field settings as is
                                   (if (and (= (get field-settings "view_as") "link")
                                            (contains? field-settings "link_template"))
                                     ;; remove old shape and add new shape under click_behavior
                                     (assoc field-settings
                                            "click_behavior"
                                            {"type"             (get field-settings "view_as")
                                             "linkType"         "url"
                                             "linkTemplate"     (get field-settings "link_template")
                                             "linkTextTemplate" (get field-settings "link_text")})
                                     field-settings)))
                          {}
                          column-settings))
        fixed-card      (-> (if (contains? dashcard "click")
                             (dissoc card "click_behavior") ;; throw away click behavior if dashcard has click
                             ;; behavior added
                             (fix-top-level card))
                           (update "column_settings" fix-cols) ;; fix columns and then select only the new shape from
                           ;; the settings tree
                           existing-fixed)
        fixed-dashcard  (update (fix-top-level dashcard) "column_settings" fix-cols)
        final-settings  (->> (m/deep-merge fixed-card fixed-dashcard (existing-fixed dashcard))
                            ;; remove nils and empty maps _AFTER_ deep merging so that the shapes are
                            ;; uniform. otherwise risk not fully clobbering an underlying form if the one going on top
                            ;; doesn't have link text
                            (walk/postwalk (fn [form]
                                             (if (map? form)
                                               (into {} (for [[k v] form
                                                              :when (if (seqable? v)
                                                                      ;; remove keys with empty maps. must be postwalk
                                                                      (seq v)
                                                                      ;; remove nils
                                                                      (some? v))]
                                                          [k v]))
                                               form))))]
    (when (not= final-settings dashcard)
      {:id                     id
       :visualization_settings final-settings})))
(defn- parse-to-json [& ks]
  (fn [x]
    (reduce #(update %1 %2 json/parse-string)
            x
            ks)))

This was previously a data migration, hence the metadata. The metadata is unused but potentially useful as documentation.

(defn- migrate-click-through!
  {:author "dpsutton"
   :added  "0.38.1"
   :doc    "Migration of old 'custom drill-through' to new 'click behavior'; see #15014"}
  []
  (transduce (comp (map (parse-to-json :card_visualization :dashcard_visualization))
                   (map fix-click-through)
                   (filter :visualization_settings))
             (completing
              (fn [_ {:keys [id visualization_settings]}]
                (t2/update! :report_dashboardcard id
                            {:visualization_settings (json/generate-string visualization_settings)})))
             nil
             ;; flamber wrote a manual postgres migration that this faithfully recreates: see
             ;; https://github.com/metabase/metabase/issues/15014
             (t2/query {:select [:dashcard.id
                                 [:card.visualization_settings :card_visualization]
                                 [:dashcard.visualization_settings :dashcard_visualization]]
                        :from   [[:report_dashboardcard :dashcard]]
                        :join   [[:report_card :card] [:= :dashcard.card_id :card.id]]
                        :where  [:or
                                 [:like
                                  :card.visualization_settings "%\"link_template\":%"]
                                 [:like
                                  :card.visualization_settings "%\"click_link_template\":%"]
                                 [:like
                                  :dashcard.visualization_settings "%\"link_template\":%"]
                                 [:like
                                  :dashcard.visualization_settings "%\"click_link_template\":%"]]})))
(define-migration MigrateClickThrough
  (migrate-click-through!))

Removing admin from group mapping migration

Get raw setting directly from DB. For some reasons during data-migration [[metabase.models.setting/get]] return the default value defined in [[metabase.models.setting/defsetting]] instead of value from Setting table.

(defn- raw-setting
  [k]
  (t2/select-one-fn :value :setting :key (name k)))
(defn- remove-admin-group-from-mappings-by-setting-key!
  [mapping-setting-key]
  (let [admin-group-id (t2/select-one-pk :permissions_group :name "Administrators")
        mapping        (try
                        (json/parse-string (raw-setting mapping-setting-key))
                        (catch Exception _e
                          {}))]
    (when-not (empty? mapping)
      (t2/update! :setting {:key (name mapping-setting-key)}
                  {:value
                   (->> mapping
                        (map (fn [[k v]] [k (filter #(not= admin-group-id %) v)]))
                        (into {})
                        json/generate-string)}))))
(defn- migrate-remove-admin-from-group-mapping-if-needed
  {:author "qnkhuat"
   :added  "0.43.0"
   :doc    "In the past we have a setting to disable group sync for admin group when using SSO or LDAP, but it's broken
            and haven't really worked (see #13820).
            In #20991 we remove this option entirely and make sync for admin group just like a regular group.
            But on upgrade, to make sure we don't unexpectedly begin adding or removing admin users:
              - for LDAP, if the `ldap-sync-admin-group` toggle is disabled, we remove all mapping for the admin group
              - for SAML, JWT, we remove all mapping for admin group, because they were previously never being synced
            if `ldap-sync-admin-group` has never been written, getting raw-setting will return a `nil`, and nil could
            also be interpreted as disabled. so checking `(not= x \"true\")` is safer than `(= x \"false\")`."}
  []
  (when (not= (raw-setting :ldap-sync-admin-group) "true")
    (remove-admin-group-from-mappings-by-setting-key! :ldap-group-mappings))
  ;; sso are enterprise feature but we still run this even in OSS in case a customer
  ;; have switched from enterprise -> SSO and stil have this mapping in Setting table
  (remove-admin-group-from-mappings-by-setting-key! :jwt-group-mappings)
  (remove-admin-group-from-mappings-by-setting-key! :saml-group-mappings))
(define-migration MigrateRemoveAdminFromGroupMappingIfNeeded
  (migrate-remove-admin-from-group-mapping-if-needed))
 
(ns metabase.db.data-source
  (:require
   [clojure.set :as set]
   [clojure.string :as str]
   [metabase.config :as config]
   [metabase.connection-pool :as connection-pool]
   [metabase.db.spec :as mdb.spec]
   [metabase.db.update-h2 :as update-h2]
   [metabase.util.log :as log]
   [potemkin :as p]
   [pretty.core :as pretty])
  (:import
   (java.sql DriverManager)
   (java.util Properties)))
(set! *warn-on-reflection* true)
(p/deftype+ DataSource [^String url ^Properties properties]
  pretty/PrettyPrintable
  (pretty [_]
    ;; in dev we can actually print out the details, it's useful in debugging. Everywhere else we should obscure them
    ;; because they're potentially sensitive.
    (if config/is-dev?
      (list `->DataSource url properties)
      (list `->DataSource (symbol "#_REDACTED") (symbol "#_REDACTED"))))
  javax.sql.DataSource
  (getConnection [_]
    (update-h2/update-if-needed! url)
    (if properties
      (DriverManager/getConnection url properties)
      (DriverManager/getConnection url)))
  ;; we don't use (.getConnection this url user password) so we don't need to implement it.
  (getConnection [_ _user _password]
    (throw (UnsupportedOperationException. "Use (.getConnection this) instead.")))
  Object
  (equals [_ another]
    (and (instance? DataSource another)
         (= (.url ^DataSource another) url)
         (= (.properties ^DataSource another) properties)))
  (toString [this]
    (pr-str (pretty/pretty this))))
(alter-meta! #'->DataSource assoc :private true)

Return a [[javax.sql.DataSource]] given a raw JDBC connection string.

(defn raw-connection-string->DataSource
  (^javax.sql.DataSource [s]
   (raw-connection-string->DataSource s nil nil))
  (^javax.sql.DataSource [s username password]
   {:pre [(string? s)]}
   ;; normalize the protocol in case someone is trying to trip us up. Heroku is known for this and passes stuff in
   ;; like `postgres:...` to screw with us.
   (let [s     (cond-> s
                 (str/starts-with? s "postgres:")   (str/replace-first #"^postgres:" "postgresql:")
                 (not (str/starts-with? s "jdbc:")) (str/replace-first #"^" "jdbc:"))
         ;; Even tho they're invalid we need to handle strings like `postgres://user:password@host:port` for legacy
         ;; reasons. (I think this is also how some places like Heroku ship them in order to make our lives hard) So
         ;; strip those out with the absolute minimum of parsing we can get away with and then pass them in separately
         ;; -- see #14678 and #20121
         ;;
         ;; NOTE: if password is URL-encoded this isn't going to work, since we're not URL-decoding it. I don't think
         ;; that's a problem we really have to worry about, and at any rate we have never supported it. We did
         ;; URL-decode things at one point, but that was only because [[clojure.java.jdbc]] tries to parse connection
         ;; strings itself if you let it -- see #14836. We never let it see connection strings anymore, so that
         ;; shouldn't be a problem. At any rate #20122 would probably solve most people's problems if their password
         ;; contains special characters.
         [s m] (if-let [[_ subprotocol user password more] (re-find #"^jdbc:((?:postgresql)|(?:mysql))://([^:@]+)(?::([^@:]+))?@(.+$)" s)]
                 [(str "jdbc:" subprotocol "://" more)
                  (merge {:user user}
                         (when (seq password)
                           {:password password}))]
                 [s nil])
         ;; these can't be i18n'ed because the app DB isn't set up yet
         _     (when (and (:user m) (seq username))
                 (log/error "Connection string contains a username, but MB_DB_USER is specified. MB_DB_USER will be used."))
         _     (when (and (:password m) (seq password))
                 (log/error "Connection string contains a password, but MB_DB_PASS is specified. MB_DB_PASS will be used."))
         m     (cond-> m
                 (seq username) (assoc :user username)
                 (seq password) (assoc :password password))]
     (->DataSource s (some-> (not-empty m) connection-pool/map->properties)))))

Return a [[javax.sql.DataSource]] given a broken-out Metabase connection details.

(defn broken-out-details->DataSource
  ^javax.sql.DataSource [db-type details]
  {:pre [(keyword? db-type) (map? details)]}
  (let [{:keys [subprotocol subname], :as spec} (mdb.spec/spec db-type (set/rename-keys details {:dbname :db}))
        _                                       (assert subprotocol)
        _                                       (assert subname)
        url                                     (format "jdbc:%s:%s" subprotocol subname)
        properties                              (some-> (not-empty (dissoc spec :classname :subprotocol :subname))
                                                        connection-pool/map->properties)]
    (->DataSource url properties)))
 

Logic related to fetching and working with the connection details for the application database. These are provided by environment variables -- either as a single JDBC connection URL string (MB_DB_CONNECTION_URI) or as broken-out environment variables e.g. MB_DB_TYPE, MB_DB_HOST, etc. MB_DB_CONNECTION_URI is used preferentially if both are specified.

There are three ways you can specify application JDBC connection information for Metabase:

  1. As broken-out connection details -- see [[env]] for a list of env vars. This is basically the same format the actual :details map we save when creating a [[metabase.models.Database]] object. We convert this to a [[clojure.java.jdbc]] spec map using [[metabase.db.spec/spec]] and then to create a [[javax.sql.DataSource]] from it. See [[mdb.data-source/broken-out-details->DataSource]].

  2. As a JDBC connection string specified by MB_DB_CONNECTION_URI. This is used to create a [[javax.sql.DataSource]]. See [[mdb.data-source/raw-connection-string->DataSource]].

  3. As a JDBC connection string (MB_DB_CONNECTION_URI) with username (MB_DB_USER) and/or password (MB_DB_PASS) passed separately. Support for this was added in Metabase 0.43.0 -- see #20122.

This namespace exposes the vars [[db-type]] and [[data-source]] based on the aforementioned environment variables. Normally you should use the equivalent functions in [[metabase.db.connection]] which can be overridden rather than using this namespace directly.

(ns metabase.db.env
  (:require
   [clojure.java.io :as io]
   [clojure.string :as str]
   [metabase.config :as config]
   [metabase.db.data-source :as mdb.data-source]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]))
(set! *warn-on-reflection* true)

[[env->db-type]]

(defn- raw-connection-string->type [s]
  (when (seq s)
    (when-let [[_protocol subprotocol] (re-find #"^(?:jdbc:)?([^:]+):" s)]
      (condp = subprotocol
        "postgresql" :postgres
        (keyword subprotocol)))))
(mu/defn ^:private env->db-type :- [:enum :postgres :mysql :h2]
  [{:keys [mb-db-connection-uri mb-db-type]}]
  (or (some-> mb-db-connection-uri raw-connection-string->type)
      mb-db-type))

[[env->DataSource]]

Takes a filename and converts it to H2-compatible filename.

(defn- get-db-file
  [db-file-name]
  ;; H2 wants file path to always be absolute
  (str "file:" (.getAbsolutePath (io/file db-file-name))))
(defn- env->db-file
  [{:keys [mb-db-in-memory mb-db-file]}]
  (if mb-db-in-memory
    ;; In-memory (i.e. test) DB
    "mem:metabase"
    ;; File-based DB
    (get-db-file mb-db-file)))
(def ^:private h2-connection-properties
  ;; see https://h2database.com/html/features.html for explanation of options
  {;; DB_CLOSE_DELAY=-1 = don't close the Database until the JVM shuts down
   :DB_CLOSE_DELAY -1
   ;; we need to enable MVCC for Quartz JDBC backend to work! Quartz depends on row-level locking, which means without
   ;; MVCC we "will experience dead-locks". MVCC is the default for everyone using the MVStore engine anyway so this
   ;; only affects people still with legacy PageStore databases
   :MVCC           true
   ;; Tell H2 to defrag when Metabase is shut down -- can reduce DB size by multiple GIGABYTES -- see #6510
   :DEFRAG_ALWAYS  true
   ;; LOCK_TIMEOUT=60000 = wait up to one minute to acquire table lock instead of default of 1 second
   :LOCK_TIMEOUT   60000})

Connection details that can be used when pretending the Metabase DB is itself a Database (e.g., to use the Generic SQL driver functions on the Metabase DB itself).

(defn- broken-out-details
  [db-type {:keys [mb-db-dbname mb-db-host mb-db-pass mb-db-port mb-db-user], :as env-vars}]
  (if (= db-type :h2)
    (assoc h2-connection-properties
           :db (env->db-file env-vars))
    {:host     mb-db-host
     :port     mb-db-port
     :db       mb-db-dbname
     :user     mb-db-user
     :password mb-db-pass}))
(defn- env->DataSource
  [db-type {:keys [mb-db-connection-uri mb-db-user mb-db-pass], :as env-vars}]
  (if mb-db-connection-uri
    (mdb.data-source/raw-connection-string->DataSource mb-db-connection-uri mb-db-user mb-db-pass)
    (mdb.data-source/broken-out-details->DataSource db-type (broken-out-details db-type env-vars))))

exports: [[db-type]], [[db-file]], and [[data-source]] created using environment variables.

(defmulti ^:private env-defaults
  {:arglists '([db-type])}
  keyword)
(defmethod env-defaults :h2
  [_db-type]
  nil)
(defmethod env-defaults :mysql
  [_db-type]
  {:mb-db-host "localhost"
   :mb-db-port 3306})
(defmethod env-defaults :postgres
  [_db-type]
  {:mb-db-host "localhost"
   :mb-db-port 5432})
(defn- env* [db-type]
  (merge-with
   (fn [env-value default-value]
     (if (nil? env-value)
       default-value
       env-value))
   {:mb-db-type           db-type
    :mb-db-in-memory      (config/config-bool :mb-db-in-memory)
    :mb-db-file           (config/config-str :mb-db-file)
    :mb-db-connection-uri (config/config-str :mb-db-connection-uri)
    :mb-db-host           (config/config-str :mb-db-host)
    :mb-db-port           (config/config-int :mb-db-port)
    :mb-db-dbname         (config/config-str :mb-db-dbname)
    :mb-db-user           (config/config-str :mb-db-user)
    :mb-db-pass           (config/config-str :mb-db-pass)}
   (env-defaults db-type)))

Metabase Datatbase environment. Used to setup application-db and audit-db for enterprise users.

(def env
  (env* (config/config-kw :mb-db-type)))

Keyword type name of the application DB details specified by environment variables. Matches corresponding driver name e.g. :h2, :mysql, or :postgres.

(def db-type
  (env->db-type env))
(when (= db-type :h2)
  (log/warn
   (u/format-color
    :red
    ;; Unfortunately this can't be i18n'ed because the application DB hasn't been initialized yet at the time we log
    ;; this and thus the site locale is unavailable.
    (str/join
     " "
     ["WARNING: Using Metabase with an H2 application database is not recommended for production deployments."
      "For production deployments, we highly recommend using Postgres, MySQL, or MariaDB instead."
      "If you decide to continue to use H2, please be sure to back up the database file regularly."
      "For more information, see https://metabase.com/docs/latest/operations-guide/migrating-from-h2.html"]))))

Path to our H2 DB file from env var or app config.

(defn db-file
  []
  (env->db-file env))

If someone is using Postgres and specifies ssl=true they might need to specify sslmode=require. Let's let them know about that to make their lives a little easier. See #8908 for more details.

(when-let [raw-connection-string (not-empty (:mb-db-connection-uri env))]
  (when (and (= db-type :postgres)
             (str/includes? raw-connection-string "ssl=true")
             (not (str/includes? raw-connection-string "sslmode=require")))
    ;; Unfortunately this can't be i18n'ed because the application DB hasn't been initialized yet at the time we log
    ;; this and thus the site locale is unavailable.
    (log/warn (str/join " " ["Warning: Postgres connection string with `ssl=true` detected."
                             "You may need to add `?sslmode=require` to your application DB connection string."
                             "If Metabase fails to launch, please add it and try again."
                             "See https://github.com/metabase/metabase/issues/8908 for more details."]))))

A [[javax.sql.DataSource]] ultimately derived from the environment variables.

(def ^javax.sql.DataSource data-source
  (env->DataSource db-type env))
 

Implementations of [[clojure.java.jdbc]] and [[next.jdbc]] protocols for the Metabase application database. These handle type mappings for setting parameters and for reading results from the DB — mainly by automatically converting CLOBs to Strings and using new java.time classes.

(ns metabase.db.jdbc-protocols
  (:require
   [clojure.java.jdbc :as jdbc]
   [clojure.string :as str]
   [java-time.api :as t]
   [metabase.db.connection :as mdb.connection]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date]
   [metabase.util.log :as log]
   [methodical.core :as methodical]
   [next.jdbc.prepare]
   [toucan2.jdbc.read :as t2.jdbc.read])
  (:import
   (java.io BufferedReader)
   (java.sql PreparedStatement ResultSet ResultSetMetaData Types)
   (java.time Instant LocalDate LocalDateTime LocalTime OffsetDateTime OffsetTime ZonedDateTime)))
(set! *warn-on-reflection* true)
(defn- set-object
  [^PreparedStatement stmt ^Integer index object ^Integer target-sql-type]
  (.setObject stmt index object target-sql-type))
(extend-protocol jdbc/ISQLParameter
  ;; DB's don't seem to handle Instant correctly so convert it to an OffsetDateTime with zone offset = 0
  Instant
  (set-parameter [t stmt i]
    (jdbc/set-parameter (t/offset-date-time t (t/zone-offset 0)) stmt i))

  LocalDate
  (set-parameter [t stmt i]
    (set-object stmt i t Types/DATE))

  LocalDateTime
  (set-parameter [t stmt i]
    (set-object stmt i t Types/TIMESTAMP))

  LocalTime
  (set-parameter [t stmt i]
    (set-object stmt i t Types/TIME))

  OffsetDateTime
  (set-parameter [t stmt i]
    (if (= (mdb.connection/db-type) :mysql)
      ;; Regardless of session timezone it seems to be the case that OffsetDateTimes get normalized to UTC inside MySQL
      ;;
      ;; Since MySQL TIMESTAMPs aren't timezone-aware this means comparisons are done between timestamps in the report
      ;; timezone and the local datetime portion of the parameter, in UTC. Bad!
      ;;
      ;; Convert it to a LocalDateTime, in the report timezone, so comparisions will work correctly.
      ;;
      ;; See also — https://dev.mysql.com/doc/refman/5.5/en/datetime.html
      (let [offset (.. (t/zone-id) getRules (getOffset (t/instant t)))
            t      (t/local-date-time (t/with-offset-same-instant t offset))]
        (set-object stmt i t Types/TIMESTAMP))
      ;; h2 and Postgres work as expected
      (set-object stmt i t Types/TIMESTAMP_WITH_TIMEZONE)))

  ;; MySQL, Postgres, and H2 all don't support OffsetTime
  OffsetTime
  (set-parameter [t stmt i]
    (set-object stmt i (t/local-time (t/with-offset-same-instant t (t/zone-offset 0))) Types/TIME))

  ;; Similarly, none of them handle ZonedDateTime out of the box either, so convert it to an OffsetDateTime first
  ZonedDateTime
  (set-parameter [t stmt i]
    (jdbc/set-parameter (t/offset-date-time t) stmt i))

  ;; JDBC drivers don't know about Clojure ratios. So just set them as a double instead. That should be ok enough for
  ;; now.
  clojure.lang.Ratio
  (set-parameter [ratio stmt i]
    (jdbc/set-parameter (double ratio) stmt i)))

Convert an H2 clob to a String.

(defn clob->str
  ^String [^org.h2.jdbc.JdbcClob clob]
  (when clob
    (letfn [(->str [^BufferedReader buffered-reader]
              (loop [acc []]
                (if-let [line (.readLine buffered-reader)]
                  (recur (conj acc line))
                  (str/join "\n" acc))))]
      (with-open [reader (.getCharacterStream clob)]
        (if (instance? BufferedReader reader)
          (->str reader)
          (with-open [buffered-reader (BufferedReader. reader)]
            (->str buffered-reader)))))))
(extend-protocol jdbc/IResultSetReadColumn
  org.postgresql.util.PGobject
  (result-set-read-column [clob _ _]
    (.getValue clob))

  org.h2.jdbc.JdbcClob
  (result-set-read-column [clob _ _]
    (clob->str clob))

  org.h2.jdbc.JdbcBlob
  (result-set-read-column [^org.h2.jdbc.JdbcBlob blob _ _]
    (.getBytes blob 0 (.length blob))))
(defmulti ^:private read-column
  {:arglists '([rs rsmeta i])}
  (fn [_ ^ResultSetMetaData rsmeta ^Integer i]
    (.getColumnType rsmeta i)))
(defmethod read-column :default
  [^ResultSet rs _ ^Integer i]
  (.getObject rs i))
(defmethod read-column Types/TIMESTAMP
  [^ResultSet rs ^ResultSetMetaData rsmeta ^Integer i]
  (case (mdb.connection/db-type)
    :postgres
    ;; for some reason postgres `TIMESTAMP WITH TIME ZONE` columns still come back as `Type/TIMESTAMP`, which seems
    ;; like a bug with the JDBC driver?
    (let [^Class klass (if (= (u/lower-case-en (.getColumnTypeName rsmeta i)) "timestamptz")
                         OffsetDateTime
                         LocalDateTime)]
      (.getObject rs i klass))

    :mysql
    ;; MySQL TIMESTAMPS are actually TIMESTAMP WITH LOCAL TIME ZONE, i.e. they are stored normalized to UTC when stored.
    ;; However, MySQL returns them in the report time zone in an effort to make our lives horrible.
    ;;
    ;; Check and see if the column type is `TIMESTAMP` (as opposed to `DATETIME`, which is the equivalent of
    ;; LocalDateTime), and normalize it to a UTC timestamp if so.
    (when-let [t (.getObject rs i LocalDateTime)]
      (if (= (.getColumnTypeName rsmeta i) "TIMESTAMP")
        (t/with-offset-same-instant (t/offset-date-time t (t/zone-id)) (t/zone-offset 0))
        t))

    ;; h2
    (.getObject rs i LocalDateTime)))
(defmethod read-column Types/TIMESTAMP_WITH_TIMEZONE
  [^ResultSet rs _ ^Integer i]
  (.getObject rs i OffsetDateTime))
(defmethod read-column Types/DATE
  [^ResultSet rs _ ^Integer i]
  (.getObject rs i LocalDate))
(defmethod read-column Types/TIME
  [^ResultSet rs _ ^Integer i]
  (case (mdb.connection/db-type)
    :postgres
    ;; Sometimes Postgres times come back as strings like `07:23:18.331+00` (no minute in offset) and there's a bug in
    ;; the JDBC driver where it can't parse those correctly. We can do it ourselves in that case.
    (try
      (.getObject rs i LocalTime)
      (catch Throwable _
        (when-let [s (.getString rs i)]
          (log/tracef "Error in Postgres JDBC driver reading TIME value, fetching as string '%s'" s)
          (u.date/parse s))))

    ;; H2 & MySQL work as expected
    (.getObject rs i LocalTime)))
(defmethod read-column Types/TIME_WITH_TIMEZONE
  [^ResultSet rs _ ^Integer i]
  (.getObject rs i OffsetTime))

Default clojure.java.jdbc :read-columns method to use for Metabase. Reads temporal values as java.sql.time types rather than legacy java.sql.Timestamp and the like.

(defn read-columns
  [rs rsmeta indexes]
  (mapv
   (fn [i]
     (-> (read-column rs rsmeta i)
         (jdbc/result-set-read-column rsmeta i)))
   indexes))

[[next.jdbc]] and Toucan 2 mappings

(extend-protocol next.jdbc.prepare/SettableParameter
   ;; DB's don't seem to handle Instant correctly so convert it to an OffsetDateTime with zone offset = 0
  Instant
  (set-parameter [t stmt i]
    (jdbc/set-parameter (t/offset-date-time t (t/zone-offset 0)) stmt i))

  ZonedDateTime
  (set-parameter [t stmt i]
    (next.jdbc.prepare/set-parameter (t/offset-date-time t) stmt i))

  clojure.lang.Ratio
  (set-parameter [ratio stmt i]
    (next.jdbc.prepare/set-parameter (double ratio) stmt i)))
(methodical/defmethod t2.jdbc.read/read-column-thunk [:default :default java.sql.Types/OTHER]
  "Read Postgres `citext` columns out as Strings."
  [^java.sql.Connection conn model ^java.sql.ResultSet rset ^java.sql.ResultSetMetaData rsmeta ^Long i]
  (if (= (.getColumnTypeName rsmeta i) "citext")
    (fn get-citext-as-string []
      (.getString rset i))
    (next-method conn model rset rsmeta i)))
 

High-level Clojure wrapper around relevant parts of the Liquibase API.

(ns metabase.db.liquibase
  (:require
   [clojure.java.jdbc :as jdbc]
   [clojure.string :as str]
   [metabase.config :as config]
   [metabase.db.custom-migrations]
   [metabase.db.liquibase.h2 :as liquibase.h2]
   [metabase.db.liquibase.mysql :as liquibase.mysql]
   [metabase.plugins.classloader :as classloader]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.connection :as t2.conn])
  (:import
   (java.io StringWriter)
   (java.util List Map)
   (liquibase Contexts LabelExpression Liquibase RuntimeEnvironment Scope Scope$Attr Scope$ScopedRunner)
   (liquibase.change.custom CustomChangeWrapper)
   (liquibase.changelog ChangeLogIterator ChangeSet ChangeSet$ExecType)
   (liquibase.changelog.filter ChangeSetFilter)
   (liquibase.changelog.visitor AbstractChangeExecListener ChangeExecListener UpdateVisitor)
   (liquibase.database Database DatabaseFactory)
   (liquibase.database.jvm JdbcConnection)
   (liquibase.exception LockException)
   (liquibase.lockservice LockService LockServiceFactory)
   (liquibase.resource ClassLoaderResourceAccessor)))
(set! *warn-on-reflection* true)
(comment
  ;; load our custom migrations
  metabase.db.custom-migrations/keep-me)

register our custom MySQL SQL generators

(liquibase.mysql/register-mysql-generators!)

Liquibase uses java.util.logging (JUL) for logging, so we need to install the JUL -> Log4j2 bridge which replaces the default JUL handler with one that "writes" log messages to Log4j2. (Not sure this is the best place in the world to do this, but Liquibase is the only thing using JUL directly.)

See https://logging.apache.org/log4j/2.x/log4j-jul/index.html for more information.

(org.apache.logging.log4j.jul.Log4jBridgeHandler/install true nil true)

Liquibase logs a message for every ChangeSet directly to standard out -- see https://github.com/liquibase/liquibase/issues/2396 -- but we can disable this by setting the ConsoleUIService's output stream to the null output stream

(doto ^liquibase.ui.ConsoleUIService (.getUI (Scope/getCurrentScope))
  ;; we can't use `java.io.OutputStream/nullOutputStream` here because it's not available on Java 8
  (.setOutputStream (java.io.PrintStream. (org.apache.commons.io.output.NullOutputStream.))))

Liquibase setting used for upgrading instances running version < 45.

(def ^{:private true
       :doc     }
  ^String changelog-legacy-file "liquibase_legacy.yaml")

Liquibase setting used for upgrading a fresh instance or instances running version >= 45.

(def ^{:private true
       :doc     }
  ^String changelog-file "liquibase.yaml")

Return the proper changelog table name based on db type of the connection.

(defn changelog-table-name
  [^java.sql.Connection conn]
  (if (= "PostgreSQL" (-> conn .getMetaData .getDatabaseProductName))
    "databasechangelog"
    "DATABASECHANGELOG"))

Check if a table exists.

(defn table-exists?
  [table-name ^java.sql.Connection conn]
  (-> (.getMetaData conn)
      (.getTables  nil nil table-name (u/varargs String ["TABLE"]))
      jdbc/metadata-query
      seq
      boolean))
(defn- fresh-install?
  [^java.sql.Connection conn]
  (not (table-exists? (changelog-table-name conn) conn)))
(defn- decide-liquibase-file
  [^java.sql.Connection conn]
  (if (fresh-install? conn)
   changelog-file
   (let [latest-migration (->> (jdbc/query {:connection conn}
                                           [(format "select id from %s order by dateexecuted desc limit 1" (changelog-table-name conn))])
                               first
                               :id)]
     (cond
       (nil? latest-migration)
       changelog-file
       ;; post-44 installation downgraded to 45
       (= latest-migration "v00.00-000")
       changelog-file
       ;; pre 42
       (not (str/starts-with? latest-migration "v"))
       changelog-legacy-file
       (< (->> latest-migration (re-find #"v(\d+)\..*") second parse-long) 45)
       changelog-legacy-file
       :else
       changelog-file))))
(defn- liquibase-connection ^JdbcConnection [^java.sql.Connection jdbc-connection]
  (JdbcConnection. jdbc-connection))
(defn- h2? [^JdbcConnection liquibase-conn]
  (str/starts-with? (.getURL liquibase-conn) "jdbc:h2"))
(defn- database ^Database [^JdbcConnection liquibase-conn]
  (if (h2? liquibase-conn)
    (liquibase.h2/h2-database liquibase-conn)
    (.findCorrectDatabaseImplementation (DatabaseFactory/getInstance) liquibase-conn)))
(defn- liquibase ^Liquibase [^java.sql.Connection conn ^Database database]
  (Liquibase.
   ^String (decide-liquibase-file conn)
   (ClassLoaderResourceAccessor. (classloader/the-classloader))
   database))

Impl for [[with-liquibase-macro]].

(mu/defn do-with-liquibase
  [conn-or-data-source :- [:or (ms/InstanceOfClass java.sql.Connection) (ms/InstanceOfClass javax.sql.DataSource)]
   f                   :- fn?]
  ;; Custom migrations use toucan2, so we need to make sure it uses the same connection with liquibase
  (binding [t2.conn/*current-connectable* conn-or-data-source]
    (if (instance? java.sql.Connection conn-or-data-source)
      (f (->> conn-or-data-source liquibase-connection database (liquibase conn-or-data-source)))
      ;; closing the `LiquibaseConnection`/`Database` closes the parent JDBC `Connection`, so only use it in combination
      ;; with `with-open` *if* we are opening a new JDBC `Connection` from a JDBC spec. If we're passed in a `Connection`,
      ;; it's safe to assume the caller is managing its lifecycle.
      (with-open [conn           (.getConnection ^javax.sql.DataSource conn-or-data-source)
                  liquibase-conn (liquibase-connection conn)
                  database       (database liquibase-conn)]
        (f (liquibase conn database))))))

Execute body with an instance of a Liquibase bound to liquibase-binding.

(liquibase/with-liquibase [liquibase {:subname :postgres, ...}] (liquibase/migrate-up-if-needed! liquibase))

(defmacro with-liquibase
  {:style/indent 1}
  [[liquibase-binding conn-or-data-source] & body]
  `(do-with-liquibase
    ~conn-or-data-source
    (fn [~(vary-meta liquibase-binding assoc :tag (symbol (.getCanonicalName Liquibase)))]
      ~@body)))

Return a string of SQL containing the DDL statements needed to perform unrun liquibase migrations, custom migrations will be ignored.

(defn migrations-sql
  ^String [^Liquibase liquibase]
  ;; calling update on custom migrations will execute them, so we ignore it and generates
  ;; sql for SQL migrations only
  (doseq [^ChangeSet change (.listUnrunChangeSets liquibase nil nil)]
    (when (instance? CustomChangeWrapper (first (.getChanges change)))
      (.setIgnore change true)))
  (let [writer (StringWriter.)]
    (.update liquibase "" writer)
    (.toString writer)))

Returns a list of unrun migrations.

It's a good idea to check to make sure there's actually something to do before running (migrate :up) so we can skip creating and releasing migration locks, which is both slightly dangerous and a waste of time when we won't be using them.

(I'm not 100% sure whether Liquibase.update() still acquires locks if the database is already up-to-date)

(defn unrun-migrations
  [^Liquibase liquibase]
  (.listUnrunChangeSets liquibase nil (LabelExpression.)))

Is a migration lock in place for liquibase?

(defn- migration-lock-exists?
  ^Boolean [^Liquibase liquibase]
  (boolean (seq (.listLocks liquibase))))

(Attempt to) force release Liquibase migration locks.

(defn force-release-locks!
  [^Liquibase liquibase]
  (.forceReleaseLocks liquibase))

Attempts to release the liquibase lock if present. Logs but does not bubble up the exception if one occurs as it's intended to be used when a failure has occurred and bubbling up this exception would hide the real exception.

(defn release-lock-if-needed!
  [^Liquibase liquibase]
  (when (migration-lock-exists? liquibase)
    (try
      (force-release-locks! liquibase)
      (catch Exception e
        (log/error e (trs "Unable to release the Liquibase lock after a migration failure"))))))

Check and make sure the database isn't locked. If it is, sleep for 2 seconds and then retry several times. There's a chance the lock will end up clearing up so we can run migrations normally.

(defn- wait-for-migration-lock-to-be-cleared
  [^Liquibase liquibase]
  (u/auto-retry 5
    (when (migration-lock-exists? liquibase)
      (Thread/sleep 2000)
      (throw
       (LockException.
        (str
         (trs "Database has migration lock; cannot run migrations.")
         " "
         (trs "You can force-release these locks by running `java -jar metabase.jar migrate release-locks`.")))))))

Run any unrun liquibase migrations, if needed.

(defn migrate-up-if-needed!
  [^Liquibase liquibase]
  (log/info (trs "Checking if Database has unrun migrations..."))
  (if (seq (unrun-migrations liquibase))
    (do
     (log/info (trs "Database has unrun migrations. Waiting for migration lock to be cleared..."))
     (wait-for-migration-lock-to-be-cleared liquibase)
    ;; while we were waiting for the lock, it was possible that another instance finished the migration(s), so make
    ;; sure something still needs to be done...
     (let [unrun-migrations-count (count (unrun-migrations liquibase))]
       (if (pos? unrun-migrations-count)
         (let [^Contexts contexts nil
               start-time         (System/currentTimeMillis)]
           (log/info (trs "Migration lock is cleared. Running {0} migrations ..." unrun-migrations-count))
           (.update liquibase contexts)
           (log/info (trs "Migration complete in {0}" (u/format-milliseconds (- (System/currentTimeMillis) start-time)))))
         (log/info
          (trs "Migration lock cleared, but nothing to do here! Migrations were finished by another instance.")))))
    (log/info (trs "No unrun migrations found."))))

Run function f in a scope on the Liquibase instance liquibase. Liquibase scopes are used to hold configuration and parameters (akin to binding dynamic variables in Clojure). This function initializes the database and the resource accessor which are often required.

(defn run-in-scope-locked
  [^Liquibase liquibase f]
  (let [database (.getDatabase liquibase)
        ^LockService lock-service (.getLockService (LockServiceFactory/getInstance) database)
        scope-objects {(.name Scope$Attr/database) database
                       (.name Scope$Attr/resourceAccessor) (.getResourceAccessor liquibase)}]
    (Scope/child ^Map scope-objects
                 (reify Scope$ScopedRunner
                   (run [_]
                     (.waitForLock lock-service)
                     (try
                       (f)
                       (finally
                         (.releaseLock lock-service))))))))

Run update with the change log instances in liquibase.

(defn update-with-change-log
  ([liquibase]
   (update-with-change-log liquibase {}))
  ([^Liquibase liquibase
    {:keys [^List change-set-filters exec-listener]
     :or {change-set-filters []}}]
   (let [change-log     (.getDatabaseChangeLog liquibase)
         database       (.getDatabase liquibase)
         log-iterator   (ChangeLogIterator. change-log ^"[Lliquibase.changelog.filter.ChangeSetFilter;" (into-array ChangeSetFilter change-set-filters))
         update-visitor (UpdateVisitor. database ^ChangeExecListener exec-listener)
         runtime-env    (RuntimeEnvironment. database (Contexts.) nil)]
     (run-in-scope-locked
      liquibase
      #(.run ^ChangeLogIterator log-iterator update-visitor runtime-env)))))

Force migrating up. This does three things differently from [[migrate-up-if-needed!]]:

  1. This will force release the locks before start running
  2. Migrations that fail will be ignored

It can be used to fix situations where the database got into a weird state, as was common before the fixes made in

3295.

(mu/defn force-migrate-up-if-needed!
  [^Liquibase liquibase :- (ms/InstanceOfClass Liquibase)]
  ;; have to do this before clear the checksums else it will wait for locks to be released
  (release-lock-if-needed! liquibase)
  (.clearCheckSums liquibase)
  (when (seq (unrun-migrations liquibase))
    (let [change-log     (.getDatabaseChangeLog liquibase)
          fail-on-errors (mapv (fn [^ChangeSet change-set] [change-set (.getFailOnError change-set)])
                               (.getChangeSets change-log))
          exec-listener  (proxy [AbstractChangeExecListener] []
                           (willRun [^ChangeSet change-set _database-change-log _database _run-status]
                             (when (instance? ChangeSet change-set)
                               (log/info (format "Start executing migration with id %s" (.getId change-set)))))
                           (runFailed [^ChangeSet change-set _database-change-log _database ^Exception e]
                             (log/error (u/format-color 'red "[ERROR] %s" (.getMessage e))))
                           (ran [change-set _database-change-log _database ^ChangeSet$ExecType exec-type]
                             (when (instance? ChangeSet change-set)
                               (condp = exec-type
                                 ChangeSet$ExecType/EXECUTED
                                 (log/info (u/format-color 'green "[SUCCESS]"))
                                 ChangeSet$ExecType/FAILED
                                 (log/error (u/format-color 'red "[ERROR]"))
                                 (log/info (format "[%s]" (.name exec-type)))))))]
      (try
        (doseq [^ChangeSet change-set (.getChangeSets change-log)]
          (.setFailOnError change-set false))
        (update-with-change-log liquibase {:exec-listener exec-listener})
        (finally
          (doseq [[^ChangeSet change-set fail-on-error?] fail-on-errors]
            (.setFailOnError change-set fail-on-error?)))))))

Consolidate all previous DB migrations so they come from single file.

Previously migrations where stored in many small files which added seconds per file to the startup time because liquibase was checking the jar signature for each file. This function is required to correct the liquibase tables to reflect that these migrations were grouped into 2 files.

See https://github.com/metabase/metabase/issues/3715 Also see https://github.com/metabase/metabase/pull/34400

(mu/defn consolidate-liquibase-changesets!
  [conn :- (ms/InstanceOfClass java.sql.Connection)]
  (let [liquibase-table-name (changelog-table-name conn)
        statement            (format "UPDATE %s SET FILENAME = CASE WHEN ID = ? THEN ? WHEN ID < ? THEN ? ELSE ? END" liquibase-table-name)]
    (when-not (fresh-install? conn)
      (jdbc/execute!
       {:connection conn}
       [statement
        "v00.00-000" "migrations/001_update_migrations.yaml"
        "v45.00-001" "migrations/000_legacy_migrations.yaml"
        "migrations/001_update_migrations.yaml"]))))

Returns contiguous integers parsed from string s

(defn- extract-numbers
  [s]
  (map #(Integer/parseInt %) (re-seq #"\d+" s)))

Roll back migrations later than given Metabase major version

(defn rollback-major-version
  ;; default rollback to previous version
  ([db-type conn liquibase]
   ;; get current major version of Metabase we are running
   (rollback-major-version db-type conn liquibase (dec (config/current-major-version))))
  ;; with explicit target version
  ([_db-type conn ^Liquibase liquibase target-version]
   (when (or (not (integer? target-version)) (< target-version 44))
     (throw (IllegalArgumentException.
             (format "target version must be a number between 44 and the previous major version (%d), inclusive"
                     (config/current-major-version)))))
   ;; count and rollback only the applied change set ids which come after the target version (only the "v..." IDs need to be considered)
   (let [changeset-query (format "SELECT id FROM %s WHERE id LIKE 'v%%' ORDER BY ORDEREXECUTED ASC" (changelog-table-name conn))
         changeset-ids   (map :id (jdbc/query {:connection conn} [changeset-query]))
         ;; IDs in changesets do not include the leading 0/1 digit, so the major version is the first number
         ids-to-drop     (drop-while #(not= (inc target-version) (first (extract-numbers %))) changeset-ids)]
     (log/infof "Rolling back app database schema to version %d" target-version)
     (.rollback liquibase (count ids-to-drop) ""))))

Gets the latest version that was applied to the database.

(defn latest-applied-major-version
  [conn]
  (when-not (fresh-install? conn)
    (let [changeset-query (format "SELECT id FROM %s WHERE id LIKE 'v%%' ORDER BY ORDEREXECUTED DESC LIMIT 1" (changelog-table-name conn))
          changeset-id (last (map :id (jdbc/query {:connection conn} [changeset-query])))]
      (some-> changeset-id extract-numbers first))))

Get the latest version that Liquibase would apply if we ran migrations right now.

(defn latest-available-major-version
  [^Liquibase liquibase]
  (->> liquibase
       (.getDatabaseChangeLog)
       (.getChangeSets)
       (map #(.getId ^ChangeSet %))
       last
       extract-numbers
       first))
 

Custom implementation of the Liquibase H2 adapter that uppercases all identifiers. See #20611 for more details.

(ns metabase.db.liquibase.h2
  (:require
   [metabase.util :as u])
  (:import
   (liquibase.database.core H2Database)
   (liquibase.database.jvm JdbcConnection)))
(set! *warn-on-reflection* true)
(defn- upcase ^String [s]
  (some-> s u/upper-case-en))
(defn- h2-database* ^H2Database []
  (proxy [H2Database] []
    (quoteObject [object-name object-type]
      (let [^H2Database this this]
        (proxy-super quoteObject (upcase object-name) object-type)))
    (mustQuoteObjectName [_object-name _object-type]
      true)))

HACK! Create a [[java.lang.Package]] for the proxy class if one does not already exist. This is needed because:

  1. Liquibase will throw an NPE if the package for the class does not exist -- see https://github.com/liquibase/liquibase/blob/master/liquibase-core/src/main/java/liquibase/logging/core/JavaLogService.java#L45 and https://github.com/liquibase/liquibase/issues/2633

  2. In Java 9+, the JVM will automatically define a package when a class is created; in Java 8, it does not.

  3. The Clojure DynamicClassLoader does not create a Package -- see https://clojure.atlassian.net/browse/CLJ-1550?focusedCommentId=13025

This only does anything in REPL-based development; in the uberjar the proxy class will be AOT'ed and will have a package defined for it when it's loaded by the normal JVM classloader rather than the Clojure DynamicClassLoader

(let [klass (class (h2-database*))]
  (when-not (.getPackage klass)
    (let [method       (.getDeclaredMethod
                        ClassLoader
                        "definePackage"
                        (into-array Class [String String String String String String String java.net.URL]))
          class-name   (.getName klass)
          ;; e.g. metabase.db.liquibase.h2.proxy$liquibase.database.core
          package-name (.substring class-name 0 (.lastIndexOf class-name "."))]
      (doto method
        (.setAccessible true)
        (.invoke (.getClassLoader klass) (into-array Object [package-name nil nil nil nil nil nil nil]))
        (.setAccessible false))
      (assert (.getPackage klass) (format "Failed to create package for proxy class %s." class-name)))))

A version of the Liquibase H2 implementation that always converts identifiers to uppercase and then quotes them.

(defn h2-database
  ^H2Database [^JdbcConnection conn]
  (doto (h2-database*)
    (.setConnection conn)))
 
(ns metabase.db.liquibase.mysql
  (:require
   [clojure.string :as str])
  (:import
   (liquibase.database Database)
   (liquibase.database.core MySQLDatabase)
   (liquibase.sql Sql UnparsedSql)
   (liquibase.sqlgenerator SqlGeneratorFactory)
   (liquibase.sqlgenerator.core AddColumnGenerator CreateTableGenerator SetColumnRemarksGenerator)
   (liquibase.structure DatabaseObject)))
(set! *warn-on-reflection* true)
(defn- mysql? [database]
  (instance? MySQLDatabase database))

Custom generator for ALTER TABLE ... MODIFY COLUMN ... COMMENT statements. Due to upstream bug https://github.com/liquibase/liquibase/issues/2634 these do not work correctly in MySQL. This SQL generator is a no-op generator that skips these statements (most of our column remarks are added in CREATE TABLE anyway, so we're not losing much.)

(defn- column-remarks-generator
  ^SetColumnRemarksGenerator []
  (proxy [SetColumnRemarksGenerator] []
    (getPriority []
      (let [^SetColumnRemarksGenerator this this]
        (inc (proxy-super getPriority))))
    (supports [statement database]
      (let [^SetColumnRemarksGenerator this this]
        (and (proxy-super supports statement database)
             (mysql? database))))
    (generateSql [_statement _database _sql-generator-chain]
      (into-array Sql []))))

we need a separate ADD COLUMN generator in case an ADD COLUMN migration is being on launch without any CREATE TABLE migrations happening before it

It seems like Liquibase actually ignores the defaultValueComputed that we set in the migrations YAML file -- see https://stackoverflow.com/questions/58816496/force-liquibase-to-current-timestamp-instead-of-now -- so we will do it manually.

(defn- set-mysql-current-datetime-function!
  [^Database database]
  (.setCurrentDateTimeFunction database "current_timestamp(6)"))

We need generators for both ADD COLUMN and for CREATE TABLE because if we have say just one new migration that is one type or the other then we need to have that specific generator call [[set-mysql-current-datetime-function!]].

TODO -- we should probably add a generate for ADD DEFAULT VALUE too. I assumed this didn't work so for a lot of MySQL/MariaDB migrations that add defaults values to timestamp columns we've written them as plain SQL... if we added the generator for addDefaultValue then we wouldn't need to write those migrations by hand.

Custom generator for ALTER TABLE ... ADD COLUMN statements.

This uses current_timestamp(6) as the current date time function.

(defn- add-column-generator
  ^AddColumnGenerator []
  (proxy [AddColumnGenerator] []
    (getPriority []
      (let [^AddColumnGenerator this this]
        (inc (proxy-super getPriority))))
    (supports [statement database]
      (let [^AddColumnGenerator this this]
        (and (proxy-super supports statement database)
             (mysql? database))))
    (generateSql [statement database sql-generator-chain]
      (set-mysql-current-datetime-function! database)
      (let [^AddColumnGenerator this this]
        (proxy-super generateSql statement database sql-generator-chain)))))

Custom generator for CREATE TABLE statements. This does two things:

  • Uses current_timestamp(6) as the current date time function
  • Adds CHARACTER SET and COLLATE info at the end of the statement to force UTF-8
(defn- create-table-generator
  ^CreateTableGenerator []
  (proxy [CreateTableGenerator] []
    (getPriority []
      (let [^CreateTableGenerator this this]
        (inc (proxy-super getPriority))))
    (supports [statement database]
      (let [^CreateTableGenerator this this]
        (and (proxy-super supports statement database)
             (mysql? database))))
    (generateSql [statement ^Database database sql-generator-chain]
      (set-mysql-current-datetime-function! database)
      (let [^CreateTableGenerator this this]
        (into-array
         Sql
         (map (fn [^Sql sql]
                (if-not (str/starts-with? (.toSql sql) "CREATE TABLE")
                  sql
                  (UnparsedSql. (str (.toSql sql)
                                     " ENGINE InnoDB CHARACTER SET utf8mb4 COLLATE utf8mb4_unicode_ci;")
                                (into-array DatabaseObject (.getAffectedDatabaseObjects sql)))))
              (proxy-super generateSql statement database sql-generator-chain)))))))

Register our custom MySQL SQL generators.

(defn register-mysql-generators!
  []
  (doto (SqlGeneratorFactory/getInstance)
    (.register (column-remarks-generator))
    (.register (add-column-generator))
    (.register (create-table-generator))))
 

Predefined MBQL queries for getting metadata about an external database.

TODO -- these have nothing to do with the application database. This namespace should be renamed something like metabase.driver.util.metadata-queries.

(ns metabase.db.metadata-queries
  (:require
   [metabase.driver :as driver]
   [metabase.driver.util :as driver.u]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.schema.helpers :as helpers]
   [metabase.models.table :as table :refer [Table]]
   [metabase.query-processor :as qp]
   [metabase.query-processor.interface :as qp.i]
   [metabase.util :as u]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))
(defn- qp-query [db-id mbql-query]
  {:pre [(integer? db-id)]}
  (-> (binding [qp.i/*disable-qp-logging* true]
        (qp/process-query
         {:type       :query
          :database   db-id
          :query      mbql-query
          :middleware {:disable-remaps? true}}))
      :data
      :rows))
(defn- field-query [{table-id :table_id} mbql-query]
  {:pre [(integer? table-id)]}
  (qp-query (t2/select-one-fn :db_id Table, :id table-id)
            ;; this seeming useless `merge` statement IS in fact doing something important. `ql/query` is a threading
            ;; macro for building queries. Do not remove
            (assoc mbql-query :source-table table-id)))

The absolute maximum number of results to return for a field-distinct-values query. Normally Fields with 100 or less values (at the time of this writing) get marked as auto-list Fields, meaning we save all their distinct values in a FieldValues object, which powers a list widget in the FE when using the Field for filtering in the QB. Admins can however manually mark any Field as list, which is effectively ordering Metabase to keep FieldValues for the Field regardless of its cardinality.

Of course, if a User does something crazy, like mark a million-arity Field as List, we don't want Metabase to explode trying to make their dreams a reality; we need some sort of hard limit to prevent catastrophes. So this limit is effectively a safety to prevent Users from nuking their own instance for Fields that really shouldn't be List Fields at all. For these very-high-cardinality Fields, we're effectively capping the number of FieldValues that get could saved.

This number should be a balance of:

  • Not being too low, which would definitely result in GitHub issues along the lines of 'My 500-distinct-value Field that I marked as List is not showing all values in the List Widget'
  • Not being too high, which would result in Metabase running out of memory dealing with too many values
(def ^Integer absolute-max-distinct-values-limit
  (int 1000))
(mu/defn field-distinct-values :- [:sequential ms/NonRemappedFieldValue]
  "Return the distinct values of `field`, each wrapped in a vector.
   This is used to create a `FieldValues` object for `:type/Category` Fields."
  ([field]
   (field-distinct-values field absolute-max-distinct-values-limit))
  ([field max-results :- ms/PositiveInt]
   (field-query field {:breakout [[:field (u/the-id field) nil]]
                       :limit    (min max-results absolute-max-distinct-values-limit)})))

Return the distinct count of field.

(defn field-distinct-count
  [field & [limit]]
  (-> (field-query field {:aggregation [[:distinct [:field (u/the-id field) nil]]]
                          :limit       limit})
      first first int))

Return the count of field.

(defn field-count
  [field]
  (-> (field-query field {:aggregation [[:count [:field (u/the-id field) nil]]]})
      first first int))

The maximum number of values we should return when using table-rows-sample. This many is probably fine for inferring semantic types and what-not; we don't want to scan millions of values at any rate.

(def max-sample-rows
  10000)

Number of rows to sample for tables with nested (e.g., JSON) columns.

(def nested-field-sample-limit
  500)

Schema for table-rows-sample options

(def ^:private TableRowsSampleOptions
  [:maybe
   [:map
    [:truncation-size {:optional true} :int]
    [:limit           {:optional true} :int]
    [:order-by        {:optional true} (helpers/distinct (helpers/non-empty [:sequential mbql.s/OrderBy]))]
    [:rff             {:optional true} fn?]]])

Identify text fields which can accept our substring optimization.

JSON and XML fields are now marked as :type/Structured but in the past were marked as :type/Text so its not enough to just check the base type.

(defn- text-field?
  [{:keys [base_type semantic_type]}]
  (and (= base_type :type/Text)
       (not (isa? semantic_type :type/Structured))))

Returns the mbql query to query a table for sample rows

(defn- table-rows-sample-query
  [table
   fields
   {:keys [truncation-size limit order-by] :or {limit max-sample-rows} :as _opts}]
  (let [database           (table/database table)
        driver             (driver.u/database->driver database)
        text-fields        (filter text-field? fields)
        field->expressions (when (and truncation-size (driver/database-supports? driver :expressions database))
                             (into {} (for [field text-fields]
                                        [field [(str (gensym "substring"))
                                                [:substring [:field (u/the-id field) nil]
                                                 1 truncation-size]]])))]
    {:database   (:db_id table)
     :type       :query
     :query      (cond-> {:source-table (u/the-id table)
                          :expressions  (into {} (vals field->expressions))
                          :fields       (vec (for [field fields]
                                               (if-let [[expression-name _] (get field->expressions field)]
                                                 [:expression expression-name]
                                                 [:field (u/the-id field) nil])))
                          :limit        limit}
                   order-by (assoc :order-by order-by))
     :middleware {:format-rows?           false
                  :skip-results-metadata? true}}))

Run a basic MBQL query to fetch a sample of rows of FIELDS belonging to a TABLE.

Options: a map of :truncation-size: [optional] size to truncate text fields if the driver supports expressions. :rff: [optional] a reducing function function (a function that given initial results metadata returns a reducing function) to reduce over the result set in the the query-processor rather than realizing the whole collection

(mu/defn table-rows-sample
  {:style/indent 1}
  ([table  :- (ms/InstanceOf :model/Table)
    fields :- [:sequential (ms/InstanceOf :model/Field)]
    rff]
   (table-rows-sample table fields rff nil))
  ([table  :- (ms/InstanceOf :model/Table)
    fields :- [:sequential (ms/InstanceOf :model/Field)]
    rff    :- fn?
    opts   :- TableRowsSampleOptions]
   (let [query (table-rows-sample-query table fields opts)
         qp    (requiring-resolve 'metabase.query-processor/process-query)]
     (qp query rff nil))))
(defmethod driver/table-rows-sample :default
  [_driver table fields rff opts]
  (table-rows-sample table fields rff opts))
 

Honey SQL 2 replacements for [[toucan.db/query]] and [[toucan.db/reducible-query]]. These are here to ease our transition to Honey SQL 2 and Toucan 2. Once we switch over to the latter we can hopefully remove this namespace.

PRO TIPS:

  1. You can enable debug logging for the compiled SQL locally by setting the log level for this namespace to :trace:

    ``` (metabase.test/set-ns-log-level! 'metabase.db.query :trace) ```

  2. If using CIDER, set

    ``` (setq cider-stacktrace-fill-column nil) ```

    So the nicely-formatted SQL in error messages doesn't get wrapped into a big blob in the *cider-error* buffer.

(ns metabase.db.query
  (:refer-clojure :exclude [compile])
  (:require
   [clojure.string :as str]
   [honey.sql :as sql]
   [metabase.db.connection :as mdb.connection]
   [metabase.driver :as driver]
   [metabase.plugins.classloader :as classloader]
   [metabase.util.log :as log]
   [toucan2.core :as t2]
   [toucan2.jdbc.options :as t2.jdbc.options]))
(set! *warn-on-reflection* true)

Return a nicely-formatted version of a query string with the current application db driver formatting.

(defn format-sql
  [sql]
  (driver/prettify-native-form (mdb.connection/db-type) sql))

Compile a query (e.g. a Honey SQL map) to [sql & args].

(defmulti compile
  {:arglists '([query])}
  type)
(defmethod compile String
  [sql]
  (compile [sql]))
(defmethod compile clojure.lang.IPersistentVector
  [sql-args]
  sql-args)
(defmethod compile clojure.lang.IPersistentMap
  [honey-sql]
  ;; make sure metabase.db.setup is loaded so the `:metabase.db.setup/application-db` gets defined
  (classloader/require 'metabase.db.setup)
  (let [sql-args (try
                   (sql/format honey-sql {:quoted true, :dialect :metabase.db.setup/application-db, :quoted-snake false})
                   (catch Throwable e
                     ;; this is not i18n'ed because it (hopefully) shouldn't be user-facing -- we shouldn't be running
                     ;; in to unexpected Honey SQL compilation errors at run time -- if we are it means we're not being
                     ;; careful enough with the Honey SQL forms we create which is a bug in the Metabase code we should
                     ;; have caught in tests.
                     (throw (ex-info (str "Error compiling Honey SQL: " (ex-message e))
                                     {:honey-sql honey-sql}
                                     e))))]
    (log/tracef "Compiled SQL:\n%s\nparameters: %s"
                (format-sql (first sql-args))
                (pr-str (rest sql-args)))
    sql-args))

Replacement for [[toucan.db/query]] -- uses Honey SQL 2 instead of Honey SQL 1, to ease the transition to the former (and to Toucan 2).

Query the application database and return all results at once.

See namespace documentation for [[metabase.db.query]] for pro debugging tips.

TODO -- we should mark this deprecated and tell people to use [[toucan2.core/query]] directly instead

(defn query
  [sql-args-or-honey-sql-map & {:as jdbc-options}]
  ;; make sure [[metabase.db.setup]] gets loaded so default Honey SQL options and the like are loaded.
  (classloader/require 'metabase.db.setup)
  (let [sql-args (compile sql-args-or-honey-sql-map)]
    ;; catch errors running the query and rethrow with the failing generated SQL and the failing Honey SQL form -- this
    ;; will help with debugging stuff. This should mostly be dev-facing because we should hopefully not be committing
    ;; any busted code into the repo
    (try
      (binding [t2.jdbc.options/*options* (merge t2.jdbc.options/*options* jdbc-options)]
        (t2/query sql-args))
      (catch Throwable e
        (let [formatted-sql (format-sql (first sql-args))]
          (throw (ex-info (str "Error executing SQL query: " (ex-message e)
                               \newline
                               \newline
                               formatted-sql)
                          {:sql        (str/split-lines (str/trim formatted-sql))
                           :args       (rest sql-args)
                           :uncompiled sql-args-or-honey-sql-map}
                          e)))))))

Replacement for [[toucan.db/reducible-query]] -- uses Honey SQL 2 instead of Honey SQL 1, to ease the transition to the former (and to Toucan 2).

Query the application database and return an IReduceInit.

See namespace documentation for [[metabase.db.query]] for pro debugging tips.

(defn reducible-query
  [sql-args-or-honey-sql-map & {:as jdbc-options}]
  ;; make sure [[metabase.db.setup]] gets loaded so default Honey SQL options and the like are loaded.
  (classloader/require 'metabase.db.setup)
  (let [sql-args (compile sql-args-or-honey-sql-map)]
    ;; It doesn't really make sense to put a try-catch around this since it will return immediately and not execute
    ;; until we actually reduce it
    (reify clojure.lang.IReduceInit
      (reduce [_this rf init]
        (binding [t2.jdbc.options/*options* (merge t2.jdbc.options/*options* jdbc-options)]
          (reduce rf init (t2/reducible-query sql-args)))))))
 

Code for setting up the application DB -- verifying that we can connect and for running migrations. Unlike code in metabase.db, code here takes a clojure.java.jdbc spec as a parameter; the higher-level code in metabase.db presents a similar set of functions but passes in the default (i.e., env var) application DB connection details automatically.

Because functions here don't know where the JDBC spec came from, you can use them to perform the usual application DB setup steps on arbitrary databases -- useful for functionality like the load-from-h2 or dump-to-h2 commands.

(ns metabase.db.setup
  (:require
   [honey.sql :as sql]
   [metabase.db.connection :as mdb.connection]
   [metabase.db.custom-migrations]
   [metabase.db.jdbc-protocols :as mdb.jdbc-protocols]
   [metabase.db.liquibase :as liquibase]
   [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn]
   [metabase.models.setting :as setting]
   [metabase.plugins.classloader :as classloader]
   [metabase.util :as u]
   [metabase.util.honey-sql-2]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [methodical.core :as methodical]
   [toucan2.honeysql2 :as t2.honeysql]
   [toucan2.jdbc.options :as t2.jdbc.options]
   [toucan2.pipeline :as t2.pipeline])
  (:import
   (liquibase.exception LockException)))
(set! *warn-on-reflection* true)
(comment
  ;; load our custom migrations
  metabase.db.custom-migrations/keep-me
  ;; needed so the `:h2` dialect gets registered with Honey SQL
  metabase.util.honey-sql-2/keep-me)

If we are not doing auto migrations then print out migration SQL for user to run manually. Then throw an exception to short circuit the setup process and make it clear we can't proceed.

(defn- print-migrations-and-quit-if-needed!
  [liquibase]
  (when (seq (liquibase/unrun-migrations liquibase))
    (log/info (str (trs "Database Upgrade Required")
                   "\n\n"
                   (trs "NOTICE: Your database requires updates to work with this version of Metabase.")
                   "\n"
                   (trs "Please execute the following sql commands on your database before proceeding.")
                   "\n\n"
                   (liquibase/migrations-sql liquibase)
                   "\n\n"
                   (trs "Once your database is updated try running the application again.")
                   "\n"))
    (throw (Exception. (trs "Database requires manual upgrade.")))))

Migrate the application database specified by data-source.

  • :up - Migrate up
  • :force - Force migrate up, ignoring locks and any DDL statements that fail.
  • :down - Rollback to the previous major version schema
  • :print - Just print the SQL for running the migrations, don't actually run them.
  • :release-locks - Manually release migration locks left by an earlier failed migration. (This shouldn't be necessary now that we run migrations inside a transaction, but is available just in case).
(mu/defn migrate!
  [db-type     :- :keyword
   data-source :- (ms/InstanceOfClass javax.sql.DataSource)
   direction   :- :keyword
   & args]
  ;; TODO: use [[jdbc/with-db-transaction]] instead of manually commit/rollback
  (with-open [conn (.getConnection ^javax.sql.DataSource data-source)]
    (.setAutoCommit conn false)
    ;; Set up liquibase and let it do its thing
    (log/info (trs "Setting up Liquibase..."))
    (liquibase/with-liquibase [liquibase conn]
      (try
       (liquibase/consolidate-liquibase-changesets! conn)
       (log/info (trs "Liquibase is ready."))
       (case direction
         :up            (liquibase/migrate-up-if-needed! liquibase)
         :force         (liquibase/force-migrate-up-if-needed! liquibase)
         :down          (apply liquibase/rollback-major-version db-type conn liquibase args)
         :print         (print-migrations-and-quit-if-needed! liquibase)
         :release-locks (liquibase/force-release-locks! liquibase))
       ;; Migrations were successful; commit everything and re-enable auto-commit
       (.commit conn)
       (.setAutoCommit conn true)
       :done
       ;; In the Throwable block, we're releasing the lock assuming we have the lock and we failed while in the
       ;; middle of a migration. It's possible that we failed because we couldn't get the lock. We don't want to
       ;; clear the lock in that case, so handle that case separately
       (catch LockException e
         (.rollback conn)
         (throw e))
       ;; If for any reason any part of the migrations fail then rollback all changes
       (catch Throwable e
         (.rollback conn)
         ;; With some failures, it's possible that the lock won't be released. To make this worse, if we retry the
         ;; operation without releasing the lock first, the real error will get hidden behind a lock error
         (liquibase/release-lock-if-needed! liquibase)
         (throw e))))))

Test connection to application database with data-source and throw an exception if we have any troubles connecting.

(mu/defn ^:private verify-db-connection
  [db-type     :- :keyword
   data-source :- (ms/InstanceOfClass javax.sql.DataSource)]
  (log/info (u/format-color 'cyan (trs "Verifying {0} Database Connection ..." (name db-type))))
  (classloader/require 'metabase.driver.util)
  (let [error-msg (trs "Unable to connect to Metabase {0} DB." (name db-type))]
    (try (assert (sql-jdbc.conn/can-connect-with-spec? {:datasource data-source}) error-msg)
         (catch Throwable e
           (throw (ex-info error-msg {} e)))))
  (with-open [conn (.getConnection ^javax.sql.DataSource data-source)]
    (let [metadata (.getMetaData conn)]
      (log/info (trs "Successfully verified {0} {1} application database connection."
                     (.getDatabaseProductName metadata) (.getDatabaseProductVersion metadata))
                (u/emoji "✅")))))
(mu/defn ^:private error-if-downgrade-required!
  [data-source :- (ms/InstanceOfClass javax.sql.DataSource)]
  (log/info (u/format-color 'cyan (trs "Checking if a database downgrade is required...")))
  (with-open [conn (.getConnection ^javax.sql.DataSource data-source)]
    (liquibase/with-liquibase [liquibase conn]
      (let [latest-available (liquibase/latest-available-major-version liquibase)
            latest-applied (liquibase/latest-applied-major-version conn)]
        ;; `latest-applied` will be `nil` for fresh installs
        (when (and latest-applied (< latest-available latest-applied))
          (log/error (str (u/format-color 'red (trs "ERROR: Downgrade detected."))
                          "\n\n"
                          (trs "Your metabase instance appears to have been downgraded without a corresponding database downgrade.")
                          "\n\n"
                          (trs "You must run `java -jar metabase.jar migrate down` from version {0}." latest-applied)
                          "\n\n"
                          (trs "Once your database has been downgraded, try running the application again.")
                          "\n\n"
                          (trs "See: https://www.metabase.com/docs/latest/installation-and-operation/upgrading-metabase#rolling-back-an-upgrade")))
          (throw (ex-info (trs "Downgrade detected. Please run `migrate down` from version {0}."
                            latest-applied)
                          {})))))))

Run through our DB migration process and make sure DB is fully prepared

(mu/defn ^:private run-schema-migrations!
  [db-type       :- :keyword
   data-source   :- (ms/InstanceOfClass javax.sql.DataSource)
   auto-migrate? :- [:maybe :boolean]]
  (log/info (trs "Running Database Migrations..."))
  (migrate! db-type data-source (if auto-migrate? :up :print))
  (log/info (trs "Database Migrations Current ... ") (u/emoji "✅")))

Connects to db and runs migrations. Don't use this directly, unless you know what you're doing; use [[metabase.db/setup-db!]] instead, which can be called more than once without issue and is thread-safe.

TODO -- consider renaming to something like verify-connection-and-migrate!

TODO -- consider whether this should be done automatically the first time someone calls getConnection

(mu/defn setup-db!
  [db-type       :- :keyword
   data-source   :- (ms/InstanceOfClass javax.sql.DataSource)
   auto-migrate? :- [:maybe :boolean]]
  (u/profile (trs "Database setup")
    (u/with-us-locale
       (binding [mdb.connection/*application-db* (mdb.connection/application-db db-type data-source :create-pool? false) ; should already be a pool
                 setting/*disable-cache*         true]
         (verify-db-connection db-type data-source)
         (error-if-downgrade-required! data-source)
         (run-schema-migrations! db-type data-source auto-migrate?))))
  :done)

Toucan Setup.

Done at namespace load time these days.

Quote SQL identifier string s appropriately for the currently bound application database.

create a custom HoneySQL quoting style called ::application-db that uses the appropriate quote function based on [[application-db]]; register this as the default quoting style for Toucan. Then

(defn quote-for-application-db
  ([s]
   (quote-for-application-db (mdb.connection/quoting-style (mdb.connection/db-type)) s))
  ([dialect s]
   {:pre [(#{:h2 :ansi :mysql} dialect)]}
   ((:quote (sql/get-dialect dialect)) s)))

register with Honey SQL 2

(sql/register-dialect!
 ::application-db
 (assoc (sql/get-dialect :ansi)
        :quote quote-for-application-db))
(reset! t2.honeysql/global-options
        {:quoted       true
         :dialect      ::application-db
         :quoted-snake false})
(reset! t2.jdbc.options/global-options
        {:read-columns mdb.jdbc-protocols/read-columns
         :label-fn     u/lower-case-en})
(methodical/defmethod t2.pipeline/build :around :default
  "Normally, our Honey SQL 2 `:dialect` is set to `::application-db`; however, Toucan 2 does need to know the actual
  dialect to do special query building magic. When building a Honey SQL form, make sure `:dialect` is bound to the
  *actual* dialect for the application database."
  [query-type model parsed-args resolved-query]
  (binding [t2.honeysql/*options* (assoc t2.honeysql/*options*
                                         :dialect (mdb.connection/quoting-style (mdb.connection/db-type)))]
    (next-method query-type model parsed-args resolved-query)))
 

Functions for creating JDBC DB specs for a given driver. Only databases that are supported as application DBs should have functions in this namespace; otherwise, similar functions are only needed by drivers, and belong in those namespaces.

(ns metabase.db.spec
  (:require
   [clojure.string :as str]
   [metabase.config :as config]))

Create a [[clojure.java.jdbc]] spec map from broken-out database details.

(defmulti spec
  {:arglists '([db-type details])}
  (fn [db-type _details]
    (keyword db-type)))
(defmethod spec :h2
  [_ {:keys [db]
      :or   {db "h2.db"}
      :as   opts}]
  (merge {:classname   "org.h2.Driver"
          :subprotocol "h2"
          :subname     db}
         (dissoc opts :db)))

Make a subname for the given host, port, and db params. Iff db is not blank, then a slash will precede it in the subname.

(defn make-subname
  {:arglists '([host port db]), :added "0.39.0"}
  [host port db]
  (str "//" (when-not (str/blank? host) (str host ":" port)) (if-not (str/blank? db) (str "/" db) "/")))
(defmethod spec :postgres
  [_ {:keys [host port db]
      :or   {host "localhost", port 5432, db ""}
      :as   opts}]
  (merge
   {:classname                     "org.postgresql.Driver"
    :subprotocol                   "postgresql"
    :subname                       (make-subname host (or port 5432) db)
    ;; I think this is done to prevent conflicts with redshift driver registering itself to handle postgres://
    :OpenSourceSubProtocolOverride true
    :ApplicationName               config/mb-version-and-process-identifier}
   (dissoc opts :host :port :db)))
(defmethod spec :mysql
  [_ {:keys [host port db]
      :or   {host "localhost", port 3306, db ""}
      :as   opts}]
  (merge
   {:classname   "org.mariadb.jdbc.Driver"
    :subprotocol "mysql"
    :subname     (make-subname host (or port 3306) db)}
   (dissoc opts :host :port :db)))

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! !! !! Don't put database spec functions for new drivers in this namespace. These ones are only here because they !! !! can also be used for the application DB in metabase.driver. Put functions like these for new drivers in the !! !! driver namespace itself. !! !! !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

 

Functions for updating an H2 v1.x database to v2.x

(ns metabase.db.update-h2
  (:require
   [clj-http.client :as http]
   [clojure.java.io :as io]
   [clojure.java.jdbc :as jdbc]
   [clojure.java.shell :as sh]
   [clojure.string :as str]
   [metabase.util.files :as u.files]
   [metabase.util.log :as log])
  (:import
   (java.nio.file Files)))
(set! *warn-on-reflection* true)

Generic utils

Returns seq of first n bytes of file at path

(defn- head
  [path n]
  (let [f (io/file path)
        bytes (byte-array n)]
    (with-open [input (io/input-stream f)]
      (take (.read input bytes) bytes))))

Tries to parse and return x as char, else nil

(defn- try-char
  [x]
  (try (char x) (catch IllegalArgumentException _ nil)))

H2-specific utils

Returns H2 database base path from JDBC URL, i.e. without .mv.db

(defn- h2-base-path
  [jdbc-url]
  (second (re-matches #"jdbc:h2:file:(.*)$" jdbc-url)))

Returns the H2 major version number of H2 MV database file at path, or nil if no file exists

(defn db-version
  [jdbc-url]
  ;; The H2 database version is indicated in the "format:" key of the MV file header, which is 4096 bytes
  ;; See: https://www.h2database.com/html/mvstore.html
  (when-let [path (str (h2-base-path jdbc-url) ".mv.db")]
    (when (.exists (io/file path))
      (let [header     (str/join (map try-char (head path 4096)))
            format-key "format:"]
        (when-not (.startsWith header "H:2")
          (throw (IllegalArgumentException. "File does not appear to be an H2 MV database file")))
        (Integer/parseInt (str (nth header (+ (.indexOf header format-key) (count format-key)))))))))

Migration constants/utils

(def ^:private v1-jar-url
  "https://repo1.maven.org/maven2/com/h2database/h2/1.4.197/h2-1.4.197.jar")
(defn- tmp-path
  [& components]
  (str (apply u.files/get-path (System/getProperty "java.io.tmpdir") components)))
(def ^:private jar-path
  (tmp-path (last (.split ^String v1-jar-url "/"))))
(def ^:private migration-sql-path
  (tmp-path "metabase-migrate-h2-db-v1-v2.sql"))

Migration logic

Updates existing H2 v1 database to H2 v2

(defn- update!
  [jdbc-url]
  (when-not (.exists (io/file jar-path))
    (log/info "Downloading" v1-jar-url)
    (io/copy (:body (http/get v1-jar-url {:as :stream})) (io/file jar-path)))
  (log/info "Creating v1 database backup at" migration-sql-path)
  (let [result (sh/sh "java" "-cp" jar-path "org.h2.tools.Script" "-url" jdbc-url "-script" migration-sql-path)]
    (when-not (= 0 (:exit result))
      (throw (ex-info "Dumping H2 database failed." {:result result}))))
  (let [base-path (h2-base-path jdbc-url)
        backup-path (str base-path ".v1-backup.mv.db")]
    (log/info "Moving old app database to" backup-path)
    (Files/move (u.files/get-path (str base-path ".mv.db"))
                (u.files/get-path backup-path)
                (into-array java.nio.file.CopyOption [])))
  (log/info "Restoring backup into v2 database")
  (jdbc/execute! {:connection-uri jdbc-url} ["RUNSCRIPT FROM ? FROM_1X" migration-sql-path])
  (log/info "Backup restored into H2 v2 database. Update complete!"))
(def ^:private h2-lock (Object.))

Updates H2 database at db-path from version 1.x to 2.x if jdbc-url points to version 1 H2 database.

(defn update-if-needed!
  [jdbc-url]
  (locking h2-lock
    (when (= 1 (db-version jdbc-url))
      (log/info "H2 v1 database detected, updating...")
      (try
        (update! jdbc-url)
        (catch Exception e
          (log/error "Failed to update H2 database:" e)
          (throw e))))))
 

Utility functions for querying the application database.

(ns metabase.db.util
  (:require
   [metabase.util :as u]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]
   [toucan2.model :as t2.model]))

Check if model is a toucan model.

(defn toucan-model?
  [model]
  (isa? model :metabase/model))

Returns a qualified field for [modelable] with [field-name].

(defn qualify
  ^clojure.lang.Keyword [modelable field-name]
  (if (vector? field-name)
    [(qualify modelable (first field-name)) (second field-name)]
    (let [model (t2.model/resolve-model modelable)]
      (keyword (str (name (t2.model/table-name model)) \. (name field-name))))))

Convenience for generating a HoneySQL JOIN clause.

(t2/select-pks-set FieldValues (mdb/join [FieldValues :field_id] [Field :id]) :active true)

(defn join
  [[source-entity fk] [dest-entity pk]]
  {:left-join [(t2/table-name (t2.model/resolve-model dest-entity))
               [:= (qualify source-entity fk) (qualify dest-entity pk)]]})
(def ^:private NamespacedKeyword
  [:and :keyword [:fn (comp seq namespace)]])
(mu/defn ^:private type-keyword->descendants :- [:set {:min 1} ms/NonBlankString]
  "Return a set of descendents of Metabase `type-keyword`. This includes `type-keyword` itself, so the set will always
  have at least one element.
     (type-keyword->descendants :Semantic/Coordinate) ; -> #{\"type/Latitude\" \"type/Longitude\" \"type/Coordinate\"}"
  [type-keyword :- NamespacedKeyword]
  (set (map u/qualified-name (cons type-keyword (descendants type-keyword)))))

Convenience for generating an HoneySQL IN clause for a keyword and all of its descendents. Intended for use with the type hierarchy in metabase.types.

(t2/select Field :semantic_type (mdb/isa :type/URL)) -> (t2/select Field :semantic_type [:in #{"type/URL" "type/ImageURL" "type/AvatarURL"}])

Also accepts optional expr for use directly in a HoneySQL where:

(t2/select Field {:where (mdb/isa :semantic_type :type/URL)}) -> (t2/select Field {:where [:in :semantic_type #{"type/URL" "type/ImageURL" "type/AvatarURL"}]})

(defn isa
  ([type-keyword]
   [:in (type-keyword->descendants type-keyword)])
  ;; when using this with an `expr` (e.g. `(isa :semantic_type :type/URL)`) just go ahead and take the results of the
  ;; one-arity impl above and splice expr in as the second element
  ;;
  ;;    [:in #{"type/URL" "type/ImageURL"}]
  ;;
  ;; becomes
  ;;
  ;;    [:in :semantic_type #{"type/URL" "type/ImageURL"}]
  ([expr type-keyword]
   [:in expr (type-keyword->descendants type-keyword)]))
 
(ns metabase.domain-entities.converters
  (:require
    [malli.core :as mc]
    [malli.transform :as mtx]
    [metabase.util :as u]))
(defn- decode-map [schema _]
  (let [by-prop (into {} (for [[map-key props] (mc/children schema)]
                           [(or (get props :js/prop)
                                (u/->snake_case_en (u/qualified-name map-key)))
                            {:map-key map-key}]))]
    {:enter (fn [x]
              (cond
                (map? x) x
                (object? x)
                (into {} (for [prop (js-keys x)
                               :let [js-val  (unchecked-get x prop)
                                     map-key (or (get-in by-prop [prop :map-key])
                                                 (keyword (u/->kebab-case-en prop)))]]
                           [map-key js-val]))))
     :leave (fn [x]
              (if (object? x)
                (throw (ex-info "decode-map leaving with a JS object not a CLJS map"
                                {:value  x
                                 :schema (mc/form schema)}))
                x))}))
(defn- infer-child-decoder [schema _]
  (let [mapping (into {} (for [c (mc/children schema)]
                           (if (keyword? c)
                             [(name c) c]
                             [c c])))]
    {:enter #(mapping % %)}))
(defn- infer-child-encoder [schema _]
  (let [mapping (into {} (for [c (mc/children schema)]
                           (if (keyword? c)
                             [c (name c)]
                             [c c])))]
    {:enter #(mapping % %)}))
(defn- decode-map-of [keydec x]
  (cond
    (map? x)    x
    (object? x) (into {} (for [prop (js/Object.keys x)]
                           [(keydec prop) (unchecked-get x prop)]))))
(defn- encode-map [x keyenc]
  (cond
    (object? x) x
    (map? x) (reduce-kv (fn [obj k v]
                          (unchecked-set obj (keyenc k) v)
                          obj)
                        #js {}
                        x)))
(def ^:private identity-transformers
  (-> ['string? :string
       'number? :number
       'int?    :int
       'double? :double
       'float?  :float]
      (zipmap (repeat {:enter identity}))))

Malli transformer for converting JavaScript data to and from CLJS data.

This is a bit more flexible than a JSON transformer. In particular, it normalizes the keys of :map schema objects to :kebab-case-keywords, and restores them to strings with the original spelling when converting back.

On keyword conversion

Note that "snake_case" is the default spelling we expect in the JS data. This can be overridden with the {:js/prop "correctSpelling"} property on the schema, eg. ``` [:map [:camel-case {:js/prop "camelCase"} string?] [:kebab-case {:js/prop "kebab-case"} number?] [:snake-case [:enum "foo" "bar"]]] ```

Observe that :snake-case does not need a :js/prop setting, since that is the default.

On :map-of

Note that :map-of is not :map. The spelling of the keys in a :map-of is not changed. If the key schema is keyword?, they will be converted to keywords and back, but with the original spelling.

On sequences :tuple, :vector and :sequential all get transformed into CLJS vectors. When converting back to JS, they are JS arrays.

(def js-transformer
  (mtx/transformer
    {:name :js
     :decoders
     (merge identity-transformers
            {:keyword           keyword
             'keyword?          keyword
             :qualified-keyword keyword
             :uuid              parse-uuid
             :vector            {:enter #(and % (vec %))}
             :sequential        {:enter #(and % (vec %))}
             :tuple             {:enter #(and % (vec %))}
             :cat               {:enter #(and % (vec %))}
             :catn              {:enter #(and % (vec %))}
             :enum              {:compile infer-child-decoder}
             :=                 {:compile infer-child-decoder}
             :map               {:compile decode-map}
             :map-of            {:compile (fn [schema _]
                                            (let [[key-schema] (mc/children schema)
                                                  keydec (mc/decoder key-schema js-transformer)]
                                              {:enter #(decode-map-of keydec %)}))}})
     :encoders
     (merge identity-transformers
            {:keyword           name
             'keyword?          name
             :qualified-keyword #(str (namespace %) "/" (name %))
             :uuid              str
             :vector            {:leave clj->js}
             :sequential        {:leave clj->js}
             :tuple             {:leave clj->js}
             :enum              {:compile infer-child-encoder}
             :=                 {:compile infer-child-encoder}
             :map               {:compile
                                 (fn [schema _]
                                   (let [js-props (into {} (for [[k props] (mc/children schema)
                                                                 :when (:js/prop props)]
                                                             [k (:js/prop props)]))
                                         keyenc   (fn [k] (or (get js-props k)
                                                              (u/->snake_case_en (u/qualified-name k))))]
                                     {:leave #(encode-map % keyenc)}))}
             :map-of            {:leave #(encode-map % name)}})}))

Returns a function for converting a JS value into CLJS data structures, based on a schema.

(defn incoming
  [schema]
  ;; TODO This should be a mc/coercer that decodes and then validates, throwing if it doesn't match.
  ;; However, enabling that now breaks loads of tests that pass input data with lots of holes. The JS
  ;; tests (as opposed to TS) are particularly bad for this.
  ;; Don't forget the nested `mc/decoder` calls elsewhere in this file!
  (mc/decoder schema js-transformer))

Returns a function for converting a CLJS value back into a plain JS one, based on its schema.

(defn outgoing
  [schema]
  (mc/encoder schema js-transformer))
 
(ns metabase.domain-entities.core
  (:require
   [clojure.string :as str]
   [medley.core :as m]
   [metabase.domain-entities.specs :refer [domain-entity-specs MBQL]]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.card :refer [Card]]
   [metabase.models.interface :as mi]
   [metabase.models.table :as table :refer [Table]]
   [metabase.util :as u]
   [schema.core :as s]))

Return the most specific type of a given field.

(def ^:private ^{:arglists '([field])} field-type
  (some-fn :semantic_type :base_type))

A reference to a SourceEntity.

(def SourceName
  s/Str)
(def ^:private DimensionReference s/Str)

Mapping from dimension name to the corresponding instantiated MBQL snippet

(def DimensionBindings
  {DimensionReference MBQL})

A source for a card. Can be either a table or another card.

(def SourceEntity
  #_{:clj-kondo/ignore [:deprecated-var]}
  (s/cond-pre (mi/InstanceOf:Schema Table) (mi/InstanceOf:Schema Card)))

Top-level lexical context mapping source names to their corresponding entity and constituent dimensions. See also DimensionBindings.

(def Bindings
  {SourceName {(s/optional-key :entity)     SourceEntity
               (s/required-key :dimensions) DimensionBindings}})
(s/defn ^:private get-dimension-binding :- MBQL
  [bindings :- Bindings, source :- SourceName, dimension-reference :- DimensionReference]
  (let [[table-or-dimension maybe-dimension] (str/split dimension-reference #"\.")]
    (if maybe-dimension
      (let [field-clause (get-in bindings [table-or-dimension :dimensions maybe-dimension])]
        (cond-> field-clause
          (not= source table-or-dimension) (mbql.u/assoc-field-options :join-alias table-or-dimension)))
      (get-in bindings [source :dimensions table-or-dimension]))))

Instantiate all dimension reference in given (nested) structure

(s/defn resolve-dimension-clauses
  [bindings :- Bindings, source :- SourceName, obj]
  (mbql.u/replace obj
    [:dimension dimension] (->> dimension
                                (get-dimension-binding bindings source)
                                (resolve-dimension-clauses bindings source))))
(s/defn mbql-reference :- MBQL
  "Return MBQL clause for a given field-like object."
  [{:keys [id name base_type]}]
  (if id
    [:field id nil]
    [:field name {:base-type base_type}]))
(defn- has-attribute?
  [entity {:keys [field _domain_entity _has_many]}]
  (cond
    field (some (fn [col]
                  (when (or (isa? (field-type col) field)
                            (= (:name col) (name field)))
                    col))
                ((some-fn :fields :result_metadata) entity))))

Does source entity satisfies requierments of given spec?

(defn satisfies-requierments?
  [entity {:keys [required_attributes]}]
  (every? (partial has-attribute? entity) required_attributes))
(defn- best-match
  [candidates]
  (->> candidates
       (sort-by (juxt (comp count ancestors :type) (comp count :required_attributes)))
       last))
(defn- instantiate-dimensions
  [bindings source entities]
  (into (empty entities) ; this way we don't care if we're dealing with a map or a vec
        (for [entity entities
              :when (every? (get-in bindings [source :dimensions])
                            (mbql.u/match entity [:dimension dimension] dimension))]
          (resolve-dimension-clauses bindings source entity))))
(defn- instantiate-domain-entity
  [table {:keys [name description metrics segments breakout_dimensions type]}]
  (let [dimensions (into {} (for [field (:fields table)]
                              [(-> field field-type clojure.core/name) field]))
        bindings   {name {:entity     table
                          :dimensions (m/map-vals mbql-reference dimensions)}}]
    {:metrics             (instantiate-dimensions bindings name metrics)
     :segments            (instantiate-dimensions bindings name segments)
     :breakout_dimensions (instantiate-dimensions bindings name breakout_dimensions)
     :dimensions          dimensions
     :type                type
     :description         description
     :source_table        (u/the-id table)
     :name                name}))

Find the best fitting domain entity for given table.

(defn domain-entity-for-table
  [table]
  (let [table (assoc table :fields (table/fields table))]
    (some->> @domain-entity-specs
             vals
             (filter (partial satisfies-requierments? table))
             best-match
             (instantiate-domain-entity table))))

Fake hydration function.

(defn with-domain-entity
  [tables]
  (for [table tables]
    (assoc table :domain_entity (domain-entity-for-table table))))
 
(ns metabase.domain-entities.malli
  (:require
    [malli.core :as mc]
    [malli.util :as mut]
    [metabase.domain-entities.converters])
  (:require-macros [metabase.domain-entities.malli]))

Given a schema and a value path (as opposed to a schema path), finds the schema for that path. Throws if there are multiple such paths and those paths have different schemas.

(clojure.core/defn schema-for-path
  [schema path]
  (let [paths (-> schema mc/schema (mut/in->paths path))]
    (cond
      (empty? paths)      (throw (ex-info "Path does not match schema" {:schema schema :path path}))
      (= (count paths) 1) (mut/get-in schema (first paths))
      :else (let [child-schemas (map #(mut/get-in schema %) paths)]
              (if (apply = child-schemas)
                (first child-schemas)
                (throw (ex-info "Value path has multiple schema paths, with different schemas"
                                {:schema        schema
                                 :paths         paths
                                 :child-schemas child-schemas})))))))
 
(ns metabase.domain-entities.malli
  (:refer-clojure :exclude [defn])
  (:require
    [malli.instrument]
    [net.cgrand.macrovich :as macros]))

Generates an accessor, given the symbol and path to the value.

(defmacro -define-getter
  [sym path]
  `(clojure.core/defn ~(vary-meta sym assoc :export true)
     ~(str "Accessor for `" path "`.")
     [obj#]
     (get-in obj# ~path)))

Incoming converter for the replacement value. identity in CLJ.

(defmacro -define-converter
  [schema path in-sym]
  `(def ~in-sym
     ~(macros/case
        :cljs `(-> ~schema
                   (metabase.domain-entities.malli/schema-for-path ~path)
                   metabase.domain-entities.converters/incoming)
        :clj  `identity)))

Generates a setter. Prefixes the symbol with with-, ie. with-foo-bar. in-sym is the name of the incoming converter defined by [[-define-converter]]. Calls that converter on the new value before associng it in.

(defmacro -define-setter
  [sym path in-sym]
  `(clojure.core/defn ~(vary-meta (symbol (str "with-" (name sym)))
                                  assoc :export true)
     ~(str "Updater for `" path "`.")
     [obj# new-value#]
     (assoc-in obj# ~path (~in-sym new-value#))))

Generates the outgoing converter from CLJS data structures to vanilla JS objects. Generates nothing in CLJ mode.

(defmacro -define-js-converter
  [schema path out-sym]
  (macros/case
    :cljs `(def ~out-sym
             (metabase.domain-entities.converters/outgoing
               (metabase.domain-entities.malli/schema-for-path ~schema ~path)))))

Generates a getter that converts back to a JS object, in CLJS. Generates nothing in CLJ. sym is the main symbol, eg. foo-bar. out-sym is the outgoing converter defined by [[-define-js-converter]], eg. foo-bar->.

(defmacro -define-js-returning-getter
  [sym path out-sym]
  (macros/case
    :cljs `(clojure.core/defn ~(vary-meta (symbol (str (name sym) "-js"))
                                          assoc :export true)
             ~(str "Fetches `" path "` and converts it to plain JS.")
             [obj#]
             (~out-sym (~sym obj#)))))

Generates the getter, setter and necessary JS<->CLJS converters for a single sym and path pair.

In CLJ, this generates the getter, setter and a dummy incoming converter that is just identity.

In CLJS, generates the getter and setter, real converters in both directions, and a getter that returns vanilla JS objects instead of CLJS data.

(defmacro -define-getter-and-setter
  [schema sym path]
  (let [in-sym  (vary-meta (symbol (str "->" (name sym)))
                           assoc :private true)
        out-sym (vary-meta (symbol (str (name sym) "->"))
                           assoc :private true)]
    `(do
       (-define-getter ~sym ~path)
       (-define-converter ~schema ~path ~in-sym)
       (-define-setter ~sym ~path ~in-sym)
       (-define-js-converter ~schema ~path ~out-sym)
       (-define-js-returning-getter ~sym ~path ~out-sym))))

Generates an accessor (get-in) and updater (assoc-in) for each specified path.

For example: ``` (define-getters-and-setters Question dataset-query [:card :dataset-query] cache-ttl [:card :cache-ttl]) ``` will generate: ``` (mu/defn ^:export dataset-query :- DatasetQuery "Accessor for [:card :dataset-query]." [obj :- Question] (get-in obj [:card :dataset-query]))

;; This converter is always defined, but it's identity in CLJ. ;; Note that it's safe to call these converters even if the incoming data is already CLJS. ;; This is what's generated in CLJS: (def ^:private ->dataset-query (converters/incoming DatasetQuery))

(mu/defn ^:export with-dataset-query :- Question "Updater for [:card :dataset-query]." [obj :- Question new-value :- DatasetQuery] (assoc-in obj [:card :dataset-query] (->dataset-query new-value)))

;; This converter is only generated in CLJS. (def ^:private dataset-query-> (converters/outgoing Question))

;; This function is also only generated in CLJS. (mu/defn ^:export dataset-query-js :- :any "Fetches [:card :dataset-query] and converts it to plain JS." [obj :- Question] (dataset-query-> (dataset-query obj)))

;; ... and the same five things generated for cache-ttl and any other args. ```

You provide the schema for the parent object; the macro will examine that schema to determine the schema for the field being fetched or updated. The updater's name gets prefixed with with-, and the JS-returning getter suffixed with -js.

The converters are private and intended to be internal to the macros. Since they only depend on the schema it's more efficient to compute them once and reuse them.

(defmacro define-getters-and-setters
  [schema sym path & more]
  `(do
     (-define-getter-and-setter ~schema ~sym ~path)
     ~(when (seq more)
        `(define-getters-and-setters ~schema ~@more))))
 
(ns metabase.domain-entities.specs
  (:require
   [medley.core :as m]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.util :as mbql.u]
   [metabase.util.yaml :as yaml]
   [schema.coerce :as sc]
   [schema.core :as s]))

MBQL clause (ie. a vector starting with a keyword)

(def MBQL
  (s/pred mbql.u/mbql-clause?))

Field type designator -- a keyword derived from type/*

(def FieldType
  (s/constrained s/Keyword
                                        ;#(isa? % :type/*)
                 identity))
(def ^:private DomainEntityReference s/Str)
(def ^:private DomainEntityType (s/isa :DomainEntity/*))
(def ^:private Identifier s/Str)
(def ^:private Description s/Str)
(def ^:private Attributes [{(s/optional-key :field)         FieldType
                            (s/optional-key :domain_entity) DomainEntityReference
                            (s/optional-key :has_many)      {:domain_entity DomainEntityReference}}])
(def ^:private BreakoutDimensions [MBQL])
(def ^:private Metrics {Identifier {(s/required-key :aggregation) MBQL
                                    (s/required-key :name)        Identifier
                                    (s/optional-key :breakout)    BreakoutDimensions
                                    (s/optional-key :filter)      MBQL
                                    (s/optional-key :description) Description}})
(def ^:private Segments {Identifier {(s/required-key :filter)      MBQL
                                     (s/required-key :name)        Identifier
                                     (s/optional-key :description) Description}})

Domain entity spec

(def DomainEntitySpec
  {(s/required-key :name)                DomainEntityReference
   (s/required-key :type)                DomainEntityType
   (s/optional-key :description)         Description
   (s/required-key :required_attributes) Attributes
   (s/optional-key :optional_attributes) Attributes
   (s/optional-key :metrics)             Metrics
   (s/optional-key :segments)            Segments
   (s/optional-key :breakout_dimensions) BreakoutDimensions})
(defn- add-to-hiearchy!
  [{:keys [name refines] :as spec}]
  (let [spec-type (keyword "DomainEntity" name)
        refines   (some->> refines (keyword "DomainEntity"))]
    (derive spec-type (or refines :DomainEntity/*))
    (-> spec
        (dissoc :refines)
        (assoc :type spec-type))))
(def ^:private ^{:arglists '([m])} add-name-from-key
  (partial m/map-kv-vals (fn [k v]
                           (assoc v :name k))))
(def ^:private domain-entity-spec-parser
  (sc/coercer!
   DomainEntitySpec
   {MBQL                  mbql.normalize/normalize
    Segments              add-name-from-key
    Metrics               add-name-from-key
    BreakoutDimensions    (fn [breakout-dimensions]
                            (for [dimension breakout-dimensions]
                              (if (string? dimension)
                                (do
                                  (s/validate FieldType (keyword "type" dimension))
                                  [:dimension dimension])
                                dimension)))
    FieldType             (partial keyword "type")
    ;; Some map keys are names (ie. strings) while the rest are keywords, a distinction lost in YAML
    s/Str                 name}))
(def ^:private domain-entities-dir "domain_entity_specs/")

List of registered domain entities.

(def domain-entity-specs
  (delay (into {} (for [spec (yaml/load-dir domain-entities-dir (comp domain-entity-spec-parser
                                                                      add-to-hiearchy!))]
                    [(:name spec) spec]))))
 

Metabase Drivers handle various things we need to do with connected data warehouse databases, including things like introspecting their schemas and processing and running MBQL queries. Drivers must implement some or all of the multimethods defined below, and register themselves with a call to [[metabase.driver/register!]].

SQL-based drivers can use the :sql driver as a parent, and JDBC-based SQL drivers can use :sql-jdbc. Both of these drivers define additional multimethods that child drivers should implement; see [[metabase.driver.sql]] and [[metabase.driver.sql-jdbc]] for more details.

(ns metabase.driver
  (:require
   [clojure.set :as set]
   [clojure.string :as str]
   [java-time.api :as t]
   [metabase.driver.impl :as driver.impl]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.plugins.classloader :as classloader]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru trs tru]]
   [metabase.util.log :as log]
   [potemkin :as p]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)
(declare notify-database-updated)

Send notification that all Databases should immediately release cached resources (i.e., connection pools).

Currently only used below by [[report-timezone]] setter (i.e., only used when report timezone changes). Reusing pooled connections with the old session timezone can have weird effects, especially if report timezone is changed to nil (meaning subsequent queries will not attempt to change the session timezone) or something considered invalid by a given Database (meaning subsequent queries will fail to change the session timezone).

(defn- notify-all-databases-updated
  []
  (doseq [{driver :engine, id :id, :as database} (t2/select 'Database)]
    (try
      (notify-database-updated driver database)
      (catch Throwable e
        (log/error e (trs "Failed to notify {0} Database {1} updated" driver id))))))
(defn- short-timezone-name [timezone-id]
  (let [^java.time.ZoneId zone (if (seq timezone-id)
                                 (t/zone-id timezone-id)
                                 (t/zone-id))]
    (.getDisplayName
     zone
     java.time.format.TextStyle/SHORT
     (java.util.Locale/getDefault))))
(defn- long-timezone-name [timezone-id]
  (if (seq timezone-id)
    timezone-id
    (str (t/zone-id))))
(defsetting report-timezone
  (deferred-tru "Connection timezone to use when executing queries. Defaults to system timezone.")
  :visibility :settings-manager
  :audit      :getter
  :setter
  (fn [new-value]
    (setting/set-value-of-type! :string :report-timezone new-value)
    (notify-all-databases-updated)))

Current report timezone abbreviation

(defsetting report-timezone-short
  :visibility :public
  :setter     :none
  :getter     (fn [] (short-timezone-name (report-timezone)))
  :doc        false)

Current report timezone string

(defsetting report-timezone-long
  :visibility :public
  :setter     :none
  :getter     (fn [] (long-timezone-name (report-timezone)))
  :doc        false)

+----------------------------------------------------------------------------------------------------------------+ | Current Driver | +----------------------------------------------------------------------------------------------------------------+

Current driver (a keyword such as :postgres) in use by the Query Processor/tests/etc. Bind this with with-driver below. The QP binds the driver this way in the bind-driver middleware.

(def ^:dynamic *driver*
  nil)
(declare the-driver)

Impl for with-driver.

(defn do-with-driver
  [driver f]
  {:pre [(keyword? driver)]}
  (binding [*driver* (the-driver driver)]
    (f)))

Bind current driver to driver and execute body.

(driver/with-driver :postgres ...)

(defmacro with-driver
  {:style/indent 1}
  [driver & body]
  `(do-with-driver ~driver (fn [] ~@body)))

+----------------------------------------------------------------------------------------------------------------+ | Driver Registration / Hierarchy / Multimethod Dispatch | +----------------------------------------------------------------------------------------------------------------+

(p/import-vars [driver.impl hierarchy register! initialized?])
(add-watch
 #'hierarchy
 nil
 (fn [_ _ _ _]
   (when (not= hierarchy driver.impl/hierarchy)
     ;; this is a dev-facing error so no need to i18n it.
     (throw (Exception. (str "Don't alter #'metabase.driver/hierarchy directly, since it is imported from "
                             "metabase.driver.impl. Alter #'metabase.driver.impl/hierarchy instead if you need to "
                             "alter the var directly."))))))

Is this driver available for use? (i.e. should we show it as an option when adding a new database?) This is true for all registered, non-abstract drivers and false everything else.

Note that an available driver is not necessarily initialized yet; for example lazy-loaded drivers are registered when Metabase starts up (meaning this will return true for them) and only initialized when first needed.

(defn available?
  [driver]
  ((every-pred driver.impl/registered? driver.impl/concrete?) driver))

Like [[clojure.core/the-ns]]. Converts argument to a keyword, then loads and registers the driver if not already done, throwing an Exception if it fails or is invalid. Returns keyword. Note that this does not neccessarily mean the driver is initialized (e.g., its full implementation and deps might not be loaded into memory) -- see also [[the-initialized-driver]].

This is useful in several cases:

;; Ensuring a driver is loaded & registered (isa? driver/hierarchy (the-driver :postgres) (the-driver :sql-jdbc)

;; Accepting either strings or keywords (e.g., in API endpoints) (the-driver "h2") ; -> :h2

;; Ensuring a driver you are passed is valid (t2/insert! Database :engine (name (the-driver driver)))

(the-driver :postgres) ; -> :postgres (the-driver :baby) ; -> Exception

(defn the-driver
  [driver]
  {:pre [((some-fn keyword? string?) driver)]}
  (classloader/the-classloader)
  (let [driver (keyword driver)]
    (driver.impl/load-driver-namespace-if-needed! driver)
    driver))

Add a new parent to driver.

(defn add-parent!
  [driver new-parent]
  (when-not *compile-files*
    (driver.impl/load-driver-namespace-if-needed! driver)
    (driver.impl/load-driver-namespace-if-needed! new-parent)
    (alter-var-root #'driver.impl/hierarchy derive driver new-parent)))

Dispatch function to use for driver multimethods. Dispatches on first arg, a driver keyword; loads that driver's namespace if not already done. DOES NOT INITIALIZE THE DRIVER.

Driver multimethods for abstract drivers like :sql or :sql-jdbc should use [[dispatch-on-initialized-driver]] to ensure the driver is initialized (i.e., its method implementations will be loaded).

(defn- dispatch-on-uninitialized-driver
  [driver & _]
  (the-driver driver))
(declare initialize!)

Like [[the-driver]], but also initializes the driver if not already initialized.

(defn the-initialized-driver
  [driver]
  (let [driver (the-driver driver)]
    (driver.impl/initialize-if-needed! driver initialize!)
    driver))

Like [[dispatch-on-uninitialized-driver]], but guarantees a driver is initialized before dispatch. Prefer [[the-driver]] for trivial methods that should do not require the driver to be initialized (e.g., ones that simply return information about the driver, but do not actually connect to any databases.)

(defn dispatch-on-initialized-driver
  [driver & _]
  (the-initialized-driver driver))

+----------------------------------------------------------------------------------------------------------------+ | Interface (Multimethod Defintions) | +----------------------------------------------------------------------------------------------------------------+

Methods a driver can implement. Not all of these are required; some have default implementations immediately below them.

SOME TIPS:

To call the Clojure equivalent of the superclass implementation of a method, use get-method with the parent driver:

(driver/register-driver! :my-driver, :parent :sql-jdbc)

(defmethod driver/describe-table :my-driver [driver database table] (-> ((get-method driver/describe-table :sql-jdbc) driver databse table) (update :tables add-materialized-views)))

Make sure to pass along the driver parameter-as when you call other methods, rather than hardcoding the name of the current driver (e.g. :my-driver in the example above). This way if other drivers use your driver as a parent in the future their implementations of any methods called by those methods will get used.

DO NOT CALL THIS METHOD DIRECTLY. Called automatically once and only once the first time a non-trivial driver method is called; implementers should do one-time initialization as needed (for example, registering JDBC drivers used internally by the driver.)

'Trivial' methods include a tiny handful of ones like [[connection-properties]] that simply provide information about the driver, but do not connect to databases; these can be be supplied, for example, by a Metabase plugin manifest file (which is supplied for lazy-loaded drivers). Methods that require connecting to a database dispatch off of [[the-initialized-driver]], which will initialize a driver if not already done so.

You will rarely need to write an implentation for this method yourself. A lazy-loaded driver (like most of the Metabase drivers in v1.0 and above) are automatiaclly given an implentation of this method that performs the init-steps specified in the plugin manifest (such as loading namespaces in question).

If you do need to implement this method yourself, you do not need to call parent implementations. We'll take care of that for you.

(defmulti initialize!
  {:added "0.32.0" :arglists '([driver])}
  dispatch-on-uninitialized-driver)

VERY IMPORTANT: Unlike all other driver multimethods, we DO NOT use the driver hierarchy for dispatch here. Why? We do not want a driver to inherit parent drivers' implementations and have those implementations end up getting called multiple times. If a driver does not implement initialize!, always fall back to the default no-op implementation.

initialize-if-needed! takes care to make sure a driver's parent(s) are initialized before initializing a driver.

(defmethod initialize! :default [_]) ; no-op

A nice name for the driver that we'll display to in the admin panel, e.g. "PostgreSQL" for :postgres. Default implementation capitializes the name of the driver, e.g. :oracle becomes "Oracle".

When writing a driver that you plan to ship as a separate, lazy-loading plugin (including core drivers packaged this way, like SQLite), you do not need to implement this method; instead, specifiy it in your plugin manifest, and lazy-loaded-driver will create an implementation for you. Probably best if we only have one place where we set values for this.

(defmulti display-name
  {:added "0.32.0" :arglists '([driver])}
  dispatch-on-uninitialized-driver
  :hierarchy #'hierarchy)
(defmethod display-name :default [driver]
  (str/capitalize (name driver)))

The contact information for the driver

(defmulti contact-info
  {:changelog-test/ignore true :added "0.43.0" :arglists '([driver])}
  dispatch-on-uninitialized-driver
  :hierarchy #'hierarchy)
(defmethod contact-info :default
  [_]
  nil)

Dispatch on initialized driver, except checks for classname, subprotocol, connection-uri in the details map in order to prevent a mismatch in spec type vs driver.

(defn dispatch-on-initialized-driver-safe-keys
  [driver details-map]
  (let [invalid-keys #{"classname" "subprotocol" "connection-uri"}
        ks           (->> details-map keys
                          (map name)
                          (map u/lower-case-en) set)]
    (when (seq (set/intersection ks invalid-keys))
      (throw (ex-info "Cannot specify subname, protocol, or connection-uri in details map"
                      {:invalid-keys (set/intersection ks invalid-keys)})))
    (dispatch-on-initialized-driver driver)))

Check whether we can connect to a Database with details-map and perform a simple query. For example, a SQL database might try running a query like SELECT 1;. This function should return truthy if a connection to the DB can be made successfully, otherwise it should return falsey or throw an appropriate Exception. Exceptions if a connection cannot be made. Throw an ex-info containing a truthy ::can-connect-message? in ex-data in order to suppress logging expected driver validation messages during setup.

(defmulti can-connect?
  {:added "0.32.0" :arglists '([driver details])}
  dispatch-on-initialized-driver-safe-keys
  :hierarchy #'hierarchy)

Return a map containing information that describes the version of the DBMS. This typically includes a :version containing the (semantic) version of the DBMS as a string and potentially a :flavor specifying the flavor like MySQL or MariaDB.

(defmulti dbms-version
  {:changelog-test/ignore true :added "0.46.0" :arglists '([driver database])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)

Some drivers like BigQuery or Snowflake cannot provide a meaningful stable version.

(defmethod dbms-version :default
  [_ _]
  nil)

Return a map containing information that describes all of the tables in a database, an instance of the Database model. It is expected that this function will be peformant and avoid draining meaningful resources of the database. Results should match the [[metabase.sync.interface/DatabaseMetadata]] schema.

(defmulti describe-database
  {:added "0.32.0" :arglists '([driver database])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)

Return a map containing information that describes the physical schema of table (i.e. the fields contained therein). database will be an instance of the Database model; and table, an instance of the Table model. It is expected that this function will be peformant and avoid draining meaningful resources of the database. Results should match the [[metabase.sync.interface/TableMetadata]] schema.

(defmulti describe-table
  {:added "0.32.0" :arglists '([driver database table])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)

Returns a set of map containing information about the indexes of a table. Currently we only sync single column indexes or the first column of a composite index. Results should match the [[metabase.sync.interface/TableIndexMetadata]] schema.

(defmulti describe-table-indexes
  {:added "0.49.0" :arglists '([driver database table])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)

escaping for when calling .getColumns or .getTables on table names or schema names. Useful for when a database driver has difference escaping rules for table or schema names when used from metadata.

For example, oracle treats slashes differently when querying versus when used with .getTables or .getColumns

(defmulti escape-entity-name-for-metadata
  {:arglists '([driver table-name]), :added "0.37.0"}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)
(defmethod escape-entity-name-for-metadata :default [_driver table-name] table-name)

Return information about the foreign keys in a table. Required for drivers that support :foreign-keys. Results should match the [[metabase.sync.interface/FKMetadata]] schema.

(defmulti describe-table-fks
  {:added "0.32.0" :arglists '([driver database table])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)
(defmethod describe-table-fks ::driver [_ _ _]
  nil)

this is no longer used but we can leave it around for not for documentation purposes. Maybe we can actually do something useful with it like write a test that validates that drivers return correct connection details?

Return information about the connection properties that should be exposed to the user for databases that will use this driver. This information is used to build the UI for editing a Database details map, and for validating it on the backend. It should include things like host, port, and other driver-specific parameters. Each property must conform to the [[ConnectionDetailsProperty]] schema above.

There are several definitions for common properties available in the [[metabase.driver.common]] namespace, such as default-host-details and default-port-details. Prefer using these if possible.

Like display-name, lazy-loaded drivers should specify this in their plugin manifest; lazy-loaded-driver will automatically create an implementation for you.

#_(def ConnectionDetailsProperty
    "Schema for a map containing information about a connection property we should ask the user to supply when setting up
  a new database, as returned by an implementation of `connection-properties`."
    (s/constrained
     {
      ;; The key that should be used to store this property in the `details` map.
      :name su/NonBlankString
      ;; Human-readable name that should be displayed to the User in UI for editing this field.
      :display-name su/NonBlankString
      ;; Human-readable text that gives context about a field's input.
      (s/optional-key :helper-text) s/Str
      ;; Type of this property. Defaults to `:string` if unspecified.
      ;; `:select` is a `String` in the backend.
      (s/optional-key :type) (s/enum :string :integer :boolean :password :select :text)
      ;; A default value for this field if the user hasn't set an explicit value. This is shown in the UI as a
      ;; placeholder.
      (s/optional-key :default) s/Any
      ;; Placeholder value to show in the UI if user hasn't set an explicit value. Similar to `:default`, but this value
      ;; is *not* saved to `:details` if no explicit value is set. Since `:default` values are also shown as
      ;; placeholders, you cannot specify both `:default` and `:placeholder`.
      (s/optional-key :placeholder) s/Any
      ;; Is this property required? Defaults to `false`.
      (s/optional-key :required?) s/Bool
      ;; Any options for `:select` types
      (s/optional-key :options) {s/Keyword s/Str}}
     (complement (every-pred #(contains? % :default) #(contains? % :placeholder)))
     "connection details that does not have both default and placeholder"))
(defmulti connection-properties
  {:added "0.32.0" :arglists '([driver])}
  dispatch-on-uninitialized-driver
  :hierarchy #'hierarchy)

Execute a native query against that database and return rows that can be reduced using transduce/reduce.

Pass metadata about the columns and the reducible object to respond, which has the signature

(respond results-metadata rows)

You can use [[metabase.query-processor.reducible/reducible-rows]] to create reducible, streaming results.

Example impl:

(defmethod reducible-query :my-driver [_ query context respond] (with-open [results (run-query! query)] (respond {:cols [{:name "my_col"}]} (qp.reducible/reducible-rows (get-row results) (context/canceled-chan context)))))

(defmulti execute-reducible-query
  {:added "0.35.0", :arglists '([driver query context respond])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)

Set of all features a driver can support.

TODO -- I think we should rename this to features since driver/driver-features is a bit redundant.

(def driver-features
  #{
    ;; Does this database support foreign key relationships?
    :foreign-keys
    ;; Does this database support nested fields for any and every field except primary key (e.g. Mongo)?
    :nested-fields
    ;; Does this database support nested fields but only for certain field types (e.g. Postgres and JSON / JSONB columns)?
    :nested-field-columns
    ;; Does this driver support setting a timezone for the query?
    :set-timezone
    ;; Does the driver support *basic* aggregations like `:count` and `:sum`? (Currently, everything besides standard
    ;; deviation is considered \"basic\"; only GA doesn't support this).
    ;;
    ;; DEFAULTS TO TRUE.
    :basic-aggregations
    ;; Does this driver support standard deviation and variance aggregations? Note that if variance is not supported
    ;; directly, you can calculate it manually by taking the square of the standard deviation. See the MongoDB driver
    ;; for example.
    :standard-deviation-aggregations
    ;; Does this driver support expressions (e.g. adding the values of 2 columns together)?
    :expressions
    ;; Does this driver support parameter substitution in native queries, where parameter expressions are replaced
    ;; with a single value? e.g.
    ;;
    ;;    SELECT * FROM table WHERE field = {{param}}
    ;;    ->
    ;;    SELECT * FROM table WHERE field = 1
    :native-parameters
    ;; Does the driver support using expressions inside aggregations? e.g. something like \"sum(x) + count(y)\" or
    ;; \"avg(x + y)\"
    :expression-aggregations
    ;; Does the driver support using a query as the `:source-query` of another MBQL query? Examples are CTEs or
    ;; subselects in SQL queries.
    :nested-queries
    ;; Does the driver support persisting models
    :persist-models
    ;; Is persisting enabled?
    :persist-models-enabled
    ;; Does the driver support binning as specified by the `binning-strategy` clause?
    :binning
    ;; Does this driver not let you specify whether or not our string search filter clauses (`:contains`,
    ;; `:starts-with`, and `:ends-with`, collectively the equivalent of SQL `LIKE`) are case-senstive or not? This
    ;; informs whether we should present you with the 'Case Sensitive' checkbox in the UI. At the time of this writing
    ;; SQLite, SQLServer, and MySQL do not support this -- `LIKE` clauses are always case-insensitive.
    ;;
    ;; DEFAULTS TO TRUE.
    :case-sensitivity-string-filter-options
    :left-join
    :right-join
    :inner-join
    :full-join
    :regex
    ;; Does the driver support advanced math expressions such as log, power, ...
    :advanced-math-expressions
    ;; Does the driver support percentile calculations (including median)
    :percentile-aggregations
    ;; Does the driver support date extraction functions? (i.e get year component of a datetime column)
    ;; DEFAULTS TO TRUE
    :temporal-extract
    ;; Does the driver support doing math with datetime? (i.e Adding 1 year to a datetime column)
    ;; DEFAULTS TO TRUE
    :date-arithmetics
    ;; Does the driver support the :now function
    :now
    ;; Does the driver support converting timezone?
    ;; DEFAULTS TO FALSE
    :convert-timezone
    ;; Does the driver support :datetime-diff functions
    :datetime-diff
    ;; Does the driver support experimental "writeback" actions like "delete this row" or "insert a new row" from 44+?
    :actions
    ;; Does the driver support storing table privileges in the application database for the current user?
    :table-privileges
    ;; Does the driver support uploading files
    :uploads
    ;; Does the driver support schemas (aka namespaces) for tables
    ;; DEFAULTS TO TRUE
    :schemas
    ;; Does the driver support custom writeback actions. Drivers that support this must
    ;; implement [[execute-write-query!]]
    :actions/custom
    ;; Does changing the JVM timezone allow producing correct results? (See #27876 for details.)
    :test/jvm-timezone-setting
    ;; Does the driver support connection impersonation (i.e. overriding the role used for individual queries)?
    :connection-impersonation
    ;; Does the driver require specifying the default connection role for connection impersonation to work?
    :connection-impersonation-requires-role
    ;; Does the driver require specifying a collection (table) for native queries? (mongo)
    :native-requires-specified-collection
    ;; Does the driver support column(s) support storing index info
    :index-info})

Does this driver support a certain feature? (A feature is a keyword, and can be any of the ones listed above in [[driver-features]].)

(supports? :postgres :set-timezone) ; -> true

DEPRECATED — [[database-supports?]] should be used instead. This function will be removed in Metabase version 0.50.0.

(defmulti supports?
  {:added "0.32.0", :arglists '([driver feature]), :deprecated "0.47.0"}
  (fn [driver feature]
    (when-not (driver-features feature)
      (throw (Exception. (tru "Invalid driver feature: {0}" feature))))
    [(dispatch-on-initialized-driver driver) feature])
  :hierarchy #'hierarchy)
(defmethod supports? :default [_ _] false)
(defmethod supports? [::driver :schemas] [_ _] true)

Does this driver and specific instance of a database support a certain feature? (A feature is a keyword, and can be any of the ones listed above in driver-features. Note that it's the same set of driver-features with respect to both database-supports? and [[supports?]])

Database is guaranteed to be a Database instance.

Most drivers can always return true or always return false for a given feature (e.g., :left-join is not supported by any version of Mongo DB).

In some cases, a feature may only be supported by certain versions of the database engine. In this case, after implementing [[dbms-version]] for your driver you can determine whether a feature is supported for this particular database.

(database-supports? :mongo :set-timezone mongo-db) ; -> true

(defmulti database-supports?
  {:arglists '([driver feature database]), :added "0.41.0"}
  (fn [driver feature _database]
    (when-not (driver-features feature)
      (throw (Exception. (tru "Invalid driver feature: {0}" feature))))
    [(dispatch-on-initialized-driver driver) feature])
  :hierarchy #'hierarchy)
(defmethod database-supports? :default [driver feature _] (supports? driver feature))
(doseq [[feature supported?] {:basic-aggregations                     true
                              :case-sensitivity-string-filter-options true
                              :date-arithmetics                       true
                              :temporal-extract                       true
                              :convert-timezone                       false
                              :test/jvm-timezone-setting              true}]
  (defmethod database-supports? [::driver feature] [_driver _feature _db] supported?))

Escape a column-or-table-alias string in a way that makes it valid for your database. This method is used for existing columns; aggregate functions and other expressions; joined tables; and joined subqueries; be sure to return the lowest common denominator amongst if your database has different requirements for different identifier types.

These aliases can be dynamically generated in [[metabase.query-processor.util.add-alias-info]] or elsewhere (usually based on underlying table or column names) but can also be specified in the MBQL query itself for explicit joins. For :sql drivers, the aliases generated here will be quoted in the resulting SQL.

The default impl of [[escape-alias]] calls [[metabase.driver.impl/truncate-alias]] and truncates the alias to [[metabase.driver.impl/default-alias-max-length-bytes]]. You can call this function with a different max length if you need to generate shorter aliases.

That method is currently only used drivers that derive from :sql and for drivers that support joins. If your driver is/does neither, you do not need to implement this method at this time.

(defmulti ^String escape-alias
  {:added "0.42.0", :arglists '([driver column-or-table-alias])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)
(defmethod escape-alias ::driver
  [_driver alias-name]
  (driver.impl/truncate-alias alias-name))

Return a humanized (user-facing) version of an connection error message. Generic error messages provided in [[metabase.driver.util/connection-error-messages]]; should be returned as keywords whenever possible. This provides for both unified error messages and categories which let us point users to the erroneous input fields. Error messages can also be strings, or localized strings, as returned by [[metabase.util.i18n/trs]] and metabase.util.i18n/tru.

(defmulti humanize-connection-error-message
  {:added "0.32.0" :arglists '([this message])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)
(defmethod humanize-connection-error-message ::driver [_ message]
  message)

Transpile an MBQL query into the appropriate native query form. query will match the schema for an MBQL query in [[metabase.mbql.schema/Query]]; this function should return a native query that conforms to that schema.

If the underlying query language supports remarks or comments, the driver should use [[metabase.query-processor.util/query->remark]] to generate an appropriate message and include that in an appropriate place; alternatively a driver might directly include the query's :info dictionary if the underlying language is JSON-based.

The result of this function will be passed directly into calls to [[execute-reducible-query]].

For example, a driver like Postgres would build a valid SQL expression and return a map such as:

{:query "-- Metabase card: 10 user: 5 SELECT * FROM my_table"}

(defmulti mbql->native
  {:added "0.32.0", :arglists '([driver query]), :style/indent 1}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)

Pretty-format native form presumably coming from compiled query. Used eg. in the API endpoint /dataset/native, to present the user with a nicely formatted query.

How to use and extend this method?

At the time of writing, this method acts as identity for nosql drivers. However, story with sql drivers is a bit different. To extend it for sql drivers, developers could use [[metabase.driver.sql.util/format-sql]]. Function in question is implemented in a way, that developers, implemnting this multimethod can: - Avoid implementing it completely, if their driver keyword representation corresponds to key in [[metabase.driver.sql.util/dialects]] (eg. :postgres). - Ignore implementing it, if it is sufficient to format their drivers native form with dialect corresponding to :standardsql's value from the dialects map (eg :h2). - Use [[metabase.driver.sql.util/format-sql]] in this method's implementation, providing dialect keyword representation that corresponds to to their driver's formatting (eg. :sqlserver uses :tsql). - Completly reimplement this method with their special formatting code.

(defmulti prettify-native-form
  {:added "0.47.0", :arglists '([driver native-form]), :style/indent 1}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)
(defmethod prettify-native-form ::driver
 [_ native-form]
 native-form)

For a native query that has separate parameters, such as a JDBC prepared statement, e.g.

{:query "SELECT * FROM birds WHERE name = ?", :params ["Reggae"]}

splice the parameters in to the native query as literals so it can be executed by the user, e.g.

{:query "SELECT * FROM birds WHERE name = 'Reggae'"}

This is used to power features such as 'Convert this Question to SQL' in the Query Builder. Normally when executing the query we'd like to leave the statement as a prepared one and pass parameters that way instead of splicing them in as literals so as to avoid SQL injection vulnerabilities. Thus the results of this method are not normally executed by the Query Processor when processing an MBQL query. However when people convert a question to SQL they can see what they will be executing and edit the query as needed.

Input to this function follows the same shape as output of mbql->native -- that is, it will be a so-called 'inner' native query, with :query and :params keys, as in the example code above; output should be of the same format. This method might be called even if no splicing needs to take place, e.g. if :params is empty; implementations should be sure to handle this situation correctly.

For databases that do not feature concepts like 'prepared statements', this method need not be implemented; the default implementation is an identity function.

(defmulti splice-parameters-into-native-query
  {:added "0.32.0", :arglists '([driver query]), :style/indent 1}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)
(defmethod splice-parameters-into-native-query ::driver
  [_ query]
  query)

Notify the driver that the attributes of a database have changed, or that `database was deleted. This is specifically relevant in the event that the driver was doing some caching or connection pooling; the driver should release ALL related resources when this is called.

TODO - we should just have some sort of core.async channel to handle DB update notifications instead

TODO -- shouldn't this be called notify-database-updated!, since the expectation is that it is done for side effects?

(defmulti notify-database-updated
  {:added "0.32.0" :arglists '([driver database])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)
(defmethod notify-database-updated ::driver [_ _]
  nil) ; no-op

Drivers may provide this function if they need to do special setup before a sync operation such as sync-database!. The sync operation itself is encapsulated as the lambda f, which must be called with no arguments.

(defn sync-in-context [driver database f] (with-connection [_ database] (f)))

(defmulti sync-in-context
  {:added "0.32.0", :arglists '([driver database f]), :style/indent 2}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)
(defmethod sync-in-context ::driver [_ _ f] (f))

Return a sequence of all the rows in a given table, which is guaranteed to have at least :name and :schema keys. (It is guaranteed to satisfy the DatabaseMetadataTable schema in metabase.sync.interface.) Currently, this is only used for iterating over the values in a _metabase_metadata table. As such, the results are not expected to be returned lazily. There is no expectation that the results be returned in any given order.

This method is currently only used by the H2 driver to load the Sample Database, so it is not neccesary for any other drivers to implement it at this time.

(defmulti table-rows-seq
  {:added "0.32.0" :arglists '([driver database table])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)

Return the system timezone ID name of this database, i.e. the timezone that local dates/times/datetimes are considered to be in by default. Ideally, this method should return a timezone ID like America/Los_Angeles, but an offset formatted like -08:00 is acceptable in cases where the actual ID cannot be provided.

This is currently used only when syncing the Database (see [[metabase.sync.sync-metadata.sync-timezone/sync-timezone!]]) -- the result of this method is stored in the timezone column of Database.

In theory this method should probably not return nil, since every Database presumably assumes some timezone for LocalDate(Time)s types, but in practice implementations of this method return nil for some drivers. For example the default implementation for :sql-jdbc returns nil unless the driver in question implements [[metabase.driver.sql-jdbc.sync/db-default-timezone]]; the :h2 driver does not for example. Why is this? Who knows, but it's something you should keep in mind.

This method should return a [[String]], a [[java.time.ZoneId]], or a [[java.time.ZoneOffset]].

(defmulti db-default-timezone
  {:added "0.34.0", :arglists '([driver database])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)
(defmethod db-default-timezone ::driver
  [_driver _database]
  nil)

For drivers that support :native-parameters. Substitute parameters in a normalized 'inner' native query.

{:query "SELECT count(*) FROM table WHERE id = {{param}}" :template-tags {:param {:name "param", :display-name "Param", :type :number}} :parameters [{:type :number :target [:variable [:template-tag "param"]] :value 2}]} -> {:query "SELECT count(*) FROM table WHERE id = 2"}

Much of the implementation for this method is shared across drivers and lives in the metabase.driver.common.parameters.* namespaces. See the :sql and :mongo drivers for sample implementations of this method.`Driver-agnostic end-to-end native parameter tests live in [[metabase.query-processor-test.parameters-test]] and other namespaces.

(defmulti substitute-native-parameters
  {:added "0.34.0" :arglists '([driver inner-query])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)

Return how fields should be sorted by default for this database.

(defmulti default-field-order
  {:added "0.36.0" :arglists '([driver])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)
(defmethod default-field-order ::driver [_] :database)

Return the day that is considered to be the start of week by driver. Should return a keyword such as :sunday.

TODO -- this can vary based on session variables or connection options

(defmulti db-start-of-week
  {:added "0.37.0" :arglists '([driver])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)

A multimethod for driver-specific behavior required to incorporate details for an opened SSH tunnel into the DB details. In most cases, this will simply involve updating the :host and :port (to point to the tunnel entry point, instead of the backing database server), but some drivers may have more specific behavior.

WARNING! Implementations of this method may create new SSH tunnels, which need to be cleaned up. DO NOT USE THIS METHOD DIRECTLY UNLESS YOU ARE GOING TO BE CLEANING UP ANY CREATED TUNNELS! Instead, you probably want to use [[metabase.util.ssh/with-ssh-tunnel]]. See #24445 for more information.

(defmulti incorporate-ssh-tunnel-details
  {:added "0.39.0" :arglists '([driver db-details])}
  dispatch-on-uninitialized-driver
  :hierarchy #'hierarchy)

Normalizes db-details for the given driver. This is to handle migrations that are too difficult to perform via regular Liquibase queries. This multimethod will be called from a :post-select handler within the database model. The full database model object is passed as the 2nd parameter, and the multimethod implementation is expected to update the value for :details. The default implementation is essentially identity (i.e returns database unchanged). This multimethod will only be called if :details is actually present in the database map.

TODO:

  1. We definitely should not be asking drivers to "update the value for :details". Drivers shouldn't touch the application database.

  2. Something that is done for side effects like updating the application DB NEEDS TO END IN AN EXCLAMATION MARK!

(defmulti normalize-db-details
  {:added "0.41.0" :arglists '([driver database])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)
(defmethod normalize-db-details ::driver
  [_ db-details]
  ;; no normalization by default
  db-details)

Returns the driver that supersedes the given driver. A non-nil return value means that the given driver is deprecated in Metabase and will eventually be replaced by the returned driver, in some future version (at which point any databases using it will be migrated to the new one).

This is currently only used on the frontend for the purpose of showing/hiding deprecated drivers. A driver can make use of this facility by adding a top-level superseded-by key to its plugin manifest YAML file, or (less preferred) overriding this multimethod directly.

(defmulti superseded-by
  {:added "0.41.0" :arglists '([driver])}
  dispatch-on-uninitialized-driver
  :hierarchy #'hierarchy)
(defmethod superseded-by :default
  [_]
  nil)

Execute a writeback query e.g. one powering a custom QueryAction (see [[metabase.models.action]]). Drivers that support :actions/custom must implement this method.

(defmulti execute-write-query!
  {:changelog-test/ignore true, :added "0.44.0", :arglists '([driver query])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)

Processes a sample of rows produced by driver, from the table's fields using the query result processing function rff. The default implementation defined in [[metabase.db.metadata-queries]] runs a row sampling MBQL query using the regular query processor to produce the sample rows. This is good enough in most cases so this multimethod should not be implemented unless really necessary. opts is a map that may contain additional parameters: :truncation-size: size to truncate text fields to if the driver supports expressions.

(defmulti table-rows-sample
  {:arglists '([driver table fields rff opts]), :added "0.46.0"}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)

Sets the database role used on a connection. Called prior to query execution for drivers that support connection impersonation (an EE-only feature).

(defmulti set-role!
  {:added "0.47.0" :arglists '([driver conn role])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)

+----------------------------------------------------------------------------------------------------------------+ | Upload | +----------------------------------------------------------------------------------------------------------------+

The number of rows to insert at a time when uploading data to a database. This can be bound for testing purposes.

(def ^:dynamic *insert-chunk-rows*
  nil)

Return the maximum number of characters allowed in a table name, or nil if there is no limit.

(defmulti table-name-length-limit
  {:changelog-test/ignore true, :added "0.47.0", :arglists '([driver])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)

Create a table named table-name. If the table already exists it will throw an error.

(defmulti create-table!
  {:added "0.47.0", :arglists '([driver db-id table-name col->type])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)

Drop a table named table-name. If the table doesn't exist it will not be dropped.

(defmulti drop-table!
  {:added "0.47.0", :arglists '([driver db-id table-name])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)

Insert values into a table named table-name. values is a lazy sequence of rows, where each row's order matches column-names.

The types in values may include: - java.lang.String - java.lang.Double - java.math.BigInteger - java.lang.Boolean - java.time.LocalDate - java.time.LocalDateTime - java.time.OffsetDateTime

(defmulti insert-into!
  {:added "0.47.0", :arglists '([driver db-id table-name column-names values])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)

Add columns given by col->type to a table named table-name. If the table doesn't exist it will throw an error.

(defmulti add-columns!
  {:added "0.49.0", :arglists '([driver db-id table-name col->type])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)

Returns the set of syncable schemas in the database (as strings).

(defmulti syncable-schemas
  {:added "0.47.0", :arglists '([driver database])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)
(defmethod syncable-schemas ::driver [_ _] #{})

Returns the database type for a given metabase.upload type as a HoneySQL spec. This will be a vector, which allows for additional options. Sample values:

  • [:bigint]
  • [[:varchar 255]]
  • [:generated-always :as :identity :primary-key]
(defmulti upload-type->database-type
  {:changelog-test/ignore true, :added "0.47.0", :arglists '([driver upload-type])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)

Returns the rows of data as arrays needed to populate the tabel_privileges table with the DB connection's current user privileges. The data contains the privileges that the user has on the given database. The privileges include select, insert, update, and delete.

The rows have the following keys and value types: - role :- [:maybe :string] - schema :- [:maybe :string] - table :- :string - select :- :boolean - update :- :boolean - insert :- :boolean - delete :- :boolean

Either: (1) role is null, corresponding to the privileges of the DB connection's current user (2) role is not null, corresponing to the privileges of the role

(defmulti current-user-table-privileges
  {:added "0.48.0", :arglists '([driver database])}
  dispatch-on-initialized-driver
  :hierarchy #'hierarchy)
 

Shared definitions and helper functions for use across different drivers.

(ns metabase.driver.common
  (:require
   [clojure.string :as str]
   [metabase.driver :as driver]
   [metabase.models.setting :as setting]
   [metabase.public-settings :as public-settings]
   [metabase.util.i18n :refer [deferred-tru trs]]
   [metabase.util.log :as log]
   [schema.core :as s])
  (:import
   (org.joda.time DateTime)))
(set! *warn-on-reflection* true)

TODO - we should rename these from default-*-details to default-*-connection-property

Map of the db host details field, useful for connection-properties implementations

(def default-host-details
  {:name         "host"
   :display-name (deferred-tru "Host")
   :helper-text (deferred-tru "Your database's IP address (e.g. 98.137.149.56) or its domain name (e.g. esc.mydatabase.com).")
   :placeholder  "name.database.com"})

Map of the db port details field, useful for connection-properties implementations. Implementations should assoc a :placeholder key.

(def default-port-details
  {:name         "port"
   :display-name (deferred-tru "Port")
   :type         :integer})

Map of the db user details field, useful for connection-properties implementations

(def default-user-details
  {:name         "user"
   :display-name (deferred-tru "Username")
   :placeholder  (deferred-tru "username")
   :required     true})

Map of the db password details field, useful for connection-properties implementations

(def default-password-details
  {:name         "password"
   :display-name (deferred-tru "Password")
   :type         :password
   :placeholder  "••••••••"})

Map of the db name details field, useful for connection-properties implementations

(def default-dbname-details
  {:name         "dbname"
   :display-name (deferred-tru "Database name")
   :placeholder  (deferred-tru "birds_of_the_world")
   :required     true})

Map of the db ssl details field, useful for connection-properties implementations

(def default-ssl-details
  {:name         "ssl"
   :display-name (deferred-tru "Use a secure connection (SSL)")
   :type         :boolean
   :default      false})

Map of the db additional-options details field, useful for connection-properties implementations. Should assoc a :placeholder key

(def additional-options
  {:name         "additional-options"
   :display-name (deferred-tru "Additional JDBC connection string options")
   :visible-if   {"advanced-options" true}})

Configuration parameters to include in the add driver page on drivers that support ssh tunnels

(def ssh-tunnel-preferences
  [{:name         "tunnel-enabled"
    :display-name (deferred-tru "Use an SSH tunnel")
    :placeholder  (deferred-tru "Enable this SSH tunnel?")
    :type         :boolean
    :default      false}
   {:name         "tunnel-host"
    :display-name (deferred-tru "SSH tunnel host")
    :helper-text  (deferred-tru "The hostname that you use to connect to SSH tunnels.")
    :placeholder  "hostname"
    :required     true
    :visible-if   {"tunnel-enabled" true}}
   {:name         "tunnel-port"
    :display-name (deferred-tru "SSH tunnel port")
    :type         :integer
    :default      22
    :required     false
    :visible-if   {"tunnel-enabled" true}}
   {:name         "tunnel-user"
    :display-name (deferred-tru "SSH tunnel username")
    :helper-text  (deferred-tru "The username you use to login to your SSH tunnel.")
    :placeholder  "username"
    :required     true
    :visible-if   {"tunnel-enabled" true}}
   ;; this is entirely a UI flag
   {:name         "tunnel-auth-option"
    :display-name (deferred-tru "SSH Authentication")
    :type         :select
    :options      [{:name (deferred-tru "SSH Key") :value "ssh-key"}
                   {:name (deferred-tru "Password") :value "password"}]
    :default      "ssh-key"
    :visible-if   {"tunnel-enabled" true}}
   {:name         "tunnel-pass"
    :display-name (deferred-tru "SSH tunnel password")
    :type         :password
    :placeholder  "******"
    :visible-if   {"tunnel-auth-option" "password"}}
   {:name         "tunnel-private-key"
    :display-name (deferred-tru "SSH private key to connect to the tunnel")
    :type         :string
    :placeholder  (deferred-tru "Paste the contents of an SSH private key here")
    :required     true
    :visible-if   {"tunnel-auth-option" "ssh-key"}}
   {:name         "tunnel-private-key-passphrase"
    :display-name (deferred-tru "Passphrase for SSH private key")
    :type         :password
    :placeholder  "******"
    :visible-if   {"tunnel-auth-option" "ssh-key"}}])

Map representing the start of the advanced option section in a DB connection form. Fields in this section should have their visibility controlled using the visible-if property.

(def advanced-options-start
  {:name    "advanced-options"
   :type    :section
   :default false})

Map representing the auto-run-queries option in a DB connection form.

(def auto-run-queries
  {:name         "auto_run_queries"
   :type         :boolean
   :default      true
   :display-name (deferred-tru "Rerun queries for simple explorations")
   :description  (deferred-tru
                   (str "We execute the underlying query when you explore data using Summarize or Filter. "
                        "This is on by default but you can turn it off if performance is slow."))
   :visible-if   {"advanced-options" true}})

Map representing the let-user-control-scheduling option in a DB connection form.

(def let-user-control-scheduling
  {:name         "let-user-control-scheduling"
   :type         :boolean
   :display-name (deferred-tru "Choose when syncs and scans happen")
   :description  (deferred-tru "By default, Metabase does a lightweight hourly sync and an intensive daily scan of field values. If you have a large database, turn this on to make changes.")
   :visible-if   {"advanced-options" true}})

Map representing the schedules.metadata_sync option in a DB connection form, which should be only visible if let-user-control-scheduling is enabled.

(def metadata-sync-schedule
  {:name "schedules.metadata_sync"
   :display-name (deferred-tru "Database syncing")
   :description  (deferred-tru
                   (str "This is a lightweight process that checks for updates to this database’s schema. "
                        "In most cases, you should be fine leaving this set to sync hourly."))
   :visible-if   {"let-user-control-scheduling" true}})

Map representing the schedules.cache_field_values option in a DB connection form, which should be only visible if let-user-control-scheduling is enabled.

(def cache-field-values-schedule
  {:name "schedules.cache_field_values"
   :display-name (deferred-tru "Scanning for Filter Values")
   :description  (deferred-tru
                   (str "Metabase can scan the values present in each field in this database to enable checkbox "
                        "filters in dashboards and questions. This can be a somewhat resource-intensive process, "
                        "particularly if you have a very large database. When should Metabase automatically scan "
                        "and cache field values?"))
   :visible-if   {"let-user-control-scheduling" true}})

Map representing the json-unfolding option in a DB connection form

(def json-unfolding
  {:name         "json-unfolding"
   :display-name (deferred-tru "Allow unfolding of JSON columns")
   :type         :boolean
   :visible-if   {"advanced-options" true}
   :description  (deferred-tru
                   (str "This enables unfolding JSON columns into their component fields. "
                        "Disable unfolding if performance is slow. If enabled, you can still disable unfolding for "
                        "individual fields in their settings."))
   :default      true})

Map representing the refingerprint option in a DB connection form.

(def refingerprint
  {:name         "refingerprint"
   :type         :boolean
   :display-name (deferred-tru "Periodically refingerprint tables")
   :description  (deferred-tru
                   (str "This enables Metabase to scan for additional field values during syncs allowing smarter "
                        "behavior, like improved auto-binning on your bar charts."))
   :visible-if   {"advanced-options" true}})

Vector containing the three most common options present in the advanced option section of the DB connection form.

(def default-advanced-options
  [auto-run-queries let-user-control-scheduling metadata-sync-schedule cache-field-values-schedule refingerprint])

Default options listed above, keyed by name. These keys can be listed in the plugin manifest to specify connection properties for drivers shipped as separate modules, e.g.:

connection-properties: - db-name - host

See the plugin manifest reference for more details.

(def default-options
  {:dbname                   default-dbname-details
   :host                     default-host-details
   :password                 default-password-details
   :port                     default-port-details
   :ssl                      default-ssl-details
   :user                     default-user-details
   :ssh-tunnel               ssh-tunnel-preferences
   :additional-options       additional-options
   :advanced-options-start   advanced-options-start
   :default-advanced-options default-advanced-options})

Map of the cloud-ip-address-info info field. The getter is invoked and converted to a :placeholder value prior to being returned to the client, in [[metabase.driver.util/connection-props-server->client]].

(def cloud-ip-address-info
  {:name   "cloud-ip-address-info"
   :type   :info
   :getter (fn []
             (when-let [ips (public-settings/cloud-gateway-ips)]
               (str (deferred-tru
                      (str "If your database is behind a firewall, you may need to allow connections from our Metabase "
                           "[Cloud IP addresses](https://www.metabase.com/cloud/docs/ip-addresses-to-whitelist.html):"))
                    "\n"
                    (str/join " - " ips))))})

Default definitions for informational banners that can be included in a database connection form. These keys can be added to the plugin manifest as connection properties, similar to the keys in the default-options map.

(def default-connection-info-fields
  {:cloud-ip-address-info cloud-ip-address-info})

+----------------------------------------------------------------------------------------------------------------+ | Class -> Base Type | +----------------------------------------------------------------------------------------------------------------+

Return the Field.base_type that corresponds to a given class returned by the DB. This is used to infer the types of results that come back from native queries.

(defn class->base-type
  [klass]
  (condp #(isa? %2 %1) klass
    Boolean                        :type/Boolean
    Double                         :type/Float
    Float                          :type/Float
    Integer                        :type/Integer
    Long                           :type/Integer
    java.math.BigDecimal           :type/Decimal
    java.math.BigInteger           :type/BigInteger
    Number                         :type/Number
    String                         :type/Text
    ;; java.sql types and Joda-Time types should be considered DEPRECATED
    java.sql.Date                  :type/Date
    java.sql.Timestamp             :type/DateTime
    java.util.Date                 :type/Date
    DateTime                       :type/DateTime
    java.util.UUID                 :type/UUID
    clojure.lang.IPersistentMap    :type/Dictionary
    clojure.lang.IPersistentVector :type/Array
    java.time.LocalDate            :type/Date
    java.time.LocalTime            :type/Time
    java.time.LocalDateTime        :type/DateTime
    ;; `OffsetTime` and `OffsetDateTime` should be mapped to one of `type/TimeWithLocalTZ`/`type/TimeWithZoneOffset`
    ;; and `type/DateTimeWithLocalTZ`/`type/DateTimeWithZoneOffset` respectively. We can't really tell how they're
    ;; stored in the DB based on class alone, so drivers should return more specific types where possible. See
    ;; discussion in the `metabase.types` namespace.
    java.time.OffsetTime           :type/TimeWithTZ
    java.time.OffsetDateTime       :type/DateTimeWithTZ
    java.time.ZonedDateTime        :type/DateTimeWithZoneID
    java.time.Instant              :type/Instant
    ;; TODO - this should go in the Postgres driver implementation of this method rather than here
    org.postgresql.util.PGobject   :type/*
    ;; all-NULL columns in DBs like Mongo w/o explicit types
    nil                            :type/*
    (do
      (log/warn (trs "Don''t know how to map class ''{0}'' to a Field base_type, falling back to :type/*." klass))
      :type/*)))

Number of result rows to sample when when determining base type.

(def ^:private column-info-sample-size
  100)

Transducer that given a sequence of values, returns the most common base type.

(defn values->base-type
  []
  ((comp (filter some?) (take column-info-sample-size) (map class))
   (fn
     ([]
      (doto (java.util.HashMap.)
        (.put nil 0)))                  ; fallback to keep `max-key` happy if no values
     ([^java.util.HashMap freqs, klass]
      (.put freqs klass (inc (.getOrDefault freqs klass 0)))
      freqs)
     ([freqs]
      (->> freqs
           (apply max-key val)
           key
           class->base-type)))))
(def ^:private ^clojure.lang.PersistentVector days-of-week
  [:monday :tuesday :wednesday :thursday :friday :saturday :sunday])

Used to override the [[metabase.public-settings/start-of-week]] settings. Primarily being used to calculate week-of-year in US modes where the start-of-week is always Sunday. More in (defmethod date [:sql :week-of-year-us]).

(def ^:dynamic *start-of-week*
  nil)
(s/defn start-of-week->int :- (s/pred (fn [n] (and (integer? n) (<= 0 n 6)))
                                      "Start of week integer")
  "Returns the int value for the current [[metabase.public-settings/start-of-week]] Setting value, which ranges from
  `0` (`:monday`) to `6` (`:sunday`). This is guaranteed to return a value."
  {:added "0.42.0"}
  []
  (.indexOf days-of-week (or *start-of-week* (setting/get-value-of-type :keyword :start-of-week))))

Like [[start-of-week-offset]] but takes a start-of-week keyword like :sunday rather than driver. Returns the offset (as a negative number) needed to adjust a day of week in the range 1..7 with start-of-week as one to a day of week in the range 1..7 with [[metabase.public-settings/start-of-week]] as 1.

(defn start-of-week-offset-for-day
  [start-of-week]
  (let [db-start-of-week     (.indexOf days-of-week start-of-week)
        target-start-of-week (start-of-week->int)
        delta                (int (- target-start-of-week db-start-of-week))]
    (* (Integer/signum delta)
       (- 7 (Math/abs delta)))))
(s/defn start-of-week-offset :- s/Int
  "Return the offset needed to adjust a day of the week (in the range 1..7) returned by the `driver`, with `1`
  corresponding to [[driver/db-start-of-week]], so that `1` corresponds to [[metabase.public-settings/start-of-week]] in
  results.
  e.g.
  If `:my-driver` returns [[driver/db-start-of-week]] as `:sunday` (1 is Sunday, 2 is Monday, and so forth),
  and [[metabase.public-settings/start-of-week]] is `:monday` (the results should have 1 as Monday, 2 as Tuesday... 7 is
  Sunday), then the offset should be `-1`, because `:monday` returned by the driver (`2`) minus `1` = `1`."
  [driver]
  (start-of-week-offset-for-day (driver/db-start-of-week driver)))

Returns true if JSON fields should be unfolded by default for this database, and false otherwise.

(defn json-unfolding-default
  [database]
  ;; This allows adding support for nested-field-columns for drivers in the future and
  ;; have json-unfolding enabled by default, without
  ;; needing a migration to add the `json-unfolding=true` key to the database details.
  (let [json-unfolding (get-in database [:details :json-unfolding])]
    (if (nil? json-unfolding)
      true
      json-unfolding)))
 

Various record types below are used as a convenience for differentiating the different param types.

(ns metabase.driver.common.parameters
  (:require
   [potemkin.types :as p.types]
   [pretty.core :as pretty]))

"FieldFilter" is something that expands to a clause like "some_field BETWEEN 1 AND 10"

field is a Field Toucan instance

value" is either: * no-value * A map contianing the value and type info for the value, e.g.

{:type :date/single :value #t "2019-09-20T19:52:00.000-07:00"}

  • A vector of maps like the one above (for multiple values)
(p.types/defrecord+ FieldFilter [field value]
  pretty/PrettyPrintable
  (pretty [this]
    (list (pretty/qualify-symbol-for-*ns* `map->FieldFilter) (into {} this))))

Is x an instance of the FieldFilter record type?

(defn FieldFilter?
  [x]
  (instance? FieldFilter x))

A "ReferencedCardQuery" parameter expands to the native query of the referenced card.

card-id is the ID of the Card instance whose query is the value for this parameter.

query is the native query as stored in the Card

parameters are positional parameters for a parameterized native query e.g. the JDBC parameters corresponding to ? placeholders

(p.types/defrecord+ ReferencedCardQuery [card-id query params]
  pretty/PrettyPrintable
  (pretty [this]
    (list (pretty/qualify-symbol-for-*ns* `map->ReferencedCardQuery) (into {} this))))

Is x an instance of the ReferencedCardQuery record type?

(defn ReferencedCardQuery?
  [x]
  (instance? ReferencedCardQuery x))

A ReferencedQuerySnippet expands to the partial query snippet stored in the NativeQuerySnippet table in the application DB.

snippet-id is the integer ID of the row in the application DB from where the snippet content is loaded.

content is the raw query snippet which will be replaced, verbatim, for this template tag.

(p.types/defrecord+ ReferencedQuerySnippet [snippet-id content]
  pretty/PrettyPrintable
  (pretty [this]
    (list (pretty/qualify-symbol-for-*ns* `map->ReferencedQuerySnippet) (into {} this))))

Is x an instance of the ReferencedQuerySnippet record type?

(defn ReferencedQuerySnippet?
  [x]
  (instance? ReferencedQuerySnippet x))

as in a literal date, defined by date-string S

TODO - why don't we just parse this into a Temporal type and let drivers handle it.

(p.types/defrecord+ Date [^String s]
  pretty/PrettyPrintable
  (pretty [_]
    (list (pretty/qualify-symbol-for-*ns* `->Date) s)))
(p.types/defrecord+ DateRange [start end]
  pretty/PrettyPrintable
  (pretty [_]
    (list (pretty/qualify-symbol-for-*ns* `->DateRange) start end)))

Convenience for representing an optional parameter present in a query but whose value is unspecified in the param values.

(def no-value
  ::no-value)
(p.types/defrecord+ Param [k]
  pretty/PrettyPrintable
  (pretty [_]
    (list (pretty/qualify-symbol-for-*ns* `->Param) k)))
(p.types/defrecord+ Optional [args]
  pretty/PrettyPrintable
  (pretty [_]
    (cons (pretty/qualify-symbol-for-*ns* `->Optional) args)))

Is x an instance of the Param record type?

Param? and Optional? exist mostly so you don't have to try to import the classes from this namespace which can cause problems if the ns isn't loaded first

(defn Param?
  [x]
  (instance? Param x))

Is x an instance of the Optional record type?

(defn Optional?
  [x]
  (instance? Optional x))
 

Shared code for handling datetime parameters, used by both MBQL and native params implementations.

(ns metabase.driver.common.parameters.dates
  (:require
   [clojure.string :as str]
   [java-time.api :as t]
   [medley.core :as m]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.params :as params]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.util.date-2 :as u.date]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms])
  (:import
   (java.time.temporal Temporal)))
(set! *warn-on-reflection* true)

Is param type :date or some subtype like :date/month-year?

(mu/defn date-type?
  [param-type :- :keyword]
  (= (get-in mbql.s/parameter-types [param-type :type]) :date))

Does date param-type represent a range of dates, rather than a single absolute date? (The value may be relative, such as past30days, or absolute, such as 2020-01.)

(defn not-single-date-type?
  [param-type]
  (and (date-type? param-type)
       (not (#{:date/single :date} param-type))))

Both in MBQL and SQL parameter substitution a field value is compared to a date range, either relative or absolute. Currently the field value is casted to a day (ignoring the time of day), so the ranges should have the same granularity level.

See https://github.com/metabase/metabase/pull/4607#issuecomment-290884313 how we could support hour/minute granularity in field parameter queries.

(defn- day-range
  [start end]
  {:start start :end end :unit :day})
(defn- comparison-range
  ([t unit]
   (comparison-range t t unit :day))
  ([start end unit]
   (comparison-range start end unit :day))
  ([start end unit resolution]
   (merge
    (u.date/comparison-range start unit :>= {:resolution resolution})
    (u.date/comparison-range end   unit :<= {:resolution resolution, :end :inclusive})
    {:unit unit})))
(defn- second-range
  [start end]
  (comparison-range start end :second :second))
(defn- minute-range
  [start end]
  (comparison-range start end :minute :minute))
(defn- hour-range
  [start end]
  (comparison-range start end :hour :hour))
(defn- week-range [start end]
  (comparison-range start end :week))
(defn- month-range [start end]
  (comparison-range start end :month))
(defn- year-range [start end]
  (comparison-range start end :year))
(defn- relative-quarter-range
  [start end]
  (comparison-range start end :quarter))
(defn- absolute-quarter-range
  [quarter year]
  (let [year-quarter (t/year-quarter year (case quarter
                                            "Q1" 1
                                            "Q2" 2
                                            "Q3" 3
                                            "Q4" 4))]
    {:start (.atDay year-quarter 1)
     :end   (.atEndOfQuarter year-quarter)
     :unit  :quarter}))
(def ^:private operations-by-date-unit
  {"second"  {:unit-range second-range
              :to-period  t/seconds}
   "minute"  {:unit-range minute-range
              :to-period  t/minutes}
   "hour"    {:unit-range hour-range
              :to-period  t/hours}
   "day"     {:unit-range day-range
              :to-period  t/days}
   "week"    {:unit-range week-range
              :to-period  t/weeks}
   "month"   {:unit-range month-range
              :to-period  t/months}
   "quarter" {:unit-range relative-quarter-range
              :to-period  (comp t/months (partial * 3))}
   "year"    {:unit-range year-range
              :to-period  t/years}})
(defn- maybe-reduce-resolution [unit dt]
  (if (contains? #{"second" "minute" "hour"} unit)
    dt
    ; for units that are a day or longer, convert back to LocalDate
    (t/local-date dt)))

+----------------------------------------------------------------------------------------------------------------+ | DATE STRING DECODERS | +----------------------------------------------------------------------------------------------------------------+

For parsing date strings and producing either a date range (for raw SQL parameter substitution) or a MBQL clause

(defn- expand-parser-groups
  [group-label group-value]
  (when group-value
    (case group-label
      :unit (conj (seq (get operations-by-date-unit group-value))
                  [group-label group-value])
      (:int-value :int-value-1) [[group-label (Integer/parseInt group-value)]]
      (:date :date-1 :date-2) [[group-label (u.date/parse group-value)]]
      [[group-label group-value]])))
(mu/defn ^:private regex->parser :- fn?
  "Takes a regex and labels matching the regex capturing groups. Returns a parser which takes a parameter value,
  validates the value against regex and gives a map of labels and group values. Respects the following special label
  names:
      :unit – finds a matching date unit and merges date unit operations to the result
      :int-value, :int-value-1 – converts the group value to integer
      :date, :date1, date2 – converts the group value to absolute date"
  [regex :- [:fn {:error/message "regular expression"} m/regexp?] group-labels]
  (fn [param-value]
    (when-let [regex-result (re-matches regex param-value)]
      (into {} (mapcat expand-parser-groups group-labels (rest regex-result))))))

Decorders consist of: 1) Parser which tries to parse the date parameter string 2) Range decoder which takes the parser output and produces a date range relative to the given datetime 3) Filter decoder which takes the parser output and produces a mbql clause for a given mbql field reference

(def ^:private temporal-units-regex #"(millisecond|second|minute|hour|day|week|month|quarter|year)")
(def ^:private relative-suffix-regex (re-pattern (format "(|~|-from-([0-9]+)%ss)" temporal-units-regex)))

Adding a tilde (~) at the end of a pasts filter means we should include the current time-unit (e.g. year, day, week, or month).

(defn- include-current?
  [relative-suffix]
  (= "~" relative-suffix))
(defn- with-temporal-unit-if-field
  [clause unit]
  (cond-> clause
    (mbql.u/is-clause? :field clause) (mbql.u/with-temporal-unit unit)))
(def ^:private relative-date-string-decoders
  [{:parser #(= % "today")
    :range  (fn [_ dt]
              (let [dt-res (t/local-date dt)]
                {:start dt-res,
                 :end   dt-res
                 :unit  :day}))
    :filter (fn [_ field-clause]
              [:= (with-temporal-unit-if-field field-clause :day) [:relative-datetime :current]])}
   {:parser #(= % "yesterday")
    :range  (fn [_ dt]
              (let [dt-res (t/local-date dt)]
                {:start (t/minus dt-res (t/days 1))
                 :end   (t/minus dt-res (t/days 1))
                 :unit  :day}))
    :filter (fn [_ field-clause]
              [:= (with-temporal-unit-if-field field-clause :day) [:relative-datetime -1 :day]])}
   ;; Adding a tilde (~) at the end of a past<n><unit>s filter means we should include the current day/etc.
   ;; e.g. past30days  = past 30 days, not including partial data for today ({:include-current false})
   ;;      past30days~ = past 30 days, *including* partial data for today   ({:include-current true}).
   ;; Adding a -from-<n><unit>s suffix at the end of the filter means we want to offset the range in the
   ;; case of past filters into the past, in the case of next filters into the future.
   ;; The implementation below uses the fact that if the relative suffix is not empty, then the
   ;; include-current flag is true.
   {:parser (regex->parser (re-pattern (str #"past([0-9]+)" temporal-units-regex #"s" relative-suffix-regex))
                           [:int-value :unit :relative-suffix :int-value-1 :unit-1])
    :range  (fn [{:keys [unit int-value unit-range to-period relative-suffix unit-1 int-value-1]} dt]
              (let [dt-offset (cond-> dt
                                unit-1 (t/minus ((get-in operations-by-date-unit [unit-1 :to-period]) int-value-1)))
                    dt-resolution (maybe-reduce-resolution unit dt-offset)]
                (unit-range (t/minus dt-resolution (to-period int-value))
                            (t/minus dt-resolution (to-period (if (include-current? relative-suffix) 0 1))))))
    :filter (fn [{:keys [unit int-value relative-suffix unit-1 int-value-1]} field-clause]
              (if unit-1
                [:between
                 [:+ field-clause [:interval int-value-1 (keyword unit-1)]]
                 [:relative-datetime (- int-value) (keyword unit)]
                 [:relative-datetime 0 (keyword unit)]]
                [:time-interval field-clause (- int-value) (keyword unit) {:include-current (include-current? relative-suffix)}]))}
   {:parser (regex->parser (re-pattern (str #"next([0-9]+)" temporal-units-regex #"s" relative-suffix-regex))
                           [:int-value :unit :relative-suffix :int-value-1 :unit-1])
    :range  (fn [{:keys [unit int-value unit-range to-period relative-suffix unit-1 int-value-1]} dt]
              (let [dt-offset (cond-> dt
                                unit-1 (t/plus ((get-in operations-by-date-unit [unit-1 :to-period]) int-value-1)))
                    dt-resolution (maybe-reduce-resolution unit dt-offset)]
                (unit-range (t/plus dt-resolution (to-period (if (include-current? relative-suffix) 0 1)))
                            (t/plus dt-resolution (to-period int-value)))))
    :filter (fn [{:keys [unit int-value relative-suffix unit-1 int-value-1]} field-clause]
              (if unit-1
                [:between
                 [:+ field-clause [:interval (- int-value-1) (keyword unit-1)]]
                 [:relative-datetime 0 (keyword unit)]
                 [:relative-datetime int-value (keyword unit)]]
                [:time-interval field-clause int-value (keyword unit) {:include-current (include-current? relative-suffix)}]))}
   {:parser (regex->parser (re-pattern (str #"last" temporal-units-regex))
                           [:unit])
    :range  (fn [{:keys [unit unit-range to-period]} dt]
              (let [last-unit (t/minus (maybe-reduce-resolution unit dt) (to-period 1))]
                (unit-range last-unit last-unit)))
    :filter (fn [{:keys [unit]} field-clause]
              [:time-interval field-clause :last (keyword unit)])}
   {:parser (regex->parser (re-pattern (str #"this" temporal-units-regex))
                           [:unit])
    :range  (fn [{:keys [unit unit-range]} dt]
              (let [dt-adj (maybe-reduce-resolution unit dt)]
                (unit-range dt-adj dt-adj)))
    :filter (fn [{:keys [unit]} field-clause]
              [:time-interval field-clause :current (keyword unit)])}])
(defn- ->iso-8601-date [t]
  (t/format :iso-local-date t))
(defn- ->iso-8601-date-time [t]
  (t/format :iso-local-date-time t))

TODO - using range->filter so much below seems silly. Why can't we just bucket the field and use := clauses?

(defn- range->filter
  [{:keys [start end]} field-clause]
  [:between (with-temporal-unit-if-field field-clause :day) (->iso-8601-date start) (->iso-8601-date end)])
(def ^:private short-day->day
  {"Mon" :monday
   "Tue" :tuesday
   "Wed" :wednesday
   "Thu" :thursday
   "Fri" :friday
   "Sat" :saturday
   "Sun" :sunday})
(def ^:private short-month->month
  (into {}
        (map-indexed (fn [i m] [m (inc i)]))
        ["Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"]))
(defn- parse-int-in-range [s min-val max-val]
  (try
    (let [i (Integer/parseInt s)]
      (when (<= min-val i max-val)
        i))
    (catch NumberFormatException _)))
(defn- excluded-datetime [unit date exclusion]
  (let [year (t/year date)]
    (case unit
      :hour (when-let [hour (parse-int-in-range exclusion 0 23)]
              (format "%sT%02d:00:00Z" date hour))
      :day (when-let [day (short-day->day exclusion)]
             (str (t/adjust date :next-or-same-day-of-week day)))
      :month (when-let [month (short-month->month exclusion)]
               (format "%s-%02d-01" year month))
      :quarter (when-let [quarter (parse-int-in-range exclusion 1 4)]
                 (format "%s-%02d-01" year (inc (* 3 (dec quarter)))))
      nil)))
(def ^:private excluded-temporal-unit
  {:hour    :hour-of-day
   :day     :day-of-week
   :month   :month-of-year
   :quarter :quarter-of-year})

Regex to match date exclusion values, e.g. exclude-days-Mon, exclude-months-Jan, etc.

(def date-exclude-regex
  (re-pattern (str "exclude-" temporal-units-regex #"s-([-\p{Alnum}]+)")))
(defn- absolute-date->unit
  [date-string]
  (if (str/includes? date-string "T")
    ;; on the UI you can specify the time up to the minute, so we use minute here
    :minute
    :day))
(def ^:private absolute-date-string-decoders
  ;; year and month
  [{:parser (regex->parser #"([0-9]{4}-[0-9]{2})" [:date])
    :range  (fn [{:keys [date]} _]
              (month-range date date))
    :filter (fn [{:keys [date]} field-clause]
              (range->filter (month-range date date) field-clause))}
   ;; quarter year
   {:parser (regex->parser #"(Q[1-4]{1})-([0-9]{4})" [:quarter :year])
    :range  (fn [{:keys [quarter year]} _]
              (absolute-quarter-range quarter (Integer/parseInt year)))
    :filter (fn [{:keys [quarter year]} field-clause]
              (range->filter (absolute-quarter-range quarter (Integer/parseInt year))
                             field-clause))}
   ;; single day
   {:parser (regex->parser #"([0-9-T:]+)" [:date])
    :range  (fn [{:keys [date]} _]
              {:start date :end date :unit (absolute-date->unit date)})
    :filter (fn [{:keys [date]} field-clause]
              (let [iso8601date (->iso-8601-date date)]
                [:= (with-temporal-unit-if-field field-clause :day) iso8601date]))}
   ;; day range
   {:parser (regex->parser #"([0-9-T]+)~([0-9-T]+)" [:date-1 :date-2])
    :range  (fn [{:keys [date-1 date-2]} _]
              {:start date-1 :end date-2 :unit (absolute-date->unit date-1)})
    :filter (fn [{:keys [date-1 date-2]} field-clause]
              [:between (with-temporal-unit-if-field field-clause :day) (->iso-8601-date date-1) (->iso-8601-date date-2)])}
   ;; datetime range
   {:parser (regex->parser #"([0-9-T:]+)~([0-9-T:]+)" [:date-1 :date-2])
    :range  (fn [{:keys [date-1 date-2]} _]
              {:start date-1, :end date-2 :unit (absolute-date->unit date-1)})
    :filter (fn [{:keys [date-1 date-2]} field-clause]
              [:between (with-temporal-unit-if-field field-clause :default)
               (->iso-8601-date-time date-1)
               (->iso-8601-date-time date-2)])}
   ;; before day
   {:parser (regex->parser #"~([0-9-T:]+)" [:date])
    :range  (fn [{:keys [date]} _]
              {:end date :unit (absolute-date->unit date)})
    :filter (fn [{:keys [date]} field-clause]
              [:< (with-temporal-unit-if-field field-clause :day) (->iso-8601-date date)])}
   ;; after day
   {:parser (regex->parser #"([0-9-T:]+)~" [:date])
    :range  (fn [{:keys [date]} _]
              {:start date :unit (absolute-date->unit date)})
    :filter (fn [{:keys [date]} field-clause]
              [:> (with-temporal-unit-if-field field-clause :day) (->iso-8601-date date)])}
   ;; exclusions
   {:parser (regex->parser date-exclude-regex [:unit :exclusions])
    :filter (fn [{:keys [unit exclusions]} field-clause]
              (let [unit (keyword unit)
                    exclusions (map (partial excluded-datetime unit (t/local-date))
                                    (str/split exclusions #"-"))]
                (when (and (seq exclusions) (every? some? exclusions))
                  (into [:!= (with-temporal-unit-if-field field-clause (excluded-temporal-unit unit))] exclusions))))}])
(def ^:private all-date-string-decoders
  (concat relative-date-string-decoders absolute-date-string-decoders))

Returns the first successfully decoded value, run through both parser and a range/filter decoder depending on decoder-type. This generates an inclusive range by default. The range is adjusted to be exclusive as needed: see dox for [[date-string->range]] for more details.

(mu/defn ^:private execute-decoders
  [decoders
   decoder-type :- [:enum :range :filter]
   decoder-param
   date-string :- :string]
  (some (fn [{parser :parser, parser-result-decoder decoder-type}]
          (when-let [parser-result (and parser-result-decoder (parser date-string))]
            (parser-result-decoder parser-result decoder-param)))
        decoders))
(def ^:private TemporalUnit
  (into [:enum] u.date/add-units))
(def ^:private TemporalRange
  [:map
   [:start {:optional true} [:fn #(instance? Temporal %)]]
   [:end   {:optional true} [:fn #(instance? Temporal %)]]
   [:unit                   TemporalUnit]])
(mu/defn ^:private adjust-inclusive-range-if-needed :- [:maybe TemporalRange]
  "Make an inclusive date range exclusive as needed."
  [{:keys [inclusive-start? inclusive-end?]} temporal-range :- [:maybe TemporalRange]]
  (-> temporal-range
      (m/update-existing :start #(if inclusive-start?
                                   %
                                   (u.date/add % (case (:unit temporal-range)
                                                   (:year :quarter :month :week :day)
                                                   :day
                                                   (:unit temporal-range)) -1)))
      (m/update-existing :end #(if inclusive-end?
                                 %
                                 (u.date/add % (case (:unit temporal-range)
                                                   (:year :quarter :month :week :day)
                                                   :day
                                                   (:unit temporal-range)) 1)))))

Schema for a valid date range returned by date-string->range.

(def ^:private DateStringRange
  [:and [:map {:closed true}
         [:start {:optional true} ms/NonBlankString]
         [:end   {:optional true} ms/NonBlankString]]
   [:fn {:error/message "must have either :start or :end"}
    (fn [{:keys [start end]}]
      (or start end))]
   [:fn {:error/message ":start must come before :end"}
    (fn [{:keys [start end]}]
      (or (not start)
          (not end)
          (not (pos? (compare start end)))))]])
(defn- format-date-range
  [date-range]
  (-> date-range
      (m/update-existing :start u.date/format)
      (m/update-existing :end u.date/format)
      (dissoc :unit)))
(mu/defn date-string->range :- DateStringRange
  "Takes a string description of a date range such as `lastmonth` or `2016-07-15~2016-08-6` and returns a map with
  `:start` and/or `:end` keys, as ISO-8601 *date* strings. By default, `:start` and `:end` are inclusive,
  e.g:
    (date-string->range \"past2days\") ; -> {:start \"2020-01-20\", :end \"2020-01-21\"}
  intended for use with SQL like
    WHERE date(some_column) BETWEEN date '2020-01-20' AND date '2020-01-21'
  which is *INCLUSIVE*. If the filter clause you're generating is not inclusive, pass the `:inclusive-start?` or
  `:inclusive-end?` options as needed to generate an appropriate range.
  Note that some ranges are open-ended on one side, and will have only a `:start` or an `:end`."
  ;; 1-arg version returns inclusive start/end; 2-arg version can adjust as needed
  ([date-string]
   (date-string->range date-string nil))
  ([date-string  :- ms/NonBlankString
    {:keys [inclusive-start? inclusive-end?]
     :or   {inclusive-start? true inclusive-end? true}}]
   (let [options {:inclusive-start? inclusive-start?, :inclusive-end? inclusive-end?}
         now (t/local-date-time)]
     ;; Relative dates respect the given time zone because a notion like "last 7 days" might mean a different range of
     ;; days depending on the user timezone
     (or (->> (execute-decoders relative-date-string-decoders :range now date-string)
              (adjust-inclusive-range-if-needed options)
              format-date-range)
         ;; Absolute date ranges don't need the time zone conversion because in SQL the date ranges are compared
         ;; against the db field value that is casted granularity level of a day in the db time zone
         (->> (execute-decoders absolute-date-string-decoders :range nil date-string)
              (adjust-inclusive-range-if-needed options)
              format-date-range)
         ;; if both of the decoders above fail, then the date string is invalid
         (throw (ex-info (tru "Don''t know how to parse date param ''{0}'' — invalid format" date-string)
                         {:param date-string
                          :type  qp.error-type/invalid-parameter}))))))
(mu/defn date-string->filter :- mbql.s/Filter
  "Takes a string description of a *date* (not datetime) range such as 'lastmonth' or '2016-07-15~2016-08-6' and
   returns a corresponding MBQL filter clause for a given field reference."
  [date-string :- :string
   field       :- [:or ms/PositiveInt mbql.s/Field]]
  (or (execute-decoders all-date-string-decoders :filter (params/wrap-field-id-if-needed field) date-string)
      (throw (ex-info (tru "Don''t know how to parse date string {0}" (pr-str date-string))
                      {:type        qp.error-type/invalid-parameter
                       :date-string date-string}))))
 

This namespace handles parameters that are operators.

{:type :number/between :target [:dimension [:field 26 {:source-field 5}]] :value [3 5]}

(ns metabase.driver.common.parameters.operators
  (:require
   [metabase.mbql.schema :as mbql.s]
   [metabase.models.params :as params]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu]
   [schema.core :as s]))
(s/defn ^:private operator-arity :- (s/maybe (s/enum :unary :binary :variadic))
  [param-type]
  (get-in mbql.s/parameter-types [param-type :operator]))

Returns whether param-type is an "operator" type.

(defn operator?
  [param-type]
  (boolean (operator-arity param-type)))
(s/defn ^:private verify-type-and-arity
  [field param-type param-value]
  (letfn [(maybe-arity-error [n]
            (when (not= n (count param-value))
              (throw (ex-info (format "Operations Invalid arity: expected %s but received %s"
                                      n (count param-value))
                              {:param-type  param-type
                               :param-value param-value
                               :field-id    (second field)
                               :type        qp.error-type/invalid-parameter}))))]
    (condp = (operator-arity param-type)
      :unary
      (maybe-arity-error 1)
      :binary
      (maybe-arity-error 2)
      :variadic
      (when-not (sequential? param-value)
        (throw (ex-info (tru "Invalid values provided for operator: {0}" param-type)
                        {:param-type  param-type
                         :param-value param-value
                         :field-id    (second field)
                         :type        qp.error-type/invalid-parameter})))
      (throw (ex-info (tru "Unrecognized operation: {0}" param-type)
                      {:param-type  param-type
                       :param-value param-value
                       :field-id    (second field)
                       :type        qp.error-type/invalid-parameter})))))
(mu/defn to-clause :- mbql.s/Filter
  "Convert an operator style parameter into an mbql clause. Will also do arity checks and throws an ex-info with
  `:type qp.error-type/invalid-parameter` if arity is incorrect."
  [{param-type :type [a b :as param-value] :value [_ field :as _target] :target options :options :as _param}]
  (verify-type-and-arity field param-type param-value)
  (let [field' (params/wrap-field-id-if-needed field)]
    (case (operator-arity param-type)
      :binary
      (cond-> [(keyword (name param-type)) field' a b]
        (boolean options) (conj options))
      :unary
      (cond-> [(keyword (name param-type)) field' a]
        (boolean options) (conj options))
      :variadic
      (cond-> (into [(keyword (name param-type)) field'] param-value)
        (boolean options) (conj options))
      (throw (ex-info (format "Unrecognized operator: %s" param-type)
                      {:param-type param-type
                       :param-value param-value
                       :field-id    (second field)
                       :type        qp.error-type/invalid-parameter})))))
 
(ns metabase.driver.common.parameters.parse
  (:require
   [clojure.string :as str]
   [metabase.driver.common.parameters :as params]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   [schema.core :as s])
  (:import
   (metabase.driver.common.parameters Optional Param)))
(set! *warn-on-reflection* true)
(def ^:private StringOrToken  (s/cond-pre s/Str {:token s/Keyword
                                                 :text  s/Str}))
(def ^:private ParsedToken (s/cond-pre s/Str Param Optional))

Returns any adjacent strings in coll combined together

(defn- combine-adjacent-strings
  [coll]
  (apply concat
         (for [subseq (partition-by string? coll)]
           (if (string? (first subseq))
             [(apply str subseq)]
             subseq))))

Returns a vector of [index match] for string or regex pattern found in s

(defn- find-token
  [s pattern]
  (if (string? pattern)
    (when-let [index (str/index-of s pattern)]
      [index pattern])
    (let [m (re-matcher pattern s)]
      (when (.find m)
        [(.start m) (subs s (.start m) (.end m))]))))
(defn- tokenize-one [s pattern token]
  (loop [acc [], s s]
    (if (empty? s)
      acc
      (if-let [[index text] (find-token s pattern)]
        (recur (conj acc (subs s 0 index) {:text text :token token})
               (subs s (+ index (count text))))
        (conj acc s)))))
(def ^:private param-token-patterns
  [["[[" :optional-begin]
   ["]]" :optional-end]
    ;; param-begin should only match the last two opening brackets in a sequence of > 2, e.g.
    ;; [{$match: {{{x}}, field: 1}}] should parse to ["[$match: {" (param "x") ", field: 1}}]"]
   [#"(?s)\{\{(?!\{)" :param-begin]
   ["}}" :param-end]])
(def ^:private sql-token-patterns
  (concat
   [["/*" :block-comment-begin]
    ["*/" :block-comment-end]
    ["--" :line-comment-begin]
    ["\n" :newline]]
   param-token-patterns))
(s/defn ^:private tokenize :- [StringOrToken]
  [s :- s/Str, handle-sql-comments :- s/Bool]
  (reduce
   (fn [strs [token-str token]]
     (filter
      (some-fn keyword? seq)
      (mapcat
       (fn [s]
         (if-not (string? s)
           [s]
           (tokenize-one s token-str token)))
       strs)))
   [s]
   (if handle-sql-comments
     sql-token-patterns
     param-token-patterns)))
(defn- param [& [k & more]]
  (when (or (seq more)
            (not (string? k)))
    (throw (ex-info (tru "Invalid '{{...}}' clause: expected a param name")
                    {:type qp.error-type/invalid-query})))
  (let [k (str/trim k)]
    (when (empty? k)
      (throw (ex-info (tru "'{{...}}' clauses cannot be empty.")
                      {:type qp.error-type/invalid-query})))
    (params/->Param k)))
(defn- optional [& parsed]
  (when-not (some params/Param? parsed)
    (throw (ex-info (tru "'[[...]]' clauses must contain at least one '{{...}}' clause.")
                    {:type qp.error-type/invalid-query})))
  (params/->Optional (combine-adjacent-strings parsed)))
(s/defn ^:private parse-tokens* :- [(s/one [ParsedToken] "parsed tokens") (s/one [StringOrToken] "remaining tokens")]
  [tokens :- [StringOrToken]
   optional-level :- s/Int
   param-level :- s/Int
   comment-mode :- (s/enum nil :block-comment-begin :line-comment-begin)]
  (loop [acc [], [string-or-token & more] tokens]
    (cond
      (nil? string-or-token)
      (if (or (pos? optional-level) (pos? param-level))
        (throw (ex-info (tru "Invalid query: found '[[' or '{{' with no matching ']]' or '}}'")
                        {:type qp.error-type/invalid-query}))
        [acc nil])
      (string? string-or-token)
      (recur (conj acc string-or-token) more)
      :else
      (let [{:keys [text token]} string-or-token]
        (case token
          :optional-begin
          (if comment-mode
            (recur (conj acc text) more)
            (let [[parsed more] (parse-tokens* more (inc optional-level) param-level comment-mode)]
              (recur (conj acc (apply optional parsed)) more)))
          :param-begin
          (if comment-mode
            (recur (conj acc text) more)
            (let [[parsed more] (parse-tokens* more optional-level (inc param-level) comment-mode)]
              (recur (conj acc (apply param parsed)) more)))
          (:line-comment-begin :block-comment-begin)
          (if (or comment-mode (pos? optional-level))
            (recur (conj acc text) more)
            (let [[parsed more] (parse-tokens* more optional-level param-level token)]
              (recur (into acc (cons text parsed)) more)))
          :block-comment-end
          (if (= comment-mode :block-comment-begin)
            [(conj acc text) more]
            (recur (conj acc text) more))
          :newline
          (if (= comment-mode :line-comment-begin)
            [(conj acc text) more]
            (recur (conj acc text) more))
          :optional-end
          (if (pos? optional-level)
            [acc more]
            (recur (conj acc text) more))
          :param-end
          (if (pos? param-level)
            [acc more]
            (recur (conj acc text) more)))))))
(s/defn parse :- [(s/cond-pre s/Str Param Optional)]
  "Attempts to parse parameters in string `s`. Parses any optional clauses or parameters found, and returns a sequence
   of non-parameter string fragments (possibly) interposed with `Param` or `Optional` instances.
   If `handle-sql-comments` is true (default) then we make a best effort to ignore params in SQL comments."
  ([s :- s/Str]
   (parse s true))
  ([s :- s/Str, handle-sql-comments :- s/Bool]
   (let [tokenized (tokenize s handle-sql-comments)]
     (if (= [s] tokenized)
       [s]
       (do
         (log/tracef "Tokenized native query ->\n%s" (u/pprint-to-str tokenized))
         (u/prog1 (combine-adjacent-strings (first (parse-tokens* tokenized 0 0 nil)))
                  (log/tracef "Parsed native query ->\n%s" (u/pprint-to-str <>))))))))
 

These functions build a map of information about the types and values of the params used in a query. (These functions don't parse the query itself, but instead look at the values of :template-tags and :parameters passed along with the query.)

(query->params-map some-inner-query) ;; -> {"checkindate" {:field {:name "date", :parentid nil, :table_id 1375} :param {:type "date/range" :target ["dimension" ["template-tag" "checkin_date"]] :value "2015-01-01~2016-09-01"}}}

(ns metabase.driver.common.parameters.values
  (:require
   [clojure.string :as str]
   [metabase.driver.common.parameters :as params]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.lib.schema.template-tag :as lib.schema.template-tag]
   [metabase.mbql.schema :as mbql.s]
   [metabase.models.native-query-snippet :refer [NativeQuerySnippet]]
   [metabase.query-processor :as qp]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.store :as qp.store]
   [metabase.query-processor.util.persisted-cache :as qp.persistence]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   #_{:clj-kondo/ignore [:discouraged-namespace]}
   [toucan2.core :as t2])
  (:import
   (clojure.lang ExceptionInfo)
   (java.text NumberFormat)
   (java.util UUID)))
(set! *warn-on-reflection* true)
(def ^:private Date                   (ms/InstanceOfClass metabase.driver.common.parameters.Date))
(def ^:private FieldFilter            (ms/InstanceOfClass metabase.driver.common.parameters.FieldFilter))
(def ^:private ReferencedQuerySnippet (ms/InstanceOfClass metabase.driver.common.parameters.ReferencedQuerySnippet))
(def ^:private ReferencedCardQuery    (ms/InstanceOfClass metabase.driver.common.parameters.ReferencedCardQuery))

Parse a tag by its :type, returning an appropriate record type such as metabase.driver.common.parameters.FieldFilter.

(defmulti ^:private parse-tag
  {:arglists '([tag params])}
  (fn [{tag-type :type} _]
    (keyword tag-type)))
(defmethod parse-tag :default
  [{tag-type :type, :as tag} _]
  (throw (ex-info (tru "Don''t know how to parse parameter of type {0}" (pr-str tag-type))
                  {:tag tag})))

various schemas are used to check that various functions return things in expected formats

TAGS in this case are simple params like {{x}} that get replaced with a single value ("ABC" or 1) as opposed to a "FieldFilter" clause like FieldFilters

Since 'FieldFilter' are considered their own :type (confusingly enough, called :dimension), to actually store the type of a FieldFilter look at the key :widget-type. This applies to things like the default value for a FieldFilter as well.

Schema for a valid single value for a param.

(def ^:private SingleValue
  [:or FieldFilter Date number? :string :boolean])

Schema for valid param value(s). Params can have one or more values.

(def ^:private ParsedParamValue
  [:maybe
   [:or
    {:error/message "Valid param value(s)"}
    [:= params/no-value]
    SingleValue
    [:sequential SingleValue]
    :map]])

Given a template tag, returns a set of target structures that can be used to target the tag. Potential targets look something like:

[:dimension [:template-tag {:id }] [:dimension [:template-tag ]] ; for Field Filters

[:variable [:template-tag {:id }]] [:variable [:template-tag ]] ; for other types of params

Targeting template tags by ID is preferable (as of version 44) but targeting by name is supported for backwards compatibility.

(mu/defn ^:private tag-targets
  [tag :- mbql.s/TemplateTag]
  (let [target-type (case (:type tag)
                      :dimension :dimension
                      :variable)]
    #{[target-type [:template-tag (:name tag)]]
      [target-type [:template-tag {:id (:id tag)}]]}))

Return params from the provided params list targeting the provided tag.

(mu/defn ^:private tag-params
  [tag    :- mbql.s/TemplateTag
   params :- [:maybe [:sequential mbql.s/Parameter]]]
  (let [targets (tag-targets tag)]
    (seq (for [param params
               :when (contains? targets (:target param))]
           param))))

FieldFilter Params (Field Filters) (e.g. WHERE {{x}})

(defn- missing-required-param-exception [param-display-name]
  (ex-info (tru "You''ll need to pick a value for ''{0}'' before this query can run."
                param-display-name)
           {:type qp.error-type/missing-required-parameter}))
(mu/defn ^:private field-filter->field-id :- ms/PositiveInt
  [field-filter]
  (second field-filter))

Get parameter value(s) for a Field filter. Returns map if there is a normal single value, or a vector of maps for multiple values.

(mu/defn ^:private field-filter-value
  [tag    :- mbql.s/TemplateTag
   params :- [:maybe [:sequential mbql.s/Parameter]]]
  (let [matching-params  (tag-params tag params)
        tag-opts         (:options tag)
        normalize-params (fn [params]
                           ;; remove `:target` which is no longer needed after this point, and add any tag options
                           (let [params (map #(cond-> (dissoc % :target)
                                                (seq tag-opts) (assoc :options tag-opts))
                                             params)]
                             (if (= (count params) 1)
                               (first params)
                               params)))
        nil-value?        (and (seq matching-params)
                               (every? (fn [param]
                                         (nil? (:value param)))
                                       matching-params))]
    (cond
      ;; if we have matching parameter(s) that all have actual values, return those.
      (and (seq matching-params) (every? :value matching-params))
      (normalize-params matching-params)
      ;; If a FieldFilter has value=nil, return a [[params/no-value]]
      ;; so that this filter can be substituted with "1 = 1" regardless of whether or not this tag has default value
      (and (not (:required tag)) nil-value?)
      params/no-value
      ;; When a FieldFilter has value=nil and is required, throw an exception
      (and (:required tag) nil-value?)
      (throw (missing-required-param-exception (:display-name tag)))
      ;; otherwise, attempt to fall back to the default value specified as part of the template tag.
      (some? (:default tag))
      (cond-> {:type    (:widget-type tag :dimension) ; widget-type is the actual type of the default value if set
               :value   (:default tag)}
        tag-opts (assoc :options tag-opts))
      ;; if that doesn't exist, see if the matching parameters specified default values This can be the case if the
      ;; parameters came from a Dashboard -- Dashboard parameter mappings can specify their own defaults -- but we want
      ;; the defaults specified in the template tag to take precedence if both are specified
      (and (seq matching-params) (every? :default matching-params))
      (normalize-params matching-params)
      ;; otherwise there is no value for this Field filter ("dimension"), throw Exception if this param is required,
      (:required tag)
      (throw (missing-required-param-exception (:display-name tag)))
      ;; otherwise return [[params/no-value]] to signify that this filter can be substituted with "1 = 1"
      :else
      params/no-value)))
(mu/defmethod parse-tag :dimension :- [:maybe FieldFilter]
  [{field-filter :dimension, :as tag} :- mbql.s/TemplateTag
   params                             :- [:maybe [:sequential mbql.s/Parameter]]]
  (params/map->FieldFilter
   {:field (let [field-id (field-filter->field-id field-filter)]
             (or (lib.metadata/field (qp.store/metadata-provider) field-id)
                 (throw (ex-info (tru "Can''t find field with ID: {0}" field-id)
                                 {:field-id field-id, :type qp.error-type/invalid-parameter}))))
    :value (field-filter-value tag params)}))
(mu/defmethod parse-tag :card :- ReferencedCardQuery
  [{:keys [card-id], :as tag} :- mbql.s/TemplateTag _params]
  (when-not card-id
    (throw (ex-info (tru "Invalid :card parameter: missing `:card-id`")
                    {:tag tag, :type qp.error-type/invalid-parameter})))
  (let [card           (lib.metadata.protocols/card (qp.store/metadata-provider) card-id)
        persisted-info (when (:dataset card)
                         (:lib/persisted-info card))
        query          (or (:dataset-query card)
                           (throw (ex-info (tru "Card {0} not found." card-id)
                                           {:card-id card-id, :tag tag, :type qp.error-type/invalid-parameter})))]
    (try
      (params/map->ReferencedCardQuery
       (let [query (assoc query :info {:card-id card-id})]
         (log/tracef "Compiling referenced query for Card %d\n%s" card-id (u/pprint-to-str query))
         (merge {:card-id card-id}
                (or (when (qp.persistence/can-substitute? card persisted-info)
                      {:query (qp.persistence/persisted-info-native-query
                               (u/the-id (lib.metadata/database (qp.store/metadata-provider)))
                               persisted-info)})
                    (qp/compile query)))))
      (catch ExceptionInfo e
        (throw (ex-info
                (tru "The sub-query from referenced question #{0} failed with the following error: {1}"
                     (str card-id) (pr-str (.getMessage e)))
                {:card-query-error? true
                 :card-id           card-id
                 :tag               tag
                 :type              qp.error-type/invalid-parameter}
                e))))))
(mu/defmethod parse-tag :snippet :- ReferencedQuerySnippet
  [{:keys [snippet-name snippet-id], :as tag} :- mbql.s/TemplateTag
   _params]
  (let [snippet-id (or snippet-id
                       (throw (ex-info (tru "Unable to resolve Snippet: missing `:snippet-id`")
                                       {:tag tag, :type qp.error-type/invalid-parameter})))
        snippet    (or (t2/select-one NativeQuerySnippet :id snippet-id)
                       (throw (ex-info (tru "Snippet {0} {1} not found." snippet-id (pr-str snippet-name))
                                       {:snippet-id   snippet-id
                                        :snippet-name snippet-name
                                        :tag          tag
                                        :type         qp.error-type/invalid-parameter})))]
    (params/map->ReferencedQuerySnippet
     {:snippet-id (:id snippet)
      :content    (:content snippet)})))

Non-FieldFilter Params (e.g. WHERE x = {{x}})

Get the value that should be used for a raw value (i.e., non-Field filter) template tag from params.

(mu/defn ^:private param-value-for-raw-value-tag
  [tag    :- mbql.s/TemplateTag
   params :- [:maybe [:sequential mbql.s/Parameter]]]
  (let [matching-param (when-let [matching-params (not-empty (tag-params tag params))]
                         ;; double-check and make sure we didn't end up with multiple mappings or something crazy like that.
                         (when (> (count matching-params) 1)
                           (throw (ex-info (tru "Error: multiple values specified for parameter; non-Field Filter parameters can only have one value.")
                                           {:type                qp.error-type/invalid-parameter
                                            :template-tag        tag
                                            :matching-parameters params})))
                         (first matching-params))
        nil-value?       (and matching-param
                              (nil? (:value matching-param)))]
    ;; But if the param is present in `params` and its value is nil, don't use the default.
    ;; If the param is not present in `params` use a default from either the tag or the Dashboard parameter.
    ;; If both the tag and Dashboard parameter specify a default value, prefer the default value from the tag.
    (or (:value matching-param)
        (when (and nil-value? (:required tag))
          (throw (missing-required-param-exception (:display-name tag))))
        (when (and nil-value? (not (:required tag)))
          params/no-value)
        (:default tag)
        (:default matching-param)
        (if (:required tag)
          (throw (missing-required-param-exception (:display-name tag)))
          params/no-value))))
(defmethod parse-tag :number
  [tag params]
  (param-value-for-raw-value-tag tag params))
(defmethod parse-tag :text
  [tag params]
  (param-value-for-raw-value-tag tag params))
(defmethod parse-tag :date
  [tag params]
  (param-value-for-raw-value-tag tag params))

Parsing Values

(mu/defn ^:private parse-number :- number?
  "Parse a string like `1` or `2.0` into a valid number. Done mostly to keep people from passing in
   things that aren't numbers, like SQL identifiers."
  [s :- :string]
  (.parse (NumberFormat/getInstance) ^String s))
(mu/defn ^:private value->number :- [:or number? [:sequential {:min 1} number?]]
  "Parse a 'numeric' param value. Normally this returns an integer or floating-point number, but as a somewhat
  undocumented feature it also accepts comma-separated lists of numbers. This was a side-effect of the old parameter
  code that unquestioningly substituted any parameter passed in as a number directly into the SQL. This has long been
  changed for security purposes (avoiding SQL injection), but since users have come to expect comma-separated numeric
  values to work we'll allow that (with validation) and return a vector to be converted to a list in the native query."
  [value]
  (cond
    ;; already parsed
    (number? value)
    value
    ;; newer operators use vectors as their arguments even if there's only one
    (vector? value)
    (u/many-or-one (mapv value->number value))
    ;; if the value is a string, then split it by commas in the string. Usually there should be none.
    ;; Parse each part as a number.
    (string? value)
    (u/many-or-one (mapv parse-number (str/split value #",")))))
(mu/defn ^:private parse-value-for-field-type :- :any
  "Do special parsing for value for a (presumably textual) FieldFilter (`:type` = `:dimension`) param (i.e., attempt
  to parse it as appropriate based on the base type and semantic type of the Field associated with it). These are
  special cases for handling types that do not have an associated parameter type (such as `date` or `number`), such as
  UUID fields."
  [effective-type :- ms/FieldType value]
  (cond
    (isa? effective-type :type/UUID)
    (UUID/fromString value)
    (isa? effective-type :type/Number)
    (value->number value)
    :else
    value))
(mu/defn ^:private update-filter-for-field-type :- ParsedParamValue
  "Update a Field Filter with a textual, or sequence of textual, values. The base type and semantic type of the field
  are used to determine what 'semantic' type interpretation is required (e.g. for UUID fields)."
  [{field :field, {value :value} :value, :as field-filter} :- FieldFilter]
  (let [effective-type ((some-fn :effective-type :base-type) field)
        new-value (cond
                    (string? value)
                    (parse-value-for-field-type effective-type value)
                    (and (sequential? value)
                         (every? string? value))
                    (mapv (partial parse-value-for-field-type effective-type) value))]
    (when (not= value new-value)
      (log/tracef "update filter for base-type: %s value: %s -> %s"
                  (pr-str effective-type) (pr-str value) (pr-str new-value)))
    (cond-> field-filter
      new-value (assoc-in [:value :value] new-value))))
(mu/defn ^:private parse-value-for-type :- ParsedParamValue
  "Parse a `value` based on the type chosen for the param, such as `text` or `number`. (Depending on the type of param
  created, `value` here might be a raw value or a map including information about the Field it references as well as a
  value.) For numbers, dates, and the like, this will parse the string appropriately; for `text` parameters, this will
  additionally attempt handle special cases based on the base type of the Field, for example, parsing params for UUID
  base type Fields as UUIDs."
  [param-type :- ::lib.schema.template-tag/type value]
  (cond
    (= value params/no-value)
    value
    (= param-type :number)
    (value->number value)
    (= param-type :date)
    (params/map->Date {:s value})
    ;; Field Filters
    (and (= param-type :dimension)
         (= (get-in value [:value :type]) :number))
    (update-in value [:value :value] value->number)
    (sequential? value)
    (mapv (partial parse-value-for-type param-type) value)
    ;; Field Filters with "special" base types
    (and (= param-type :dimension)
         (get-in value [:field :base-type]))
    (update-filter-for-field-type value)
    :else
    value))
(mu/defn ^:private value-for-tag :- ParsedParamValue
  "Given a map `tag` (a value in the `:template-tags` dictionary) return the corresponding value from the `params`
   sequence. The `value` is something that can be compiled to SQL via `->replacement-snippet-info`."
  [tag    :- mbql.s/TemplateTag
   params :- [:maybe [:sequential mbql.s/Parameter]]]
  (try
    (parse-value-for-type (:type tag) (parse-tag tag params))
    (catch Throwable e
      (throw (ex-info (tru "Error determining value for parameter {0}: {1}"
                           (pr-str (:name tag))
                           (ex-message e))
                      {:tag  tag
                       :type (or (:type (ex-data e)) qp.error-type/invalid-parameter)}
                      e)))))
(mu/defn query->params-map :- [:map-of ms/NonBlankString ParsedParamValue]
  "Extract parameters info from `query`. Return a map of parameter name -> value.
    (query->params-map some-inner-query)
    ->
    {:checkin_date #t \"2019-09-19T23:30:42.233-07:00\"}"
  [{tags :template-tags, params :parameters} :- :map]
  (log/tracef "Building params map out of tags\n%s\nand params\n%s\n" (u/pprint-to-str tags) (u/pprint-to-str params))
  (try
    (into {} (for [[k tag] tags
                   :let    [v (value-for-tag tag params)]]
               (do
                 (log/tracef "Value for tag %s\n%s\n->\n%s" (pr-str k) (u/pprint-to-str tag) (u/pprint-to-str v))
                 [k v])))
    (catch Throwable e
      (throw (ex-info (tru "Error building query parameter map: {0}" (ex-message e))
                      {:type   (or (:type (ex-data e)) qp.error-type/invalid-parameter)
                       :tags   tags
                       :params params}
                      e)))))
 
(ns metabase.driver.ddl.interface
  (:require
   [clojure.string :as str]
   [metabase.driver :as driver]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.public-settings :as public-settings]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu])
  (:import
   (java.time Instant)
   (java.time.format DateTimeFormatter)))
(set! *warn-on-reflection* true)
(mu/defn schema-name :- ::lib.schema.common/non-blank-string
  "Returns a schema name for persisting models. Needs the database to use the db id and the site-uuid to ensure that
  multiple connections from multiple metabae remain distinct. The UUID will have the first character of each section taken.
  (schema-name {:id 234} \"143dd8ce-e116-4c7f-8d6d-32e99eaefbbc\") ->  \"metabase_cache_1e483_1\
  [{:keys [id] :as _database} :- [:map [:id ::lib.schema.id/database]]
   site-uuid-string           :- ::lib.schema.common/non-blank-string]
  (let [instance-string (apply str (map first (str/split site-uuid-string #"-")))]
    (format "metabase_cache_%s_%s" instance-string id)))

Transform a lowercase string Table or Field name in a way appropriate for this dataset (e.g., h2 would want to upcase these names; mongo would want to use "_id" in place of "id". This method should return a string. Defaults to an identity implementation.

This is actually ultimately used to format any name that comes back from [[metabase.test.data.sql/qualified-name-components]] -- so if you include the Database name there, it will get formatted by this as well.

(defmulti format-name
  {:changelog-test/ignore true :added "0.44.0" :arglists '([driver table-or-field-name])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
(defmethod format-name :default [_ table-or-field-name] table-or-field-name)

Verify that the source database is acceptable to persist. Returns a tuple of a boolean and :persist.check/valid in the event it was successful or a keyword indicating the reason for failure.

Examples: - [true :persist.check/valid] - [false :persist.check/create-schema] - [false :persist.check/create-table] - [false :persist.check/read-table] - [false :persist.check/delete-table]

(defmulti check-can-persist
  {:changelog-test/ignore true :added "0.44.0" :arglists '([database])}
  (fn [database] (driver/dispatch-on-initialized-driver (:engine database)))
  :hierarchy #'driver/hierarchy)

The honeysql form that creates the persisted schema cache_info table.

(defn create-kv-table-honey-sql-form
  [schema-name]
  {:create-table [(keyword schema-name "cache_info") :if-not-exists]
   :with-columns [[:key :text] [:value :text]]})

Version 1 of the values to go in the key/value table cache_info table.

(defn kv-table-values
  []
  [{:key   "settings-version"
    :value "1"}
   {:key   "created-at"
    ;; "2023-03-29T14:01:27.871697Z"
    :value (.format DateTimeFormatter/ISO_INSTANT (Instant/now))}
   {:key   "instance-uuid"
    :value (public-settings/site-uuid)}
   {:key   "instance-name"
    :value (public-settings/site-name)}])

The honeysql form that populates the persisted schema cache_info table.

(defn populate-kv-table-honey-sql-form
  [schema-name]
  {:insert-into [(keyword schema-name "cache_info")]
   :values (kv-table-values)})

Human readable messages for different connection errors.

(defn error->message
  [error schema]
  (case error
    :persist.check/create-schema (tru "Lack permissions to create {0} schema" schema)
    :persist.check/create-table (tru "Lack permission to create table in schema {0}" schema)
    :persist.check/read-table (tru "Lack permission to read table in schema {0}" schema)
    :persist.check/delete-table (tru "Lack permission to delete table in schema {0}" schema)))

Refresh a model in a datastore. A table is created and populated in the source datastore, not the application database. Assumes that the destination schema is populated and permissions are correct. This should all be true if (driver/database-supports engine :persisted-models database) returns true. Returns a map with :state that is :success or :error. If :state is :error, includes a key :error with a string message.

(defmulti refresh!
  {:changelog-test/ignore true :added "0.44.0" :arglists '([driver database definition dataset-query])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

Unpersist a persisted model. Responsible for removing the persisted table.

(defmulti unpersist!
  {:changelog-test/ignore true :added "0.44.0" :arglists '([driver database persisted-info])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
 
(ns metabase.driver.h2
  (:require
   [clojure.math.combinatorics :as math.combo]
   [clojure.string :as str]
   [java-time.api :as t]
   [metabase.config :as config]
   [metabase.db.jdbc-protocols :as mdb.jdbc-protocols]
   [metabase.db.spec :as mdb.spec]
   [metabase.driver :as driver]
   [metabase.driver.common :as driver.common]
   [metabase.driver.h2.actions :as h2.actions]
   [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn]
   [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute]
   [metabase.driver.sql-jdbc.sync :as sql-jdbc.sync]
   [metabase.driver.sql.query-processor :as sql.qp]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.plugins.classloader :as classloader]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.store :as qp.store]
   [metabase.util :as u]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.i18n :refer [deferred-tru tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.ssh :as ssh])
  (:import
   (java.sql Clob ResultSet ResultSetMetaData)
   (java.time OffsetTime)
   (org.h2.command CommandInterface Parser)
   (org.h2.engine SessionLocal)))
(set! *warn-on-reflection* true)

method impls live in this namespace

(comment h2.actions/keep-me)
(driver/register! :h2, :parent :sql-jdbc)

Whether to allow testing new H2 connections. Normally this is disabled, which effectively means you cannot create new H2 databases from the API, but this flag is here to disable that behavior for syncing existing databases, or when needed for tests.

(def ^:dynamic *allow-testing-h2-connections*
  ;; you can disable this flag with the env var below, please do not use it under any circumstances, it is only here so
  ;; existing e2e tests will run without us having to update a million tests. We should get rid of this and rework those
  ;; e2e tests to use SQLite ASAP.
  (or (config/config-bool :mb-dangerous-unsafe-enable-testing-h2-connections-do-not-enable)
      false))

this will prevent the H2 driver from showing up in the list of options when adding a new Database.

(defmethod driver/superseded-by :h2 [_driver] :deprecated)

Returns value of private field. This function is used to bypass field protection to instantiate a low-level H2 Parser object in order to detect DDL statements in queries.

(defn- get-field
  ([obj field]
   (.get (doto (.getDeclaredField (class obj) field)
           (.setAccessible true))
         obj))
  ([obj field or-else]
   (try (get-field obj field)
        (catch java.lang.NoSuchFieldException _e
          ;; when there are no fields: return or-else
          or-else))))

+----------------------------------------------------------------------------------------------------------------+ | metabase.driver impls | +----------------------------------------------------------------------------------------------------------------+

(doseq [[feature supported?] {:full-join                 false
                              :regex                     true
                              :percentile-aggregations   false
                              :actions                   true
                              :actions/custom            true
                              :datetime-diff             true
                              :now                       true
                              :test/jvm-timezone-setting false
                              :uploads                   true
                              :index-info                true}]
  (defmethod driver/database-supports? [:h2 feature]
    [_driver _feature _database]
    supported?))
(defmethod sql.qp/->honeysql [:h2 :regex-match-first]
  [driver [_ arg pattern]]
  [:regexp_substr (sql.qp/->honeysql driver arg) (sql.qp/->honeysql driver pattern)])
(defmethod driver/connection-properties :h2
  [_]
  (->>
   [{:name         "db"
     :display-name (tru "Connection String")
     :helper-text (deferred-tru "The local path relative to where Metabase is running from. Your string should not include the .mv.db extension.")
     :placeholder  (str "file:/" (deferred-tru "Users/camsaul/bird_sightings/toucans"))
     :required     true}
    driver.common/cloud-ip-address-info
    driver.common/advanced-options-start
    driver.common/default-advanced-options]
   (map u/one-or-many)
   (apply concat)))

Checks an h2 connection string for connection properties that could be malicious. Markers of this include semi-colons which allow for sql injection in org.h2.engine.Engine/openSession. The others are markers for languages like javascript and ruby that we want to suppress.

(defn- malicious-property-value
  [s]
  ;; list of strings it looks for to compile scripts:
  ;; https://github.com/h2database/h2database/blob/master/h2/src/main/org/h2/util/SourceCompiler.java#L178-L187 we
  ;; can't use the static methods themselves since they expect to check the beginning of the string
  (let [bad-markers [";"
                     "//javascript"
                     "#ruby"
                     "//groovy"
                     "@groovy"]
        pred        (apply some-fn (map (fn [marker] (fn [s] (str/includes? s marker)))
                                        bad-markers))]
    (pred s)))
(defmethod driver/can-connect? :h2
  [driver {:keys [db] :as details}]
  (when-not *allow-testing-h2-connections*
    (throw (ex-info (tru "H2 is not supported as a data warehouse") {:status-code 400})))
  (when (string? db)
    (let [connection-str  (cond-> db
                            (not (str/includes? db "h2:")) (str/replace-first #"^" "h2:")
                            (not (str/includes? db "jdbc:")) (str/replace-first #"^" "jdbc:"))
          connection-info (org.h2.engine.ConnectionInfo. connection-str nil nil nil)
          properties      (get-field connection-info "prop")
          bad-props       (into {} (keep (fn [[k v]] (when (malicious-property-value v) [k v])))
                                properties)]
      (when (seq bad-props)
        (throw (ex-info "Malicious keys detected" {:keys (keys bad-props)})))
      ;; keys are uppercased by h2 when parsed:
      ;; https://github.com/h2database/h2database/blob/master/h2/src/main/org/h2/engine/ConnectionInfo.java#L298
      (when (contains? properties "INIT")
        (throw (ex-info "INIT not allowed" {:keys ["INIT"]})))))
  (sql-jdbc.conn/can-connect? driver details))
(defmethod driver/db-start-of-week :h2
  [_]
  :monday)

Explode a connection-string like file:my-db;OPTION=100;OPTION_2=TRUE to a pair of file and an options map.

(connection-string->file+options "file:my-crazy-db;OPTION=100;OPTION_X=TRUE") -> ["file:my-crazy-db" {"OPTION" "100", "OPTION_X" "TRUE"}]

TODO - it would be better not to put all the options in the connection string in the first place?

(defn- connection-string->file+options
  [^String connection-string]
  {:pre [(string? connection-string)]}
  (let [[file & options] (str/split connection-string #";+")
        options          (into {} (for [option options]
                                    (str/split option #"=")))]
    [file options]))
(defn- db-details->user [{:keys [db], :as details}]
  {:pre [(string? db)]}
  (or (some (partial get details) ["USER" :USER])
      (let [[_ {:strs [USER]}] (connection-string->file+options db)]
        USER)))
(defn- check-native-query-not-using-default-user [{query-type :type, :as query}]
  (u/prog1 query
    ;; For :native queries check to make sure the DB in question has a (non-default) NAME property specified in the
    ;; connection string. We don't allow SQL execution on H2 databases for the default admin account for security
    ;; reasons
    (when (= (keyword query-type) :native)
      (let [{:keys [details]} (lib.metadata/database (qp.store/metadata-provider))
            user              (db-details->user details)]
        (when (or (str/blank? user)
                  (= user "sa"))        ; "sa" is the default USER
          (throw
           (ex-info (tru "Running SQL queries against H2 databases using the default (admin) database user is forbidden.")
                    {:type qp.error-type/db})))))))

Returns an H2 Parser object for the given (H2) database ID

(defn- make-h2-parser
  ^Parser [h2-db-id]
  (with-open [conn (.getConnection (sql-jdbc.execute/datasource-with-diagnostic-info! :h2 h2-db-id))]
    ;; The H2 Parser class is created from the H2 JDBC session, but these fields are not public
    (let [session (-> conn (get-field "inner") (get-field "session"))]
      ;; Only SessionLocal represents a connection we can create a parser with. Remote sessions and other
      ;; session types are ignored.
      (when (instance? SessionLocal session)
        (Parser. session)))))
(mu/defn ^:private classify-query :- [:maybe
                                      [:map
                                       [:command-types [:vector pos-int?]]
                                       [:remaining-sql [:maybe :string]]]]
  "Takes an h2 db id, and a query, returns the command-types from `query` and any remaining sql.
   More info on command types here:
   https://github.com/h2database/h2database/blob/master/h2/src/main/org/h2/command/CommandInterface.java
  If the h2 parser cannot be built, returns `nil`.
  - Each `command-type` corresponds to a value in org.h2.command.CommandInterface, and match the commands from `query` in order.
  - `remaining-sql` is a nillable sql string that is unable to be classified without running preceding queries first.
    Usually if `remaining-sql` exists we will deny the query."
  [database query]
  (when-let [h2-parser (make-h2-parser database)]
    (try
      (let [command            (.prepareCommand h2-parser query)
            first-command-type (.getCommandType command)
            command-types      (cond-> [first-command-type]
                                 (not (instance? org.h2.command.CommandContainer command))
                                 (into
                                  (map #(.getType ^org.h2.command.Prepared %))
                                  ;; when there are no fields: return no commands
                                  (get-field command "commands" [])))]
        {:command-types command-types
         ;; when there is no remaining sql: return nil for remaining-sql
         :remaining-sql (get-field command "remaining" nil)})
      ;; only valid queries can be classified.
      (catch org.h2.message.DbException _
        {:command-types [] :remaining-sql nil}))))
(defn- every-command-allowed-for-actions? [{:keys [command-types remaining-sql]}]
  (let [cmd-type-nums command-types]
    (boolean
     ;; Command types are organized with all DDL commands listed first, so all ddl commands are before ALTER_SEQUENCE.
     ;; see https://github.com/h2database/h2database/blob/master/h2/src/main/org/h2/command/CommandInterface.java#L297
     ;; This doesn't list all the possible commands, but it lists the most common and useful ones.
     (and (every? #{CommandInterface/INSERT
                    CommandInterface/MERGE
                    CommandInterface/TRUNCATE_TABLE
                    CommandInterface/UPDATE
                    CommandInterface/DELETE
                    CommandInterface/CREATE_TABLE
                    CommandInterface/DROP_TABLE
                    CommandInterface/CREATE_SCHEMA
                    CommandInterface/DROP_SCHEMA
                    CommandInterface/ALTER_TABLE_RENAME
                    CommandInterface/ALTER_TABLE_ADD_COLUMN
                    CommandInterface/ALTER_TABLE_DROP_COLUMN
                    CommandInterface/ALTER_TABLE_ALTER_COLUMN_CHANGE_TYPE
                    CommandInterface/ALTER_TABLE_ALTER_COLUMN_NOT_NULL
                    CommandInterface/ALTER_TABLE_ALTER_COLUMN_DROP_NOT_NULL
                    CommandInterface/ALTER_TABLE_ALTER_COLUMN_RENAME
                    ;; Read-only commands might not make sense for actions, but they are allowed
                    CommandInterface/SELECT ; includes SHOW, TABLE, VALUES
                    CommandInterface/EXPLAIN
                    CommandInterface/CALL} cmd-type-nums)
          (nil? remaining-sql)))))
(defn- check-action-commands-allowed [{:keys [database] {:keys [query]} :native}]
  (when query
    (when-let [query-classification (classify-query database query)]
      (when-not (every-command-allowed-for-actions? query-classification)
        (throw (ex-info "DDL commands are not allowed to be used with H2."
                        {:classification query-classification}))))))
(defn- read-only-statements? [{:keys [command-types remaining-sql]}]
  (let [cmd-type-nums command-types]
    (boolean
     (and (every? #{CommandInterface/SELECT ; includes SHOW, TABLE, VALUES
                    CommandInterface/EXPLAIN
                    CommandInterface/CALL} cmd-type-nums)
          (nil? remaining-sql)))))
(defn- check-read-only-statements [{:keys [database] {:keys [query]} :native}]
  (when query
    (let [query-classification (classify-query database query)]
      (when-not (read-only-statements? query-classification)
        (throw (ex-info "Only SELECT statements are allowed in a native query."
                        {:classification query-classification}))))))
(defmethod driver/execute-reducible-query :h2
  [driver query chans respond]
  (check-native-query-not-using-default-user query)
  (check-read-only-statements query)
  ((get-method driver/execute-reducible-query :sql-jdbc) driver query chans respond))
(defmethod driver/execute-write-query! :h2
  [driver query]
  (check-native-query-not-using-default-user query)
  (check-action-commands-allowed query)
  ((get-method driver/execute-write-query! :sql-jdbc) driver query))
(defmethod sql.qp/add-interval-honeysql-form :h2
  [driver hsql-form amount unit]
  (cond
    (= unit :quarter)
    (recur driver hsql-form (h2x/* amount 3) :month)

    ;; H2 only supports long ints in the `dateadd` amount field; since we want to support fractional seconds (at least
    ;; for application DB purposes) convert to `:millisecond`
    (and (= unit :second)
         (not (zero? (rem amount 1))))
    (recur driver hsql-form (* amount 1000.0) :millisecond)

    :else
    [:dateadd
     (h2x/literal unit)
     (h2x/cast :long (if (number? amount)
                       (sql.qp/inline-num amount)
                       amount))
     (h2x/cast :datetime hsql-form)]))
(defmethod driver/humanize-connection-error-message :h2
  [_ message]
  (condp re-matches message
    #"^A file path that is implicitly relative to the current working directory is not allowed in the database URL .*$"
    :implicitly-relative-db-file-path

    #"^Database .* not found, .*$"
    :db-file-not-found

    #"^Wrong user name or password .*$"
    :username-or-password-incorrect

    message))
(defmethod driver/db-default-timezone :h2
  [driver database]
  (sql-jdbc.execute/do-with-connection-with-options
   driver database nil
   (fn [^java.sql.Connection conn]
     (with-open [stmt (.prepareStatement conn "select current_timestamp();")
                 rset (.executeQuery stmt)]
       (when (.next rset)
         (when-let [zoned-date-time (.getObject rset 1 java.time.ZonedDateTime)]
           (t/zone-id zoned-date-time)))))))

+----------------------------------------------------------------------------------------------------------------+ | metabase.driver.sql impls | +----------------------------------------------------------------------------------------------------------------+

(defmethod sql.qp/current-datetime-honeysql-form :h2
  [_]
  (h2x/with-database-type-info :%now :TIMESTAMP))
(defn- add-to-1970 [expr unit-str]
  [:timestampadd
   (h2x/literal unit-str)
   expr
   [:raw "timestamp '1970-01-01T00:00:00Z'"]])
(defmethod sql.qp/unix-timestamp->honeysql [:h2 :seconds] [_ _ expr]
  (add-to-1970 expr "second"))
(defmethod sql.qp/unix-timestamp->honeysql [:h2 :milliseconds] [_ _ expr]
  (add-to-1970 expr "millisecond"))
(defmethod sql.qp/unix-timestamp->honeysql [:h2 :microseconds] [_ _ expr]
  (add-to-1970 expr "microsecond"))
(defmethod sql.qp/cast-temporal-string [:h2 :Coercion/YYYYMMDDHHMMSSString->Temporal]
  [_driver _coercion-strategy expr]
  [:parsedatetime expr (h2x/literal "yyyyMMddHHmmss")])
(defmethod sql.qp/cast-temporal-byte [:h2 :Coercion/YYYYMMDDHHMMSSBytes->Temporal]
  [driver _coercion-strategy expr]
  (sql.qp/cast-temporal-string driver :Coercion/YYYYMMDDHHMMSSString->Temporal
                               [:utf8tostring expr]))

H2 v2 added date_trunc and extract, so we can borrow the Postgres implementation

(defn- date-trunc [unit expr] [:date_trunc (h2x/literal unit) expr])
(defn- extract [unit expr] [::h2x/extract unit expr])
(def ^:private extract-integer (comp h2x/->integer extract))
(defmethod sql.qp/date [:h2 :default]          [_ _ expr] expr)
(defmethod sql.qp/date [:h2 :second-of-minute] [_ _ expr] (extract-integer :second expr))
(defmethod sql.qp/date [:h2 :minute]           [_ _ expr] (date-trunc :minute expr))
(defmethod sql.qp/date [:h2 :minute-of-hour]   [_ _ expr] (extract-integer :minute expr))
(defmethod sql.qp/date [:h2 :hour]             [_ _ expr] (date-trunc :hour expr))
(defmethod sql.qp/date [:h2 :hour-of-day]      [_ _ expr] (extract-integer :hour expr))
(defmethod sql.qp/date [:h2 :day]              [_ _ expr] (h2x/->date expr))
(defmethod sql.qp/date [:h2 :day-of-month]     [_ _ expr] (extract-integer :day expr))
(defmethod sql.qp/date [:h2 :day-of-year]      [_ _ expr] (extract-integer :doy expr))
(defmethod sql.qp/date [:h2 :month]            [_ _ expr] (date-trunc :month expr))
(defmethod sql.qp/date [:h2 :month-of-year]    [_ _ expr] (extract-integer :month expr))
(defmethod sql.qp/date [:h2 :quarter]          [_ _ expr] (date-trunc :quarter expr))
(defmethod sql.qp/date [:h2 :quarter-of-year]  [_ _ expr] (extract-integer :quarter expr))
(defmethod sql.qp/date [:h2 :year]             [_ _ expr] (date-trunc :year expr))
(defmethod sql.qp/date [:h2 :year-of-era]      [_ _ expr] (extract-integer :year expr))
(defmethod sql.qp/date [:h2 :day-of-week]
  [_ _ expr]
  (sql.qp/adjust-day-of-week :h2 (extract :iso_day_of_week expr)))
(defmethod sql.qp/date [:h2 :week]
  [_ _ expr]
  (sql.qp/add-interval-honeysql-form :h2 (sql.qp/date :h2 :day expr)
                                     (h2x/- 1 (sql.qp/date :h2 :day-of-week expr))
                                     :day))
(defmethod sql.qp/date [:h2 :week-of-year-iso] [_ _ expr] (extract :iso_week expr))
(defmethod sql.qp/->honeysql [:h2 :log]
  [driver [_ field]]
  [:log10 (sql.qp/->honeysql driver field)])

Like H2's datediff function but accounts for timestamps with time zones.

(defn- datediff
  [unit x y]
  [:datediff [:raw (name unit)] (h2x/->timestamp x) (h2x/->timestamp y)])

Like H2's extract but accounts for timestamps with time zones.

(defn- time-zoned-extract
  [unit x]
  (extract unit (h2x/->timestamp x)))
(defmethod sql.qp/datetime-diff [:h2 :year]    [driver _unit x y] (h2x// (sql.qp/datetime-diff driver :month x y) 12))
(defmethod sql.qp/datetime-diff [:h2 :quarter] [driver _unit x y] (h2x// (sql.qp/datetime-diff driver :month x y) 3))
(defmethod sql.qp/datetime-diff [:h2 :month]
  [_driver _unit x y]
  (h2x/+ (datediff :month x y)
         ;; datediff counts month boundaries not whole months, so we need to adjust
         ;; if x<y but x>y in the month calendar then subtract one month
         ;; if x>y but x<y in the month calendar then add one month
         [:case
          [:and [:< x y] [:> (time-zoned-extract :day x) (time-zoned-extract :day y)]]
          -1

          [:and [:> x y] [:< (time-zoned-extract :day x) (time-zoned-extract :day y)]]
          1

          :else
          0]))
(defmethod sql.qp/datetime-diff [:h2 :week] [_driver _unit x y] (h2x// (datediff :day x y) 7))
(defmethod sql.qp/datetime-diff [:h2 :day]  [_driver _unit x y] (datediff :day x y))
(defmethod sql.qp/datetime-diff [:h2 :hour] [_driver _unit x y] (h2x// (datediff :millisecond x y) 3600000))
(defmethod sql.qp/datetime-diff [:h2 :minute] [_driver _unit x y] (datediff :minute x y))
(defmethod sql.qp/datetime-diff [:h2 :second] [_driver _unit x y] (datediff :second x y))

+----------------------------------------------------------------------------------------------------------------+ | metabase.driver.sql-jdbc impls | +----------------------------------------------------------------------------------------------------------------+

Datatype grammar adapted from BNF at https://h2database.com/html/datatypes.html

Expands BNF-like grammar to all possible data types

(defn- expand-grammar
  [grammar]
  (cond
    (set? grammar)  (mapcat expand-grammar grammar)
    (list? grammar) (map (partial str/join " ")
                         (apply math.combo/cartesian-product
                                (map expand-grammar grammar)))
    :else           [grammar]))
(def ^:private base-type->db-type-grammar
  '{:type/Boolean             #{BOOLEAN}
    :type/Integer             #{TINYINT SMALLINT INTEGER INT}
    :type/BigInteger          #{BIGINT}
    :type/Decimal             #{NUMERIC DECIMAL DEC}
    :type/Float               #{REAL FLOAT "DOUBLE PRECISION" DECFLOAT}
    :type/Text                #{CHARACTER
                                CHAR
                                (NATIONAL #{CHARACTER CHAR})
                                NCHAR
                                (#{CHARACTER CHAR} VARYING)
                                VARCHAR
                                (#{(NATIONAL #{CHARACTER CHAR}) NCHAR} VARYING)
                                VARCHAR_CASESENSITIVE
                                (#{CHARACTER CHAR} LARGE OBJECT)
                                CLOB
                                (#{NATIONAL CHARACTER NCHAR} LARGE OBJECT)
                                NCLOB
                                UUID}
    :type/*                   #{ARRAY
                                BINARY
                                "BINARY VARYING"
                                VARBINARY
                                "BINARY LARGE OBJECT"
                                BLOB
                                GEOMETRY
                                IMAGE}
    :type/Date                #{DATE}
    :type/DateTime            #{TIMESTAMP}
    :type/Time                #{TIME "TIME WITHOUT TIME ZONE"}
    :type/TimeWithLocalTZ     #{"TIME WITH TIME ZONE"}
    :type/DateTimeWithLocalTZ #{"TIMESTAMP WITH TIME ZONE"}})
(def ^:private db-type->base-type
  (into {}
        (for [[base-type grammar] base-type->db-type-grammar
              db-type (expand-grammar grammar)]
          [(keyword db-type) base-type])))
(defmethod sql-jdbc.sync/database-type->base-type :h2
  [_ database-type]
  (db-type->base-type database-type))

These functions for exploding / imploding the options in the connection strings are here so we can override shady options users might try to put in their connection string, like INIT=...

Implode the results of connection-string->file+options back into a connection string.

(defn- file+options->connection-string
  [file options]
  (apply str file (for [[k v] options]
                    (str ";" k "=" v))))

Add Metabase Security Settings™ to this connection-string (i.e. try to keep shady users from writing nasty SQL).

(defn- connection-string-set-safe-options
  [connection-string]
  {:pre [(string? connection-string)]}
  (let [[file options] (connection-string->file+options connection-string)]
    (file+options->connection-string file (merge
                                           (->> options
                                                ;; Remove INIT=... from options for security reasons (Metaboat #165)
                                                ;; http://h2database.com/html/features.html#execute_sql_on_connection
                                                (remove (fn [[k _]] (= (u/lower-case-en k) "init")))
                                                (into {}))
                                           {"IFEXISTS" "TRUE"}))))
(defmethod sql-jdbc.conn/connection-details->spec :h2
  [_ details]
  {:pre [(map? details)]}
  (mdb.spec/spec :h2 (cond-> details
                       (string? (:db details)) (update :db connection-string-set-safe-options))))
(defmethod sql-jdbc.sync/active-tables :h2
  [& args]
  (apply sql-jdbc.sync/post-filtered-active-tables args))
(defmethod sql-jdbc.sync/excluded-schemas :h2
  [_]
  #{"INFORMATION_SCHEMA"})
(defmethod sql-jdbc.execute/do-with-connection-with-options :h2
  [driver db-or-id-or-spec {:keys [write?], :as options} f]
  ;; h2 doesn't support setting timezones, or changing the transaction level without admin perms, so we can skip those
  ;; steps that are in the default impl
  (sql-jdbc.execute/do-with-resolved-connection
   driver
   db-or-id-or-spec
   (dissoc options :session-timezone)
   (fn [^java.sql.Connection conn]
     (when-not (sql-jdbc.execute/recursive-connection?)
       ;; in H2, setting readOnly to true doesn't prevent writes
       ;; see https://github.com/h2database/h2database/issues/1163
       (.setReadOnly conn (not write?)))
     (f conn))))

de-CLOB any CLOB values that come back

(defmethod sql-jdbc.execute/read-column-thunk :h2
  [_ ^ResultSet rs ^ResultSetMetaData rsmeta ^Integer i]
  (let [classname (some-> (.getColumnClassName rsmeta i)
                          (Class/forName true (classloader/the-classloader)))]
    (if (isa? classname Clob)
      (fn []
        (mdb.jdbc-protocols/clob->str (.getObject rs i)))
      (fn []
        (.getObject rs i)))))
(defmethod sql-jdbc.execute/set-parameter [:h2 OffsetTime]
  [driver prepared-statement i t]
  (let [local-time (t/local-time (t/with-offset-same-instant t (t/zone-offset 0)))]
    (sql-jdbc.execute/set-parameter driver prepared-statement i local-time)))
(defmethod driver/incorporate-ssh-tunnel-details :h2
  [_ db-details]
  (if (and (:tunnel-enabled db-details) (ssh/ssh-tunnel-open? db-details))
    (if (and (:db db-details) (str/starts-with? (:db db-details) "tcp://"))
      (let [details (ssh/include-ssh-tunnel! db-details)
            db      (:db details)]
        (assoc details :db (str/replace-first db (str (:orig-port details)) (str (:tunnel-entrance-port details)))))
      (do (log/error (tru "SSH tunnel can only be established for H2 connections using the TCP protocol"))
          db-details))
    db-details))
(defmethod driver/upload-type->database-type :h2
  [_driver upload-type]
  (case upload-type
    :metabase.upload/varchar-255              [:varchar]
    :metabase.upload/text                     [:varchar]
    :metabase.upload/int                      [:bigint]
    :metabase.upload/auto-incrementing-int-pk [:bigint :generated-always :as :identity :primary-key]
    :metabase.upload/float                    [(keyword "DOUBLE PRECISION")]
    :metabase.upload/boolean                  [:boolean]
    :metabase.upload/date                     [:date]
    :metabase.upload/datetime                 [:timestamp]
    :metabase.upload/offset-datetime          [:timestamp-with-time-zone]))
(defmethod driver/table-name-length-limit :h2
  [_driver]
  ;; http://www.h2database.com/html/advanced.html#limits_limitations
  256)
 

Method impls for [[metabase.driver.sql-jdbc.actions]] for :h2.

(ns metabase.driver.h2.actions
  (:require
   [clojure.java.jdbc :as jdbc]
   [clojure.string :as str]
   [metabase.actions.error :as actions.error]
   [metabase.driver.sql-jdbc.actions :as sql-jdbc.actions]
   [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru deferred-trun]]
   [metabase.util.log :as log]))
(defmethod sql-jdbc.actions/base-type->sql-type-map :h2
  [_driver]
  {:type/BigInteger     "BIGINT"
   :type/Boolean        "BOOL"
   :type/Date           "DATE"
   :type/DateTime       "DATETIME"
   :type/DateTimeWithTZ "TIMESTAMP WITH TIME ZONE"
   :type/Decimal        "DECIMAL"
   :type/Float          "FLOAT"
   :type/Integer        "INTEGER"
   :type/Text           "VARCHAR"
   :type/Time           "TIME"})

H2 doesn't need to do anything special with nested transactions; the original transaction can proceed even if some specific statement errored.

(defmethod sql-jdbc.actions/do-nested-transaction :h2
  [_driver _conn thunk]
  (thunk))

Get the name of identifier from JDBC error message. An identifier can contains quote and full schema, database, table , etc. This formats so that we get only the identifer name with quote removed.

(db-identifier->name "PUBLIC.TABLE" ) => "TABLE"

(defn- db-identifier->name
  [s]
  (-> s
      (str/replace #"\"" "")
      (str/split #"\.")
      last))

Given a constraint with constraint-name fetch the column names associated with that constraint.

(defn- constraint->column-names
  [database table-name constraint-name]
  (let [jdbc-spec (sql-jdbc.conn/db->pooled-connection-spec (u/the-id database))
        sql-args  ["SELECT C.TABLE_CATALOG, C.TABLE_SCHEMA, K.COLUMN_NAME
                   FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS C
                   JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE K ON C.CONSTRAINT_NAME = K.CONSTRAINT_NAME
                   WHERE C.INDEX_NAME = ? AND C.TABLE_NAME = ?"
                   constraint-name table-name]]
    (first
     (reduce
      (fn [[columns catalog schema] {:keys [table_catalog table_schema column_name]}]
        (if (and (or (nil? catalog) (= table_catalog catalog))
                 (or (nil? schema) (= table_schema schema)))
          [(conj columns column_name) table_catalog table_schema]
          (do (log/warnf "Ambiguous catalog/schema for constraint %s in table %s"
                         constraint-name table-name)
              (reduced nil))))
      [[] nil nil]
      (jdbc/reducible-query jdbc-spec sql-args {:identifers identity, :transaction? false})))))
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:h2 actions.error/violate-not-null-constraint]
  [_driver error-type _database _action-type error-message]
  (when-let [[_ column]
             (re-find #"NULL not allowed for column \"([^\"]+)\"" error-message)]
    {:type    error-type
     :message (tru "{0} must have values." (str/capitalize column))
     :errors  {column (tru "You must provide a value.")}}))
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:h2 actions.error/violate-unique-constraint]
  [_driver error-type database _action-type error-message]
  (when-let [[_match constraint-name table]
             (re-find #"Unique index or primary key violation: \"[^.]+.(.+?) ON [^.]+.\"\"(.+?)\"\"" error-message)]
    (let [columns (constraint->column-names database table constraint-name)]
      {:type    error-type
       :message (tru "{0} already {1}." (u/build-sentence (map str/capitalize columns) :stop? false) (deferred-trun "exists" "exist" (count columns)))
       :errors  (reduce (fn [acc col]
                          (assoc acc col (tru "This {0} value already exists." (str/capitalize col))))
                        {}
                        columns)})))
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:h2 actions.error/violate-foreign-key-constraint]
  [_driver error-type _database action-type error-message]
  (when-let [[_match column]
             (re-find #"Referential integrity constraint violation: \"[^\:]+: [^\s]+ FOREIGN KEY\(([^\s]+)\)" error-message)]
    (let  [column (db-identifier->name column)]
     (merge {:type error-type}
            (case action-type
              :row/create
              {:message (tru "Unable to create a new record.")
               :errors {column (tru "This {0} does not exist." (str/capitalize column))}}

              :row/delete
              {:message (tru "Other tables rely on this row so it cannot be deleted.")
               :errors  {}}

              :row/update
              {:message (tru "Unable to update the record.")
               :errors  {column (tru "This {0} does not exist." (str/capitalize column))}})))))
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:h2 actions.error/incorrect-value-type]
  [_driver error-type _database _action-type error-message]
  (when-let [[_ _expected-type _value]
             (re-find #"Data conversion error converting .*" error-message)]
    {:type    error-type
     :message (tru "Some of your values aren’t of the correct type for the database.")
     :errors  {}}))
 

Internal implementation functions for [[metabase.driver]]. These functions live in a separate namespace to reduce the clutter in [[metabase.driver]] itself.

(ns metabase.driver.impl
  (:require
   [metabase.lib.util :as lib.util]
   [metabase.plugins.classloader :as classloader]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [schema.core :as s])
  (:import
   (java.util.concurrent.locks ReentrantReadWriteLock)))
(set! *warn-on-reflection* true)

--------------------------------------------------- Hierarchy ----------------------------------------------------

Driver hierarchy. Used by driver multimethods for dispatch. Add new drivers with register!.

(defonce 
  hierarchy
  (make-hierarchy))

To find out whether a driver has been registered, we need to wait until any current driver-loading operations have finished. Otherwise we can get a "false positive" -- see #13114.

To see whether a driver is registered, we only need to obtain a read lock -- multiple threads can have these at once, and they only block if a write lock is held or if a thread is waiting for one (see dox for [[ReentrantReadWriteLock]] for more details.)

If we're currently in the process of loading a driver namespace, obtain the write lock which will prevent other threads from obtaining read locks until it finishes.

(defonce  ^:private ^ReentrantReadWriteLock load-driver-lock
  (ReentrantReadWriteLock.))
(defmacro ^:private with-load-driver-read-lock [& body]
  `(try
     (.. load-driver-lock readLock lock)
     ~@body
     (finally
       (.. load-driver-lock readLock unlock))))
(defmacro ^:private with-load-driver-write-lock [& body]
  `(try
     (.. load-driver-lock writeLock lock)
     ~@body
     (finally
       (.. load-driver-lock writeLock unlock))))

Is driver a valid registered driver?

(defn registered?
  [driver]
  (with-load-driver-read-lock
    (isa? hierarchy (keyword driver) :metabase.driver/driver)))

Is driver registered, and non-abstract?

(defn concrete?
  [driver]
  (isa? hierarchy (keyword driver) ::concrete))

Is driver an abstract "base class"? i.e. a driver that you cannot use directly when adding a Database, such as :sql or :sql-jdbc.

(defn abstract?
  [driver]
  (not (concrete? driver)))

-------------------------------------------- Loading Driver Namespace --------------------------------------------

(s/defn ^:private driver->expected-namespace [driver :- s/Keyword]
  (symbol
   (or (namespace driver)
       (str "metabase.driver." (name driver)))))

require a driver's 'expected' namespace.

(defn- require-driver-ns
  [driver & require-options]
  (let [expected-ns (driver->expected-namespace driver)]
    (log/debug
     (trs "Loading driver {0} {1}" (u/format-color 'blue driver) (apply list 'require expected-ns require-options)))
    (try
      (apply classloader/require expected-ns require-options)
      (catch Throwable e
        (log/error e (tru "Error loading driver namespace"))
        (throw (Exception. (tru "Could not load {0} driver." driver) e))))))

Load the expected namespace for a driver if it has not already been registed. This only works for core Metabase drivers, whose namespaces follow an expected pattern; drivers provided by 3rd-party plugins are expected to register themselves in their plugin initialization code.

You should almost never need to do this directly; it is handled automatically when dispatching on a driver and by register! below (for parent drivers) and by driver.u/database->driver for drivers that have not yet been loaded.

(defn load-driver-namespace-if-needed!
  [driver]
  (when-not *compile-files*
    (when-not (registered? driver)
      (with-load-driver-write-lock
        ;; driver may have become registered while we were waiting for the lock, check again to be sure
        (when-not (registered? driver)
          (u/profile (trs "Load driver {0}" driver)
            (require-driver-ns driver)
            ;; ok, hopefully it was registered now. If not, try again, but reload the entire driver namespace
            (when-not (registered? driver)
              (require-driver-ns driver :reload)
              ;; if *still* not registered, throw an Exception
              (when-not (registered? driver)
                (throw (Exception. (tru "Driver not registered after loading: {0}" driver)))))))))))

-------------------------------------------------- Registration --------------------------------------------------

Check to make sure we're not trying to change the abstractness of an already registered driver

(defn check-abstractness-hasnt-changed
  [driver new-abstract?]
  (when (registered? driver)
    (let [old-abstract? (boolean (abstract? driver))
          new-abstract? (boolean new-abstract?)]
      (when (not= old-abstract? new-abstract?)
        (throw (Exception. (tru "Error: attempting to change {0} property `:abstract?` from {1} to {2}."
                                driver old-abstract? new-abstract?)))))))

Register a driver.

(register! :sql, :abstract? true)

(register! :postgres, :parent :sql-jdbc)

Valid options are:

`:parent` (default = none)

Parent driver(s) to derive from. Drivers inherit method implementations from their parents similar to the way inheritance works in OOP. Specify multiple direct parents by passing a collection of parents.

You can add additional parents to a driver using [[metabase.driver/add-parent!]]; this is how test extensions are implemented.

`:abstract?` (default = false)

Is this an abstract driver (i.e. should we hide it in the admin interface, and disallow running queries with it)?

Note that because concreteness is implemented as part of our keyword hierarchy it is not currently possible to create an abstract driver with a concrete driver as its parent, since it would still ultimately derive from ::concrete.

(defn register!
  [driver & {:keys [parent abstract?]}]
  {:pre [(keyword? driver)]}
  ;; no-op during compilation.
  (when-not *compile-files*
    (let [parents (filter some? (u/one-or-many parent))]
      ;; load parents as needed; if this is an abstract driver make sure parents aren't concrete
      (doseq [parent parents]
        (load-driver-namespace-if-needed! parent))
      (when abstract?
        (doseq [parent parents
                :when  (concrete? parent)]
          (throw (ex-info (trs "Abstract drivers cannot derive from concrete parent drivers.")
                   {:driver driver, :parent parent}))))
      ;; validate that the registration isn't stomping on things
      (check-abstractness-hasnt-changed driver abstract?)
      ;; ok, if that was successful we can derive the driver from `:metabase.driver/driver`/`::concrete` and parent(s)
      (let [derive! (partial alter-var-root #'hierarchy derive driver)]
        (derive! :metabase.driver/driver)
        (when-not abstract?
          (derive! ::concrete))
        (doseq [parent parents]
          (derive! parent)))
      ;; ok, log our great success
      (log/info
       (u/format-color 'blue
           (if (metabase.driver.impl/abstract? driver)
             (trs "Registered abstract driver {0}" driver)
             (trs "Registered driver {0}" driver)))
       (if (seq parents)
         (trs "(parents: {0})" (vec parents))
         "")
       (u/emoji "🚚")))))

------------------------------------------------- Initialization -------------------------------------------------

We'll keep track of which drivers are initialized using a set rather than adding a special key to the hierarchy or something like that -- we don't want child drivers to inherit initialized status from their ancestors

(defonce ^:private initialized-drivers
  ;; For the purposes of this exercise the special keywords used in the hierarchy should always be assumed to be
  ;; initialized so we don't try to call initialize on them, which of course would try to load their namespaces when
  ;; dispatching off `the-driver`; that would fail, so don't try it
  (atom #{:metabase.driver/driver ::concrete}))

Has driver been initialized? (See [[metabase.driver/initialize!]] for a discussion of what exactly this means.)

(defn initialized?
  [driver]
  (@initialized-drivers driver))
(defonce ^:private initialization-lock (Object.))

Initialize a driver by calling executing (init-fn driver) if it hasn't yet been initialized. Refer to documentation for [[metabase.driver/initialize!]] for a full explanation of what this means.

(defn initialize-if-needed!
  [driver init-fn]
  ;; no-op during compilation
  (when-not *compile-files*
    ;; first, initialize parents as needed
    (doseq [parent (parents hierarchy driver)]
      (initialize-if-needed! parent init-fn))
    (when-not (initialized? driver)
      ;; if the driver is not yet initialized, acquire an exclusive lock for THIS THREAD to perform initialization to
      ;; make sure no other thread tries to initialize it at the same time
      (locking initialization-lock
        ;; and once we acquire the lock, check one more time to make sure the driver didn't get initialized by
        ;; whatever thread(s) we were waiting on.
        (when-not (initialized? driver)
          (log/info (u/format-color 'yellow (trs "Initializing driver {0}..." driver)))
          (log/debug (trs "Reason:") (u/pprint-to-str 'blue (drop 5 (u/filtered-stacktrace (Thread/currentThread)))))
          (init-fn driver)
          (swap! initialized-drivers conj driver))))))

----------------------------------------------- [[truncate-alias]] -----------------------------------------------

Default length to truncate column and table identifiers to for the default implementation of [[metabase.driver/escape-alias]].

(def default-alias-max-length-bytes
  ;; Postgres' limit is 63 bytes -- see
  ;; https://www.postgresql.org/docs/current/sql-syntax-lexical.html#SQL-SYNTAX-IDENTIFIERS so we'll limit the
  ;; identifiers we generate to 60 bytes so we have room to add `_2` and stuff without drama
  60)

Truncate string s if it is longer than max-length-bytes (default [[default-alias-max-length-bytes]]) and append a hex-encoded CRC-32 checksum of the original string. Truncated string is truncated to max-length-bytes minus [[truncated-alias-hash-suffix-length]] characters so the resulting string is exactly max-length-bytes. The goal here is that two really long strings that only differ at the end will still have different resulting values.

(truncate-alias "somereallylongstring" 15) ; -> "somer_8e0f9bc2" (truncate-alias "somereallylongstring2" 15) ; -> "somer2a3c73eb"

(defn truncate-alias
  (^String [s]
   (truncate-alias s default-alias-max-length-bytes))
  (^String [^String s max-length-bytes]
   (lib.util/truncate-alias s max-length-bytes)))
 

MySQL driver. Builds off of the SQL-JDBC driver.

(ns metabase.driver.mysql
  (:require
   [clojure.java.io :as jio]
   [clojure.java.jdbc :as jdbc]
   [clojure.set :as set]
   [clojure.string :as str]
   [clojure.walk :as walk]
   [honey.sql :as sql]
   [java-time.api :as t]
   [medley.core :as m]
   [metabase.config :as config]
   [metabase.db.spec :as mdb.spec]
   [metabase.driver :as driver]
   [metabase.driver.common :as driver.common]
   [metabase.driver.mysql.actions :as mysql.actions]
   [metabase.driver.mysql.ddl :as mysql.ddl]
   [metabase.driver.sql-jdbc.common :as sql-jdbc.common]
   [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn]
   [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute]
   [metabase.driver.sql-jdbc.sync :as sql-jdbc.sync]
   [metabase.driver.sql.query-processor :as sql.qp]
   [metabase.driver.sql.query-processor.util :as sql.qp.u]
   [metabase.driver.sql.util :as sql.u]
   [metabase.driver.sql.util.unprepare :as unprepare]
   [metabase.lib.field :as lib.field]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.query-processor.store :as qp.store]
   [metabase.query-processor.timezone :as qp.timezone]
   [metabase.query-processor.util.add-alias-info :as add]
   [metabase.upload :as upload]
   [metabase.util :as u]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.i18n :refer [deferred-tru trs]]
   [metabase.util.log :as log])
  (:import
   (java.io File)
   (java.sql DatabaseMetaData ResultSet ResultSetMetaData Types)
   (java.time LocalDateTime OffsetDateTime OffsetTime ZonedDateTime ZoneOffset)
   (java.time.format DateTimeFormatter)))
(set! *warn-on-reflection* true)
(comment
  ;; method impls live in these namespaces.
  mysql.actions/keep-me
  mysql.ddl/keep-me)
(driver/register! :mysql, :parent :sql-jdbc)
(def ^:private ^:const min-supported-mysql-version 5.7)
(def ^:private ^:const min-supported-mariadb-version 10.2)
(defmethod driver/display-name :mysql [_] "MySQL")
(doseq [[feature supported?] {:persist-models                         true
                              :convert-timezone                       true
                              :datetime-diff                          true
                              :now                                    true
                              :regex                                  false
                              :percentile-aggregations                false
                              :full-join                              false
                              :uploads                                true
                              :schemas                                false
                              ;; MySQL LIKE clauses are case-sensitive or not based on whether the collation of the server and the columns
                              ;; themselves. Since this isn't something we can really change in the query itself don't present the option to the
                              ;; users in the UI
                              :case-sensitivity-string-filter-options false
                              :index-info                             true}]
  (defmethod driver/database-supports? [:mysql feature] [_driver _feature _db] supported?))

This is a bit of a lie since the JSON type was introduced for MySQL since 5.7.8. And MariaDB doesn't have the JSON type at all, though JSON was introduced as an alias for LONGTEXT in 10.2.7. But since JSON unfolding will only apply columns with JSON types, this won't cause any problems during sync.

(defmethod driver/database-supports? [:mysql :nested-field-columns] [_driver _feat db]
  (driver.common/json-unfolding-default db))
(doseq [feature [:actions :actions/custom]]
  (defmethod driver/database-supports? [:mysql feature]
    [driver _feat _db]
    ;; Only supported for MySQL right now. Revise when a child driver is added.
    (= driver :mysql)))

Returns true if the database is MariaDB. Assumes the database has been synced so :dbms_version is present.

(defn mariadb?
  [database]
  (-> database :dbms_version :flavor (= "MariaDB")))
(defmethod driver/database-supports? [:mysql :table-privileges]
  [driver _feat db]
  (and (= driver :mysql) (not (mariadb? db))))

+----------------------------------------------------------------------------------------------------------------+ | metabase.driver impls | +----------------------------------------------------------------------------------------------------------------+

(defn- db-version [^DatabaseMetaData metadata]
  (Double/parseDouble
   (format "%d.%d" (.getDatabaseMajorVersion metadata) (.getDatabaseMinorVersion metadata))))
(defn- unsupported-version? [^DatabaseMetaData metadata]
  (let [mariadb? (= (.getDatabaseProductName metadata) "MariaDB")]
    (< (db-version metadata)
       (if mariadb?
         min-supported-mariadb-version
         min-supported-mysql-version))))
(defn- warn-on-unsupported-versions [driver details]
  (sql-jdbc.conn/with-connection-spec-for-testing-connection [jdbc-spec [driver details]]
    (sql-jdbc.execute/do-with-connection-with-options
     driver
     jdbc-spec
     nil
     (fn [^java.sql.Connection conn]
       (when (unsupported-version? (.getMetaData conn))
         (log/warn
          (u/format-color 'red
                          (str
                           "\n\n********************************************************************************\n"
                           (trs "WARNING: Metabase only officially supports MySQL {0}/MariaDB {1} and above."
                                min-supported-mysql-version
                                min-supported-mariadb-version)
                           "\n"
                           (trs "All Metabase features may not work properly when using an unsupported version.")
                           "\n********************************************************************************\n"))))))))
(defmethod driver/can-connect? :mysql
  [driver details]
  ;; delegate to parent method to check whether we can connect; if so, check if it's an unsupported version and issue
  ;; a warning if it is
  (when ((get-method driver/can-connect? :sql-jdbc) driver details)
    (warn-on-unsupported-versions driver details)
    true))

Server SSL certificate chain, in PEM format.

(def default-ssl-cert-details
  {:name         "ssl-cert"
   :display-name (deferred-tru "Server SSL certificate chain")
   :placeholder  ""
   :visible-if   {"ssl" true}})
(defmethod driver/connection-properties :mysql
  [_]
  (->>
   [driver.common/default-host-details
    (assoc driver.common/default-port-details :placeholder 3306)
    driver.common/default-dbname-details
    driver.common/default-user-details
    driver.common/default-password-details
    driver.common/cloud-ip-address-info
    driver.common/default-ssl-details
    default-ssl-cert-details
    driver.common/ssh-tunnel-preferences
    driver.common/advanced-options-start
    driver.common/json-unfolding
    (assoc driver.common/additional-options
           :placeholder  "tinyInt1isBit=false")
    driver.common/default-advanced-options]
   (map u/one-or-many)
   (apply concat)))
(defmethod sql.qp/add-interval-honeysql-form :mysql
  [driver hsql-form amount unit]
  ;; MySQL doesn't support `:millisecond` as an option, but does support fractional seconds
  (if (= unit :millisecond)
    (recur driver hsql-form (/ amount 1000.0) :second)
    [:date_add hsql-form [:raw (format "INTERVAL %s %s" amount (name unit))]]))

now() returns current timestamp in seconds resolution; now(6) returns it in nanosecond resolution

(defmethod sql.qp/current-datetime-honeysql-form :mysql
  [_]
  (h2x/with-database-type-info [:now [:inline 6]] "timestamp"))
(defmethod driver/humanize-connection-error-message :mysql
  [_ message]
  (condp re-matches message
    #"^Communications link failure\s+The last packet sent successfully to the server was 0 milliseconds ago. The driver has not received any packets from the server.$"
    :cannot-connect-check-host-and-port

    #"^Unknown database .*$"
    :database-name-incorrect

    #"Access denied for user.*$"
    :username-or-password-incorrect

    #"Must specify port after ':' in connection string"
    :invalid-hostname

    ;; else
    message))
#_{:clj-kondo/ignore [:deprecated-var]}
(defmethod sql-jdbc.sync/db-default-timezone :mysql
  [_ spec]
  (let [sql                                    (str "SELECT @@GLOBAL.time_zone AS global_tz,"
                                                    " @@system_time_zone AS system_tz,"
                                                    " time_format("
                                                    "   timediff("
                                                    "      now(), convert_tz(now(), @@GLOBAL.time_zone, '+00:00')"
                                                    "   ),"
                                                    "   '%H:%i'"
                                                    " ) AS 'offset';")
        [{:keys [global_tz system_tz offset]}] (jdbc/query spec sql)
        the-valid-id                           (fn [zone-id]
                                                 (when zone-id
                                                   (try
                                                     (.getId (t/zone-id zone-id))
                                                     (catch Throwable _))))]
    (or
     ;; if global timezone ID is 'SYSTEM', then try to use the system timezone ID
     (when (= global_tz "SYSTEM")
       (the-valid-id system_tz))
     ;; otherwise try to use the global ID
     (the-valid-id global_tz)
     ;; failing that, calculate the offset between now in the global timezone and now in UTC. Non-negative offsets
     ;; don't come back with `+` so add that if needed
     (if (str/starts-with? offset "-")
       offset
       (str \+ offset)))))
(defmethod driver/db-start-of-week :mysql
  [_]
  :sunday)

+----------------------------------------------------------------------------------------------------------------+ | metabase.driver.sql impls | +----------------------------------------------------------------------------------------------------------------+

(defmethod sql.qp/unix-timestamp->honeysql [:mysql :seconds] [_ _ expr]
  [:from_unixtime expr])
(defmethod sql.qp/cast-temporal-string [:mysql :Coercion/ISO8601->DateTime]
  [_driver _coercion-strategy expr]
  (h2x/->datetime expr))
(defmethod sql.qp/cast-temporal-string [:mysql :Coercion/YYYYMMDDHHMMSSString->Temporal]
  [_driver _coercion-strategy expr]
  [:convert expr [:raw "DATETIME"]])
(defmethod sql.qp/cast-temporal-byte [:mysql :Coercion/YYYYMMDDHHMMSSBytes->Temporal]
  [driver _coercion-strategy expr]
  (sql.qp/cast-temporal-string driver :Coercion/YYYYMMDDHHMMSSString->Temporal expr))
(defn- date-format [format-str expr]
  [:date_format expr (h2x/literal format-str)])

From the dox:

STRTODATE() returns a DATETIME value if the format string contains both date and time parts, or a DATE or TIME value if the string contains only date or time parts.

See https://dev.mysql.com/doc/refman/8.0/en/date-and-time-functions.html#function_date-format for a list of format specifiers.

(defn- str-to-date
  [format-str expr]
  (let [contains-date-parts? (some #(str/includes? format-str %)
                                   ["%a" "%b" "%c" "%D" "%d" "%e" "%j" "%M" "%m" "%U"
                                    "%u" "%V" "%v" "%W" "%w" "%X" "%x" "%Y" "%y"])
        contains-time-parts? (some #(str/includes? format-str %)
                                   ["%f" "%H" "%h" "%I" "%i" "%k" "%l" "%p" "%r" "%S" "%s" "%T"])
        database-type        (cond
                               (and contains-date-parts? (not contains-time-parts?)) "date"
                               (and contains-time-parts? (not contains-date-parts?)) "time"
                               :else                                                 "datetime")]
    (-> [:str_to_date expr (h2x/literal format-str)]
        (h2x/with-database-type-info database-type))))
(defmethod sql.qp/->float :mysql
  [_ value]
  ;; no-op as MySQL doesn't support cast to float
  value)
(defmethod sql.qp/->integer :mysql
  [_ value]
  (h2x/maybe-cast :signed value))
(defmethod sql.qp/->honeysql [:mysql :regex-match-first]
  [driver [_ arg pattern]]
  [:regexp_substr (sql.qp/->honeysql driver arg) (sql.qp/->honeysql driver pattern)])
(defmethod sql.qp/->honeysql [:mysql :length]
  [driver [_ arg]]
  [:char_length (sql.qp/->honeysql driver arg)])

MySQL supports the ordinary SQL standard database type names for actual type stuff but not for coercions, sometimes. If it doesn't support the ordinary SQL standard type, then we coerce it to a different type that MySQL does support here

(def ^:private database-type->mysql-cast-type-name
  {"integer"          "signed"
   "text"             "char"
   "double precision" "double"
   "bigint"           "unsigned"})
(defmethod sql.qp/json-query :mysql
  [_driver unwrapped-identifier stored-field]
  {:pre [(h2x/identifier? unwrapped-identifier)]}
  (letfn [(handle-name [x] (str "\"" (if (number? x) (str x) (name x)) "\""))]
    (let [field-type            (:database-type stored-field)
          field-type            (get database-type->mysql-cast-type-name field-type field-type)
          nfc-path              (:nfc-path stored-field)
          parent-identifier     (sql.qp.u/nfc-field->parent-identifier unwrapped-identifier stored-field)
          jsonpath-query        (format "$.%s" (str/join "." (map handle-name (rest nfc-path))))
          json-extract+jsonpath [:json_extract parent-identifier jsonpath-query]]
      (case (u/lower-case-en field-type)
        ;; If we see JSON datetimes we expect them to be in ISO8601. However, MySQL expects them as something different.
        ;; We explicitly tell MySQL to go and accept ISO8601, because that is JSON datetimes, although there is no real standard for JSON, ISO8601 is the de facto standard.
        "timestamp" [:convert
                     [:str_to_date json-extract+jsonpath "\"%Y-%m-%dT%T.%fZ\""]
                     [:raw "DATETIME"]]

        "boolean" json-extract+jsonpath

        ;; in older versions of MySQL you can't do `convert(<string>, double)` or `cast(<string> AS double)` which is
        ;; equivalent; instead you can do `<string> + 0.0` =(
        ("float" "double") [:+ json-extract+jsonpath [:inline 0.0]]

        [:convert json-extract+jsonpath [:raw (u/upper-case-en field-type)]]))))
(defmethod sql.qp/->honeysql [:mysql :field]
  [driver [_ id-or-name opts :as mbql-clause]]
  (let [stored-field  (when (integer? id-or-name)
                        (lib.metadata/field (qp.store/metadata-provider) id-or-name))
        parent-method (get-method sql.qp/->honeysql [:sql :field])
        honeysql-expr (parent-method driver mbql-clause)]
    (cond
      (not (lib.field/json-field? stored-field))
      honeysql-expr

      (::sql.qp/forced-alias opts)
      (keyword (::add/source-alias opts))

      :else
      (walk/postwalk #(if (h2x/identifier? %)
                        (sql.qp/json-query :mysql % stored-field)
                        %)
                     honeysql-expr))))

Since MySQL doesn't have date_trunc() we fake it by formatting a date to an appropriate string and then converting back to a date. See http://dev.mysql.com/doc/refman/5.6/en/date-and-time-functions.html#function_date-format for an explanation of format specifiers this will generate a SQL statement casting the TIME to a DATETIME so date_format doesn't fail: date_format(CAST(mytime AS DATETIME), '%Y-%m-%d %H') AS mytime

(defn- trunc-with-format [format-str expr]
  (str-to-date format-str (date-format format-str (h2x/->datetime expr))))
(defn- ->date [expr]
  (if (h2x/is-of-type? expr "date")
    expr
    (-> [:date expr]
        (h2x/with-database-type-info "date"))))

Create and return a date based on a year and a number of days value.

(defn make-date
  [year-expr number-of-days]
  (-> [:makedate year-expr (sql.qp/inline-num number-of-days)]
      (h2x/with-database-type-info "date")))
(defmethod sql.qp/date [:mysql :minute]
  [_driver _unit expr]
  (let [format-str (if (= (h2x/database-type expr) "time")
                     "%H:%i"
                     "%Y-%m-%d %H:%i")]
    (trunc-with-format format-str expr)))
(defmethod sql.qp/date [:mysql :hour]
  [_driver _unit expr]
  (let [format-str (if (= (h2x/database-type expr) "time")
                     "%H"
                     "%Y-%m-%d %H")]
    (trunc-with-format format-str expr)))
(defmethod sql.qp/date [:mysql :default]         [_ _ expr] expr)
(defmethod sql.qp/date [:mysql :minute-of-hour]  [_ _ expr] (h2x/minute expr))
(defmethod sql.qp/date [:mysql :hour-of-day]     [_ _ expr] (h2x/hour expr))
(defmethod sql.qp/date [:mysql :day]             [_ _ expr] (->date expr))
(defmethod sql.qp/date [:mysql :day-of-month]    [_ _ expr] [:dayofmonth expr])
(defmethod sql.qp/date [:mysql :day-of-year]     [_ _ expr] [:dayofyear expr])
(defmethod sql.qp/date [:mysql :month-of-year]   [_ _ expr] (h2x/month expr))
(defmethod sql.qp/date [:mysql :quarter-of-year] [_ _ expr] (h2x/quarter expr))
(defmethod sql.qp/date [:mysql :year]            [_ _ expr] (make-date (h2x/year expr) 1))
(defmethod sql.qp/date [:mysql :day-of-week]
  [driver _unit expr]
  (sql.qp/adjust-day-of-week driver [:dayofweek expr]))

To convert a YEARWEEK (e.g. 201530) back to a date you need tell MySQL which day of the week to use, because otherwise as far as MySQL is concerned you could be talking about any of the days in that week

(defmethod sql.qp/date [:mysql :week] [_ _ expr]
  (let [extract-week-fn (fn [expr]
                          (str-to-date "%X%V %W"
                                       (h2x/concat [:yearweek expr]
                                                   (h2x/literal " Sunday"))))]
    (sql.qp/adjust-start-of-week :mysql extract-week-fn expr)))
(defmethod sql.qp/date [:mysql :week-of-year-iso] [_ _ expr] (h2x/week expr 3))
(defmethod sql.qp/date [:mysql :month] [_ _ expr]
  (str-to-date "%Y-%m-%d"
               (h2x/concat (date-format "%Y-%m" expr)
                           (h2x/literal "-01"))))

Truncating to a quarter is trickier since there aren't any format strings. See the explanation in the H2 driver, which does the same thing but with slightly different syntax.

(defmethod sql.qp/date [:mysql :quarter] [_ _ expr]
  (str-to-date "%Y-%m-%d"
               (h2x/concat (h2x/year expr)
                          (h2x/literal "-")
                          (h2x/- (h2x/* (h2x/quarter expr)
                                      3)
                                2)
                          (h2x/literal "-01"))))
(defmethod sql.qp/->honeysql [:mysql :convert-timezone]
  [driver [_ arg target-timezone source-timezone]]
  (let [expr       (sql.qp/->honeysql driver arg)
        timestamp? (h2x/is-of-type? expr "timestamp")]
    (sql.u/validate-convert-timezone-args timestamp? target-timezone source-timezone)
    (h2x/with-database-type-info
     [:convert_tz expr (or source-timezone (qp.timezone/results-timezone-id)) target-timezone]
     "datetime")))
(defn- timestampdiff-dates [unit x y]
  [:timestampdiff [:raw (name unit)] (h2x/->date x) (h2x/->date y)])
(defn- timestampdiff [unit x y]
  [:timestampdiff [:raw (name unit)] x y])
(defmethod sql.qp/datetime-diff [:mysql :year]    [_driver _unit x y] (timestampdiff-dates :year x y))
(defmethod sql.qp/datetime-diff [:mysql :quarter] [_driver _unit x y] (timestampdiff-dates :quarter x y))
(defmethod sql.qp/datetime-diff [:mysql :month]   [_driver _unit x y] (timestampdiff-dates :month x y))
(defmethod sql.qp/datetime-diff [:mysql :week]    [_driver _unit x y] (timestampdiff-dates :week x y))
(defmethod sql.qp/datetime-diff [:mysql :day]     [_driver _unit x y] [:datediff y x])
(defmethod sql.qp/datetime-diff [:mysql :hour]    [_driver _unit x y] (timestampdiff :hour x y))
(defmethod sql.qp/datetime-diff [:mysql :minute]  [_driver _unit x y] (timestampdiff :minute x y))
(defmethod sql.qp/datetime-diff [:mysql :second]  [_driver _unit x y] (timestampdiff :second x y))

+----------------------------------------------------------------------------------------------------------------+ | metabase.driver.sql-jdbc impls | +----------------------------------------------------------------------------------------------------------------+

(defmethod sql-jdbc.sync/database-type->base-type :mysql
  [_ database-type]
  ({:BIGINT     :type/BigInteger
    :BINARY     :type/*
    :BIT        :type/Boolean
    :BLOB       :type/*
    :CHAR       :type/Text
    :DATE       :type/Date
    :DATETIME   :type/DateTime
    :DECIMAL    :type/Decimal
    :DOUBLE     :type/Float
    :ENUM       :type/*
    :FLOAT      :type/Float
    :INT        :type/Integer
    :INTEGER    :type/Integer
    :LONGBLOB   :type/*
    :LONGTEXT   :type/Text
    :MEDIUMBLOB :type/*
    :MEDIUMINT  :type/Integer
    :MEDIUMTEXT :type/Text
    :NUMERIC    :type/Decimal
    :REAL       :type/Float
    :SET        :type/*
    :SMALLINT   :type/Integer
    :TEXT       :type/Text
    :TIME       :type/Time
    :TIMESTAMP  :type/DateTimeWithLocalTZ ; stored as UTC in the database
    :TINYBLOB   :type/*
    :TINYINT    :type/Integer
    :TINYTEXT   :type/Text
    :VARBINARY  :type/*
    :VARCHAR    :type/Text
    :YEAR       :type/Integer
    :JSON       :type/JSON}
   ;; strip off " UNSIGNED" from end if present
   (keyword (str/replace (name database-type) #"\sUNSIGNED$" ""))))
(defmethod sql-jdbc.sync/column->semantic-type :mysql
  [_ database-type _]
  ;; More types to be added when we start caring about them
  (case database-type
    "JSON"  :type/SerializedJSON
    nil))

Map of args for the MySQL/MariaDB JDBC connection string.

(def ^:private default-connection-args
  { ;; 0000-00-00 dates are valid in MySQL; convert these to `null` when they come back because they're illegal in Java
   :zeroDateTimeBehavior "convertToNull"
   ;; Force UTF-8 encoding of results
   :useUnicode           true
   :characterEncoding    "UTF8"
   :characterSetResults  "UTF8"
   ;; GZIP compress packets sent between Metabase server and MySQL/MariaDB database
   :useCompression       true})
(defn- maybe-add-program-name-option [jdbc-spec additional-options-map]
  ;; connectionAttributes (if multiple) are separated by commas, so values that contain spaces are OK, so long as they
  ;; don't contain a comma; our mb-version-and-process-identifier shouldn't contain one, but just to be on the safe side
  (let [set-prog-nm-fn (fn []
                         (let [prog-name (str/replace config/mb-version-and-process-identifier "," "_")]
                           (assoc jdbc-spec :connectionAttributes (str "program_name:" prog-name))))]
    (if-let [conn-attrs (get additional-options-map "connectionAttributes")]
      (if (str/includes? conn-attrs "program_name")
        jdbc-spec ; additional-options already includes the program_name; don't set it here
        (set-prog-nm-fn))
      (set-prog-nm-fn)))) ; additional-options did not contain connectionAttributes at all; set it
(defmethod sql-jdbc.conn/connection-details->spec :mysql
  [_ {ssl? :ssl, :keys [additional-options ssl-cert], :as details}]
  ;; In versions older than 0.32.0 the MySQL driver did not correctly save `ssl?` connection status. Users worked
  ;; around this by including `useSSL=true`. Check if that's there, and if it is, assume SSL status. See #9629
  ;;
  ;; TODO - should this be fixed by a data migration instead?
  (let [addl-opts-map (sql-jdbc.common/additional-options->map additional-options :url "=" false)
        ssl?          (or ssl? (= "true" (get addl-opts-map "useSSL")))
        ssl-cert?     (and ssl? (some? ssl-cert))]
    (when (and ssl? (not (contains? addl-opts-map "trustServerCertificate")))
      (log/info (trs "You may need to add 'trustServerCertificate=true' to the additional connection options to connect with SSL.")))
    (merge
     default-connection-args
     ;; newer versions of MySQL will complain if you don't specify this when not using SSL
     {:useSSL (boolean ssl?)}
     (let [details (-> (if ssl-cert? (set/rename-keys details {:ssl-cert :serverSslCert}) details)
                       (set/rename-keys {:dbname :db})
                       (dissoc :ssl))]
       (-> (mdb.spec/spec :mysql details)
           (maybe-add-program-name-option addl-opts-map)
           (sql-jdbc.common/handle-additional-options details))))))
(defmethod sql-jdbc.sync/active-tables :mysql
  [& args]
  (apply sql-jdbc.sync/post-filtered-active-tables args))
(defmethod sql-jdbc.sync/excluded-schemas :mysql
  [_]
  #{"INFORMATION_SCHEMA"})
(defmethod sql.qp/quote-style :mysql [_] :mysql)

If this fails you need to load the timezone definitions from your system into MySQL; run the command

mysql_tzinfo_to_sql /usr/share/zoneinfo | mysql -u root mysql

See https://dev.mysql.com/doc/refman/5.7/en/time-zone-support.html for details

(defmethod sql-jdbc.execute/set-timezone-sql :mysql
  [_]
  "SET @@session.time_zone = %s;")
(defmethod sql-jdbc.execute/set-parameter [:mysql OffsetTime]
  [driver ps i t]
  ;; convert to a LocalTime so MySQL doesn't get F U S S Y
  (sql-jdbc.execute/set-parameter driver ps i (t/local-time (t/with-offset-same-instant t (t/zone-offset 0)))))

Regardless of session timezone it seems to be the case that OffsetDateTimes get normalized to UTC inside MySQL

Since MySQL TIMESTAMPs aren't timezone-aware this means comparisons are done between timestamps in the report timezone and the local datetime portion of the parameter, in UTC. Bad!

Convert it to a LocalDateTime, in the report timezone, so comparisions will work correctly.

See also — https://dev.mysql.com/doc/refman/5.5/en/datetime.html

TIMEZONE FIXME — not 100% sure this behavior makes sense

(defmethod sql-jdbc.execute/set-parameter [:mysql OffsetDateTime]
  [driver ^java.sql.PreparedStatement ps ^Integer i t]
  (let [zone   (t/zone-id (qp.timezone/results-timezone-id))
        offset (.. zone getRules (getOffset (t/instant t)))
        t      (t/local-date-time (t/with-offset-same-instant t offset))]
    (sql-jdbc.execute/set-parameter driver ps i t)))

MySQL TIMESTAMPS are actually TIMESTAMP WITH LOCAL TIME ZONE, i.e. they are stored normalized to UTC when stored. However, MySQL returns them in the report time zone in an effort to make our lives horrible.

(defmethod sql-jdbc.execute/read-column-thunk [:mysql Types/TIMESTAMP]
  [_ ^ResultSet rs ^ResultSetMetaData rsmeta ^Integer i]
  ;; Check and see if the column type is `TIMESTAMP` (as opposed to `DATETIME`, which is the equivalent of
  ;; LocalDateTime), and normalize it to a UTC timestamp if so.
  (if (= (.getColumnTypeName rsmeta i) "TIMESTAMP")
    (fn read-timestamp-thunk []
      (when-let [t (.getObject rs i LocalDateTime)]
        (t/with-offset-same-instant (t/offset-date-time t (t/zone-id (qp.timezone/results-timezone-id))) (t/zone-offset 0))))
    (fn read-datetime-thunk []
      (.getObject rs i LocalDateTime))))

Results of timediff() might come back as negative values, or might come back as values that aren't valid LocalTimes e.g. -01:00:00 or 25:00:00.

There is currently no way to tell whether the column is the result of a timediff() call (i.e., a duration) or a normal LocalTime -- JDBC doesn't have interval/duration type enums. java.time.LocalTimeonly accepts values of hour between 0 and 23 (inclusive). The MariaDB JDBC driver's implementations of `(.getObject rs i java.time.LocalTime)` will throw Exceptions theses cases.

Thus we should attempt to fetch temporal results the normal way and fall back to string representations for cases where the values are unparseable.

(defmethod sql-jdbc.execute/read-column-thunk [:mysql Types/TIME]
  [driver ^ResultSet rs rsmeta ^Integer i]
  (let [parent-thunk ((get-method sql-jdbc.execute/read-column-thunk [:sql-jdbc Types/TIME]) driver rs rsmeta i)]
    (fn read-time-thunk []
      (try
        (parent-thunk)
        (catch Throwable _
          (.getString rs i))))))

Mysql 8.1+ returns results of YEAR(..) function having a YEAR type. In Mysql 8.0.33, return value of that function has an integral type. Let's make the returned values consistent over mysql versions. Context: https://dev.mysql.com/doc/connector-j/en/connector-j-YEAR.html

(defmethod sql-jdbc.execute/read-column-thunk [:mysql Types/DATE]
  [driver ^ResultSet rs ^ResultSetMetaData rsmeta ^Integer i]
  (if (= "YEAR" (.getColumnTypeName rsmeta i))
    (fn read-time-thunk []
      (when-let [x (.getObject rs i)]
        (.getYear (.toLocalDate ^java.sql.Date x))))
    (let [parent-thunk ((get-method sql-jdbc.execute/read-column-thunk [:sql-jdbc Types/DATE]) driver rs rsmeta i)]
      parent-thunk)))
(defn- format-offset [t]
  (let [offset (t/format "ZZZZZ" (t/zone-offset t))]
    (if (= offset "Z")
      "UTC"
      offset)))
(defmethod unprepare/unprepare-value [:mysql OffsetTime]
  [_ t]
  ;; MySQL doesn't support timezone offsets in literals so pass in a local time literal wrapped in a call to convert
  ;; it to the appropriate timezone
  (format "convert_tz('%s', '%s', @@session.time_zone)"
          (t/format "HH:mm:ss.SSS" t)
          (format-offset t)))
(defmethod unprepare/unprepare-value [:mysql OffsetDateTime]
  [_ t]
  (format "convert_tz('%s', '%s', @@session.time_zone)"
          (t/format "yyyy-MM-dd HH:mm:ss.SSS" t)
          (format-offset t)))
(defmethod unprepare/unprepare-value [:mysql ZonedDateTime]
  [_ t]
  (format "convert_tz('%s', '%s', @@session.time_zone)"
          (t/format "yyyy-MM-dd HH:mm:ss.SSS" t)
          (str (t/zone-id t))))
(defmethod driver/upload-type->database-type :mysql
  [_driver upload-type]
  (case upload-type
    ::upload/varchar-255              [[:varchar 255]]
    ::upload/text                     [:text]
    ::upload/int                      [:bigint]
    ::upload/auto-incrementing-int-pk [:bigint :not-null :auto-increment :primary-key]
    ::upload/float                    [:double]
    ::upload/boolean                  [:boolean]
    ::upload/date                     [:date]
    ::upload/datetime                 [:datetime]
    ::upload/offset-datetime          [:timestamp]))
(defmethod driver/table-name-length-limit :mysql
  [_driver]
  ;; https://dev.mysql.com/doc/refman/8.0/en/identifier-length.html
  64)
(defn- format-load
  [_clause [file-path table-name]]
  [(format "LOAD DATA LOCAL INFILE '%s' INTO TABLE %s" file-path (sql/format-entity table-name))])
(sql/register-clause! ::load format-load :insert-into)

Remove the offset from a datetime, returning a string representation in whatever timezone the database is configured to use. This is necessary since MariaDB doesn't support timestamp-with-time-zone literals and so we need to calculate one by hand.

(defn- offset-datetime->unoffset-datetime
  [driver database ^OffsetDateTime offset-time]
  (let [zone-id (t/zone-id (driver/db-default-timezone driver database))]
    (t/local-date-time offset-time zone-id)))

Convert a value into a string that's safe for insertion

(defmulti ^:private value->string
  {:arglists '([driver val])}
  (fn [_ val] (type val)))
(defmethod value->string :default
  [_driver val]
  (str val))
(defmethod value->string nil
  [_driver _val]
  nil)
(defmethod value->string Boolean
  [_driver val]
  (if val
    "1"
    "0"))
(defmethod value->string LocalDateTime
  [_driver val]
  (t/format :iso-local-date-time val))
(let [zulu-fmt         "yyyy-MM-dd'T'HH:mm:ss"
      offset-fmt       "XXX"
      zulu-formatter   (DateTimeFormatter/ofPattern zulu-fmt)
      offset-formatter (DateTimeFormatter/ofPattern (str zulu-fmt offset-fmt))]
  (defmethod value->string OffsetDateTime
    [driver ^OffsetDateTime val]
    (let [uploads-db (upload/current-database)]
      (if (mariadb? uploads-db)
        (offset-datetime->unoffset-datetime driver uploads-db val)
        (t/format (if (.equals (.getOffset val) ZoneOffset/UTC)
                    zulu-formatter
                    offset-formatter)
                  val)))))
(defn- sanitize-value
  ;; Per https://dev.mysql.com/doc/refman/8.0/en/load-data.html#load-data-field-line-handling
  ;; Backslash is the MySQL escape character within strings in SQL statements. Thus, to specify a literal backslash,
  ;; you must specify two backslashes for the value to be interpreted as a single backslash. The escape sequences
  ;; '\t' and '\n' specify tab and newline characters, respectively.
  [v]
  (if (nil? v)
    "\\N"
    (str/replace v #"\\|\n|\r|\t" {"\\" "\\\\"
                                   "\n" "\\n"
                                   "\r" "\\r"
                                   "\t" "\\t"})))
(defn- row->tsv
  [driver column-count row]
  (when (not= column-count (count row))
    (throw (Exception. (format "ERROR: missing data in row \"%s\ (str/join "," row)))))
  (->> row
       (map (comp sanitize-value (partial value->string driver)))
       (str/join "\t")))

The value of the given global variable in the DB. Does not do any type coercion, so, e.g., booleans come back as "ON" and "OFF".

(defn- get-global-variable
  [db-id var-name]
  (:value
   (first
    (jdbc/query (sql-jdbc.conn/db->pooled-connection-spec db-id)
                ["show global variables like ?" var-name]))))
(defmethod driver/insert-into! :mysql
  [driver db-id ^String table-name column-names values]
  ;; `local_infile` must be turned on per
  ;; https://dev.mysql.com/doc/refman/8.0/en/load-data.html#load-data-local
  (if (not= (get-global-variable db-id "local_infile") "ON")
    ;; If it isn't turned on, fall back to the generic "INSERT INTO ..." way
    ((get-method driver/insert-into! :sql-jdbc) driver db-id table-name column-names values)
    (let [temp-file (File/createTempFile table-name ".tsv")
          file-path (.getAbsolutePath temp-file)]
      (try
        (let [tsvs (map (partial row->tsv driver (count column-names)) values)
              sql  (sql/format {::load   [file-path (keyword table-name)]
                                :columns (map keyword column-names)}
                               :quoted  true
                               :dialect (sql.qp/quote-style driver))]
          (with-open [^java.io.Writer writer (jio/writer file-path)]
            (doseq [value (interpose \newline tsvs)]
              (.write writer (str value))))
          (sql-jdbc.execute/do-with-connection-with-options
           driver
           db-id
           nil
           (fn [conn]
             (jdbc/execute! {:connection conn} sql))))
        (finally
          (.delete temp-file))))))

Parses the contents of a row from the output of a SHOW GRANTS statement, to extract the data needed to reconstruct the set of table privileges that the current user has. Returns nil if the grant doesn't contain any information we care about. Running help show grants in the mysql console shows the syntax for the output strings of SHOW GRANTS statements.

There are two types of grants we care about: privileges and roles.

Privilege example: (parse-grant "GRANT SELECT, INSERT, UPDATE, DELETE ON test-data.* TO 'metabase'@'localhost'") => {:type :privileges :privilege-types #{:select :insert :update :delete} :level :table :object "test-data"}

Role example: (parse-grant "GRANT 'examplerole1'@'%','examplerole2'@'%' TO 'metabase'@'localhost'") => {:type :roles :roles #{'examplerole1'@'%' 'examplerole2'@'%'}}

(defn- parse-grant
  [grant]
  (condp re-find grant
    #"^GRANT PROXY ON "
    nil
    #"^GRANT (.+) ON FUNCTION "
    nil
    #"^GRANT (.+) ON PROCEDURE "
    nil
    ;; GRANT
    ;;     priv_type [(column_list)]
    ;;       [, priv_type [(column_list)]] ...
    ;;     ON object
    ;;     TO user etc.
    ;; }
    ;; For now we ignore column-level privileges. But this is how we could get them in the future.
    #"^GRANT (.+) ON (.+) TO "
    :>>
    (fn [[_ priv-types object]]
      (when-let [priv-types' (if (= priv-types "ALL PRIVILEGES")
                               #{:select :update :delete :insert}
                               (let [split-priv-types (->> (str/split priv-types #", ")
                                                           (map (comp keyword u/lower-case-en))
                                                           set)]
                                 (set/intersection #{:select :update :delete :insert} split-priv-types)))]
        {:type             :privileges
         :privilege-types  (not-empty priv-types')
         :level            (cond
                             (= object "*.*")             :global
                             (str/ends-with? object ".*") :database
                             :else                        :table)
         :object           object}))
    ;; GRANT role [, role] ... TO user etc.
    #"^GRANT (.+) TO "
    :>>
    (fn [[_ roles]]
      {:type  :roles
       :roles (set (map u/lower-case-en (str/split roles #",")))})))

Returns a list of parsed privilege grants for a user, taking into account the roles that the user has. It does so by first querying: SHOW GRANTS FOR <user>. If the results include any roles granted to the user, we query SHOW GRANTS FOR <user> USING <role1> [,<role2>] .... The results from this query will contain all privileges granted for the user, either directly or indirectly through the role hierarchy.

(defn- privilege-grants-for-user
  [conn-spec user]
  (let [query  (fn [q] (->> (jdbc/query conn-spec q {:as-arrays? true})
                            (drop 1)
                            (map first)))
        grants (map parse-grant (query (str "SHOW GRANTS FOR " user)))
        {role-grants      :roles
         privilege-grants :privileges} (group-by :type grants)]
    (if (seq role-grants)
      (let [roles  (:roles (first role-grants))
            grants (map parse-grant (query (str "SHOW GRANTS FOR " user "USING " (str/join "," roles))))
            {privilege-grants :privileges} (group-by :type grants)]
        privilege-grants)
      privilege-grants)))

Given a set of parsed grants for a user, a database name, and a list of table names in the database, return a map with table names as keys, and the set of privilege types that the user has on the table as values.

The rules are: - global grants apply to all tables - database grants apply to all tables in the database - table grants apply to the table

(defn- table-names->privileges
  [privilege-grants database-name table-names]
  (let [{global-grants   :global
         database-grants :database
         table-grants    :table} (group-by :level privilege-grants)
        lower-database-name (u/lower-case-en database-name)
        all-table-privileges (set/union (:privilege-types (first global-grants))
                                        (:privilege-types (m/find-first #(= (:object %) (str "`" lower-database-name "`.*"))
                                                                        database-grants)))
        table-privileges (into {}
                               (keep (fn [grant]
                                       (when-let [match (re-find (re-pattern (str "^`" lower-database-name "`.`(.+)`")) (:object grant))]
                                         (let [[_ table-name] match]
                                           [table-name (:privilege-types grant)]))))
                               table-grants)]
    (into {}
          (keep (fn [table-name]
                  (when-let [privileges (not-empty (set/union all-table-privileges (get table-privileges table-name)))]
                    [table-name privileges])))
          table-names)))
(defmethod driver/current-user-table-privileges :mysql
  [_driver database]
  ;; MariaDB doesn't allow users to query the privileges of roles a user might have (unless they have select privileges
  ;; for the mysql database), so we can't query the full privileges of the current user.
  (when-not (mariadb? database)
    (let [conn-spec   (sql-jdbc.conn/db->pooled-connection-spec database)
          table-names (->> (jdbc/query conn-spec "SHOW TABLES" {:as-arrays? true})
                           (drop 1)
                           (map first))]
      (for [[table-name privileges] (table-names->privileges (privilege-grants-for-user conn-spec "CURRENT_USER()")
                                                             (:name database)
                                                             table-names)]
        {:role   nil
         :schema nil
         :table  table-name
         :select (contains? privileges :select)
         :update (contains? privileges :update)
         :insert (contains? privileges :insert)
         :delete (contains? privileges :delete)}))))
 

Method impls for [[metabase.driver.sql-jdbc.actions]] for `:mysql.

(ns metabase.driver.mysql.actions
  (:require
   [clojure.java.jdbc :as jdbc]
   [clojure.string :as str]
   [metabase.actions.error :as actions.error]
   [metabase.driver.sql-jdbc.actions :as sql-jdbc.actions]
   [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn]
   [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute]
   [metabase.driver.sql.query-processor :as sql.qp]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-trun tru]]
   [metabase.util.log :as log]))
(set! *warn-on-reflection* true)

TODO -- we should probably be TTL caching this information. Otherwise parsing 100 errors for a bulk action will result in 100 identical data warehouse queries. It's not like constraint columns are something we would expect to change regularly anyway. (See the twin function in namespace metabase.driver.postgres.actions.)

In the error message we have no information about catalog and schema, so we do the query with the information we have and check if the result is unique. If it's not, we log a warning and signal that we couldn't find the columns names.

(defn- remove-backticks [id]
  (when id
    (-> id
        (str/replace "``" "`")
        (str/replace #"^`?(.+?)`?$" "$1"))))

Given a constraint with constraint-name fetch the column names associated with that constraint.

(defn- constraint->column-names
  [database constraint-name]
  (let [jdbc-spec (sql-jdbc.conn/db->pooled-connection-spec (u/the-id database))
        sql-args  ["select table_catalog, table_schema, column_name from information_schema.key_column_usage where constraint_name = ?" constraint-name]]
    (first
     (reduce
      (fn [[columns catalog schema] {:keys [table_catalog table_schema column_name]}]
        (if (and (or (nil? catalog) (= table_catalog catalog))
                 (or (nil? schema) (= table_schema schema)))
          [(conj columns column_name) table_catalog table_schema]
          (do (log/warnf "Ambiguous catalog/schema for constraint %s in table %s"
                         constraint-name)
              (reduced nil))))
      [[] nil nil]
      (jdbc/reducible-query jdbc-spec sql-args {:identifers identity, :transaction? false})))))
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:mysql actions.error/violate-not-null-constraint]
  [_driver error-type _database _action-type error-message]
  (or
   (when-let [[_ column]
              (re-find #"Column '(.+)' cannot be null" error-message)]
     {:type    error-type
      :message (tru "{0} must have values." (str/capitalize column))
      :errors  {column (tru "You must provide a value.")}})
   (when-let [[_ column]
              (re-find #"Field '(.+)' doesn't have a default value" error-message)]
     {:type    error-type
      :message (tru "{0} must have values." (str/capitalize column))
      :errors  {column (tru "You must provide a value.")}})))
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:mysql actions.error/violate-unique-constraint]
  [_driver error-type database _action-type error-message]
  (when-let [[_match constraint]
             (re-find #"Duplicate entry '.+' for key '(.+)'" error-message)]
    (let [constraint (last (str/split constraint #"\."))
          columns (constraint->column-names database constraint)]
      {:type    error-type
       :message (tru "{0} already {1}." (u/build-sentence (map str/capitalize columns) :stop? false) (deferred-trun "exists" "exist" (count columns)))
       :errors  (reduce (fn [acc col]
                          (assoc acc col (tru "This {0} value already exists." (str/capitalize col))))
                        {}
                        columns)})))
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:mysql actions.error/violate-foreign-key-constraint]
  [_driver error-type _database action-type error-message]
  (or
   (when-let [[_match _ref-table _constraint _fkey-cols column _key-cols]
              (re-find #"Cannot delete or update a parent row: a foreign key constraint fails \((.+), CONSTRAINT (.+) FOREIGN KEY \((.+)\) REFERENCES (.+) \((.+)\)\)" error-message)]
     (merge {:type error-type}
            (case action-type
              :row/delete
              {:message (tru "Other tables rely on this row so it cannot be deleted.")
               :errors  {}}

              :row/update
              (let [column (remove-backticks column)]
                {:message (tru "Unable to update the record.")
                 :errors  {column (tru "This {0} does not exist." (str/capitalize column))}}))))
   (when-let [[_match _ref-table _constraint column _fk-table _fk-col]
              (re-find #"Cannot add or update a child row: a foreign key constraint fails \((.+), CONSTRAINT (.+) FOREIGN KEY \((.+)\) REFERENCES (.+) \((.+)\)\)" error-message)]
     (let [column (remove-backticks column)]
       {:type    error-type
        :message (case action-type
                   :row/create
                   (tru "Unable to create a new record.")

                   :row/update
                   (tru "Unable to update the record."))
        :errors  {(remove-backticks column) (tru "This {0} does not exist." (str/capitalize (remove-backticks column)))}}))))
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:mysql actions.error/incorrect-value-type]
  [_driver error-type _database _action-type error-message]
  (when-let [[_ expected-type _value _database _table column _row]
             (re-find #"Incorrect (.+?) value: '(.+)' for column (?:(.+)\.)??(?:(.+)\.)?(.+) at row (\d+)"  error-message)]
    (let [column (-> column (str/replace #"^'(.*)'$" "$1") remove-backticks)]
      {:type    error-type
       :message (tru "Some of your values aren’t of the correct type for the database.")
       :errors  {column (tru "This value should be of type {0}." (str/capitalize expected-type))}})))

There is a huge discrepancy between the types used in DDL statements and types that can be used in CAST: cf https://dev.mysql.com/doc/refman/8.0/en/data-types.html et https://dev.mysql.com/doc/refman/5.7/en/data-types.html vs https://dev.mysql.com/doc/refman/5.7/en/cast-functions.html#function_cast et https://dev.mysql.com/doc/refman/8.0/en/cast-functions.html#function_cast

(defmethod sql-jdbc.actions/base-type->sql-type-map :mysql
  [_driver]
  {:type/Date           "DATE"
   ;; (3) is fractional seconds precision, i.e. millisecond precision
   :type/DateTime       "DATETIME(3)"
   :type/DateTimeWithTZ "DATETIME(3)"
   :type/JSON           "JSON"
   :type/Time           "TIME(3)"})

MySQL doesn't need to do anything special with nested transactions; the original transaction can proceed even if some specific statement errored.

(defmethod sql-jdbc.actions/do-nested-transaction :mysql
  [_driver _conn thunk]
  (thunk))
(defn- primary-keys [driver jdbc-spec table-components]
  (let [schema (when (next table-components) (first table-components))
        table  (last table-components)]
    (sql-jdbc.execute/do-with-connection-with-options
     driver
     jdbc-spec
     nil
     (fn [^java.sql.Connection conn]
       (let [metadata (.getMetaData conn)]
         (with-open [rset (.getPrimaryKeys metadata nil schema table)]
           (loop [acc []]
             (if-not (.next rset)
               acc
               (recur (conj acc (.getString rset "COLUMN_NAME")))))))))))

MySQL returns the generated ID (of which cannot be more than one) as insert_id. If this is not null, we determine the name of the primary key and query the corresponding record. If the table has no auto_increment primary key, then we make a query with the values inserted in order to get the default values. If the table has no primary key and this query returns multiple rows, then we cannot know which one resulted from this insert, so we log a warning and return nil.

(defmethod sql-jdbc.actions/select-created-row :mysql
  [driver create-hsql conn {:keys [insert_id] :as results}]
  (let [jdbc-spec {:connection conn}
        table-components (-> create-hsql :insert-into :components)
        pks (primary-keys driver jdbc-spec table-components)
        where-clause (if insert_id
                       [:= (-> pks first keyword) insert_id]
                       (into [:and]
                             (for [[col val] (:insert-into create-hsql)]
                               [:= (keyword col) val])))
        select-hsql (-> create-hsql
                        (dissoc :insert-into :values)
                        (assoc :select [:*]
                               :from [(:insert-into create-hsql)]
                               :where where-clause))
        select-sql-args (sql.qp/format-honeysql driver select-hsql)
        query-results (jdbc/query jdbc-spec
                                  select-sql-args
                                  {:identifiers identity, :transaction? false})]
    (if (next query-results)
      (log/warn "cannot identify row inserted by" create-hsql "using results" results)
      (first query-results))))
 
(ns metabase.driver.mysql.ddl
  (:require
   [clojure.core.async :as a]
   [clojure.string :as str]
   [honey.sql :as sql]
   [java-time.api :as t]
   [metabase.driver.ddl.interface :as ddl.i]
   [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn]
   [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute]
   [metabase.driver.sql.ddl :as sql.ddl]
   [metabase.public-settings :as public-settings]
   [metabase.query-processor :as qp]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log])
  (:import
   (java.sql SQLNonTransientConnectionException)))
(set! *warn-on-reflection* true)
(defn- exec-async [driver conn-chan db-spec sql+params]
  (a/thread
    (sql-jdbc.execute/do-with-connection-with-options
     driver
     db-spec
     {:write? true}
     (fn [^java.sql.Connection conn]
       (try
         (let [pid (:pid (first (sql.ddl/jdbc-query conn ["select connection_id() pid"])))]
           (a/put! conn-chan pid)
           (sql.ddl/jdbc-query conn sql+params))
         (catch SQLNonTransientConnectionException _e
           ;; Our connection may be killed due to timeout, [[kill!]] will throw an appropriate exception
           nil)
         (catch Exception e
           (log/warn e)
           e))))))
(defn- kill! [conn pid]
  (let [results (sql.ddl/jdbc-query conn ["show processlist"])
        result? (some (fn [r]
                        (and (= (:id r) pid)
                             (str/starts-with? (or (:info r) ) "-- Metabase")))
                      results)]
    (when result?
      ;; Can't use a prepared parameter with these statements
      (sql.ddl/execute! conn [(str "kill " pid)])
      (throw (Exception. (trs "Killed mysql process id {0} due to timeout." pid))))))

Spins up another channel to execute the statement. If timeout-ms passes, send a kill statement to stop execution and throw exception Otherwise return results returned by channel.

(defn- execute-with-timeout!
  [driver conn db-spec timeout-ms sql+params]
  (let [conn-chan    (a/promise-chan)
        exec-chan    (exec-async driver conn-chan db-spec sql+params)
        pid          (a/<!! conn-chan)
        _            (a/close! conn-chan)
        timeout-chan (a/timeout timeout-ms)
        [v port]     (a/alts!! [timeout-chan exec-chan])]
    (a/close! exec-chan)
    (cond
      (= port timeout-chan) (kill! conn pid)
      (= port exec-chan)    (if (instance? Exception v)
                              (throw v)
                              v))))
(defmethod ddl.i/refresh! :mysql
  [driver database definition dataset-query]
  (let [{:keys [query params]} (qp/compile dataset-query)
        db-spec (sql-jdbc.conn/db->pooled-connection-spec database)]
    (sql-jdbc.execute/do-with-connection-with-options
     driver
     database
     {:write? true}
     (fn [conn]
       (sql.ddl/execute! conn [(sql.ddl/drop-table-sql database (:table-name definition))])
       ;; It is possible that this fails and rollback would not restore the table.
       ;; That is ok, the persisted-info will be marked inactive and the next refresh will try again.
       (execute-with-timeout! driver
                              conn
                              db-spec
                              (.toMillis (t/minutes 10))
                              (into [(sql.ddl/create-table-sql database definition query)] params))
       {:state :success}))))
(defmethod ddl.i/unpersist! :mysql
  [driver database persisted-info]
  (sql-jdbc.execute/do-with-connection-with-options
   driver
   database
   {:write? true}
   (fn [^java.sql.Connection conn]
     (try
       (sql.ddl/execute! conn [(sql.ddl/drop-table-sql database (:table_name persisted-info))])
       (catch Exception e
         (log/warn e)
         (throw e))))))
(defmethod ddl.i/check-can-persist :mysql
  [{driver :engine, :as database}]
  (let [schema-name (ddl.i/schema-name database (public-settings/site-uuid))
        table-name (format "persistence_check_%s" (rand-int 10000))
        db-spec (sql-jdbc.conn/db->pooled-connection-spec database)
        steps [[:persist.check/create-schema
                (fn check-schema [conn]
                  (let [existing-schemas (->> ["select schema_name from information_schema.schemata"]
                                              (sql.ddl/jdbc-query conn)
                                              (map :schema_name)
                                              (into #{}))]
                    (or (contains? existing-schemas schema-name)
                        (sql.ddl/execute! conn [(sql.ddl/create-schema-sql database)]))))
                (fn undo-check-schema [conn]
                  (sql.ddl/execute! conn [(sql.ddl/drop-schema-sql database)]))]
               [:persist.check/create-table
                (fn create-table [conn]
                  (execute-with-timeout! driver
                                         conn
                                         db-spec
                                         (.toMillis (t/minutes 10))
                                         [(sql.ddl/create-table-sql
                                           database
                                           {:table-name table-name
                                            :field-definitions [{:field-name "field"
                                                                 :base-type :type/Text}]}
                                           "select 1")]))
                (fn undo-create-table [conn]
                  (sql.ddl/execute! conn [(sql.ddl/drop-table-sql database table-name)]))]
               [:persist.check/read-table
                (fn read-table [conn]
                  (sql.ddl/jdbc-query conn [(format "select * from %s.%s"
                                                    schema-name table-name)]))
                (constantly nil)]
               [:persist.check/delete-table
                (fn delete-table [conn]
                  (sql.ddl/execute! conn [(sql.ddl/drop-table-sql database table-name)]))
                ;; This will never be called, if the last step fails it does not need to be undone
                (constantly nil)]
               [:persist.check/create-kv-table
                (fn create-kv-table [conn]
                  (sql.ddl/execute! conn [(format "drop table if exists %s.cache_info"
                                                  schema-name)])
                  (sql.ddl/execute! conn (sql/format
                                          (ddl.i/create-kv-table-honey-sql-form schema-name)
                                          {:dialect :mysql})))]
               [:persist.check/populate-kv-table
                (fn create-kv-table [conn]
                  (sql.ddl/execute! conn (sql/format
                                          (ddl.i/populate-kv-table-honey-sql-form
                                           schema-name)
                                          {:dialect :mysql})))]]]
    ;; Unlike postgres, mysql ddl clauses will not rollback in a transaction.
    ;; So we keep track of undo-steps to manually rollback previous, completed steps.
    (sql-jdbc.execute/do-with-connection-with-options
     driver
     db-spec
     {:write? true}
     (fn [conn]
       (loop [[[step stepfn undofn] & remaining] steps
              undo-steps []]
         (let [result (try (stepfn conn)
                           (log/info (trs "Step {0} was successful for db {1}"
                                          step (:name database)))
                           ::valid
                           (catch Exception e
                             (log/warn (trs "Error in `{0}` while checking for model persistence permissions." step))
                             (log/warn e)
                             (try
                               (doseq [[undo-step undofn] (reverse undo-steps)]
                                 (log/warn (trs "Undoing step `{0}` for db {1}" undo-step (:name database)))
                                 (undofn conn))
                               (catch Exception _e
                                 (log/warn (trs "Unable to rollback database check for model persistence"))))
                             step))]
           (cond (and (= result ::valid) remaining)
                 (recur remaining (conj undo-steps [step undofn]))

                 (= result ::valid)
                 [true :persist.check/valid]

                 :else
                 [false step])))))))
 

Database driver for PostgreSQL databases. Builds on top of the SQL JDBC driver, which implements most functionality for JDBC-based drivers.

(ns metabase.driver.postgres
  (:require
   [clojure.java.jdbc :as jdbc]
   [clojure.set :as set]
   [clojure.string :as str]
   [clojure.walk :as walk]
   [honey.sql :as sql]
   [java-time.api :as t]
   [metabase.db.spec :as mdb.spec]
   [metabase.driver :as driver]
   [metabase.driver.common :as driver.common]
   [metabase.driver.postgres.actions :as postgres.actions]
   [metabase.driver.postgres.ddl :as postgres.ddl]
   [metabase.driver.sql :as driver.sql]
   [metabase.driver.sql-jdbc.common :as sql-jdbc.common]
   [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn]
   [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute]
   [metabase.driver.sql-jdbc.sync :as sql-jdbc.sync]
   [metabase.driver.sql.query-processor :as sql.qp]
   [metabase.driver.sql.query-processor.util :as sql.qp.u]
   [metabase.driver.sql.util :as sql.u]
   [metabase.driver.sql.util.unprepare :as unprepare]
   [metabase.lib.field :as lib.field]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.temporal-bucketing
    :as lib.schema.temporal-bucketing]
   [metabase.models.secret :as secret]
   [metabase.query-processor.store :as qp.store]
   [metabase.query-processor.util.add-alias-info :as add]
   [metabase.upload :as upload]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu])
  (:import
   (java.io StringReader)
   (java.sql Connection ResultSet ResultSetMetaData Time Types)
   (java.time LocalDateTime OffsetDateTime OffsetTime)
   (java.util Date UUID)
   (org.postgresql.copy CopyManager)
   (org.postgresql.jdbc PgConnection)))
(set! *warn-on-reflection* true)
(comment
  ;; method impls live in these namespaces.
  postgres.actions/keep-me
  postgres.ddl/keep-me)
(driver/register! :postgres, :parent :sql-jdbc)
(defmethod driver/display-name :postgres [_] "PostgreSQL")

Features that are supported by Postgres and all of its child drivers like Redshift

(doseq [[feature supported?] {:convert-timezone         true
                              :datetime-diff            true
                              :now                      true
                              :persist-models           true
                              :schemas                  true
                              :connection-impersonation true
                              :uploads                  true}]
  (defmethod driver/database-supports? [:postgres feature] [_driver _feature _db] supported?))
(defmethod driver/database-supports? [:postgres :nested-field-columns]
  [_driver _feat db]
  (driver.common/json-unfolding-default db))

Features that are supported by postgres only

(doseq [feature [:actions
                 :actions/custom
                 :table-privileges
                 :uploads
                 :index-info]]
  (defmethod driver/database-supports? [:postgres feature]
    [driver _feat _db]
    (= driver :postgres)))

+----------------------------------------------------------------------------------------------------------------+ | metabase.driver impls | +----------------------------------------------------------------------------------------------------------------+

(defmethod driver/display-name :postgres [_] "PostgreSQL")
(defmethod driver/humanize-connection-error-message :postgres
  [_ message]
  (condp re-matches message
    #"^FATAL: database \".*\" does not exist$"
    :database-name-incorrect

    #"^No suitable driver found for.*$"
    :invalid-hostname

    #"^Connection refused. Check that the hostname and port are correct and that the postmaster is accepting TCP/IP connections.$"
    :cannot-connect-check-host-and-port

    #"^FATAL: role \".*\" does not exist$"
    :username-incorrect

    #"^FATAL: password authentication failed for user.*$"
    :password-incorrect

    #"^FATAL: .*$" ; all other FATAL messages: strip off the 'FATAL' part, capitalize, and add a period
    (let [[_ message] (re-matches #"^FATAL: (.*$)" message)]
      (str (str/capitalize message) \.))

    message))
(defmethod driver/db-default-timezone :postgres
  [driver database]
  (sql-jdbc.execute/do-with-connection-with-options
   driver database nil
   (fn [^java.sql.Connection conn]
     (with-open [stmt (.prepareStatement conn "show timezone;")
                 rset (.executeQuery stmt)]
       (when (.next rset)
         (.getString rset 1))))))
(defmethod driver/connection-properties :postgres
  [_]
  (->>
   [driver.common/default-host-details
    (assoc driver.common/default-port-details :placeholder 5432)
    driver.common/default-dbname-details
    driver.common/default-user-details
    driver.common/default-password-details
    driver.common/cloud-ip-address-info
    {:name "schema-filters"
     :type :schema-filters
     :display-name "Schemas"}
    driver.common/default-ssl-details
    {:name         "ssl-mode"
     :display-name (trs "SSL Mode")
     :type         :select
     :options [{:name  "allow"
                :value "allow"}
               {:name  "prefer"
                :value "prefer"}
               {:name  "require"
                :value "require"}
               {:name  "verify-ca"
                :value "verify-ca"}
               {:name  "verify-full"
                :value "verify-full"}]
     :default "require"
     :visible-if {"ssl" true}}
    {:name         "ssl-root-cert"
     :display-name (trs "SSL Root Certificate (PEM)")
     :type         :secret
     :secret-kind  :pem-cert
     ;; only need to specify the root CA if we are doing one of the verify modes
     :visible-if   {"ssl-mode" ["verify-ca" "verify-full"]}}
    {:name         "ssl-use-client-auth"
     :display-name (trs "Authenticate client certificate?")
     :type         :boolean
     ;; TODO: does this somehow depend on any of the ssl-mode vals?  it seems not (and is in fact orthogonal)
     :visible-if   {"ssl" true}}
    {:name         "ssl-client-cert"
     :display-name (trs "SSL Client Certificate (PEM)")
     :type         :secret
     :secret-kind  :pem-cert
     :visible-if   {"ssl-use-client-auth" true}}
    {:name         "ssl-key"
     :display-name (trs "SSL Client Key (PKCS-8/DER)")
     :type         :secret
     ;; since this can be either PKCS-8 or PKCS-12, we can't model it as a :keystore
     :secret-kind  :binary-blob
     :visible-if   {"ssl-use-client-auth" true}}
    {:name         "ssl-key-password"
     :display-name (trs "SSL Client Key Password")
     :type         :secret
     :secret-kind  :password
     :visible-if   {"ssl-use-client-auth" true}}
    driver.common/ssh-tunnel-preferences
    driver.common/advanced-options-start
    driver.common/json-unfolding

    (assoc driver.common/additional-options
           :placeholder "prepareThreshold=0")
    driver.common/default-advanced-options]
   (map u/one-or-many)
   (apply concat)))
(defmethod driver/db-start-of-week :postgres
  [_]
  :monday)
(defn- get-typenames [{:keys [nspname typname]}]
  (cond-> [typname]
    (not= nspname "public") (conj (format "\"%s\".\"%s\ nspname typname))))
(defn- enum-types [_driver database]
  (into #{}
        (comp (mapcat get-typenames)
              (map keyword))
        (jdbc/query (sql-jdbc.conn/db->pooled-connection-spec database)
                    [(str "SELECT nspname, typname "
                          "FROM pg_type t JOIN pg_namespace n ON n.oid = t.typnamespace "
                          "WHERE t.oid IN (SELECT DISTINCT enumtypid FROM pg_enum e)")])))
(def ^:private ^:dynamic *enum-types* nil)

Describe the Fields present in a table. This just hands off to the normal SQL driver implementation of the same name, but first fetches database enum types so we have access to them. These are simply binded to the dynamic var and used later in database-type->base-type, which you will find below.

(defmethod driver/describe-table :postgres
  [driver database table]
  (binding [*enum-types* (enum-types driver database)]
    (sql-jdbc.sync/describe-table driver database table)))

+----------------------------------------------------------------------------------------------------------------+ | metabase.driver.sql impls | +----------------------------------------------------------------------------------------------------------------+

(defn- ->timestamp [honeysql-form]
  (h2x/cast-unless-type-in "timestamp" #{"timestamp" "timestamptz" "date"} honeysql-form))

Generate a Postgres 'INTERVAL' literal.

(sql/format-expr [::interval 2 :day]) => ["INTERVAL '2 day'"]

(defn- format-interval
  ;; I tried to write this with Malli but couldn't figure out how to make it work. See
  ;; https://metaboat.slack.com/archives/CKZEMT1MJ/p1676076592468909
  [_fn [amount unit]]
  {:pre [(number? amount)
         (#{:millisecond :second :minute :hour :day :week :month :year} unit)]}
  [(format "INTERVAL '%s %s'" (num amount) (name unit))])
(sql/register-fn! ::interval #'format-interval)
(defn- interval [amount unit]
  (h2x/with-database-type-info [::interval amount unit] "interval"))
(defmethod sql.qp/add-interval-honeysql-form :postgres
  [driver hsql-form amount unit]
  ;; Postgres doesn't support quarter in intervals (#20683)
  (if (= unit :quarter)
    (recur driver hsql-form (* 3 amount) :month)
    (let [hsql-form (->timestamp hsql-form)]
      (-> (h2x/+ hsql-form (interval amount unit))
          (h2x/with-type-info (h2x/type-info hsql-form))))))
(defmethod sql.qp/current-datetime-honeysql-form :postgres
  [_driver]
  (h2x/with-database-type-info :%now "timestamptz"))
(defmethod sql.qp/unix-timestamp->honeysql [:postgres :seconds]
  [_ _ expr]
  [:to_timestamp expr])
(defmethod sql.qp/cast-temporal-string [:postgres :Coercion/YYYYMMDDHHMMSSString->Temporal]
  [_driver _coercion-strategy expr]
  [:to_timestamp expr (h2x/literal "YYYYMMDDHH24MISS")])
(defmethod sql.qp/cast-temporal-byte [:postgres :Coercion/YYYYMMDDHHMMSSBytes->Temporal]
  [driver _coercion-strategy expr]
  (sql.qp/cast-temporal-string driver :Coercion/YYYYMMDDHHMMSSString->Temporal
                               [:convert_from expr (h2x/literal "UTF8")]))
(defn- extract [unit expr]
  [::h2x/extract unit expr])
(defn- make-time [hour minute second]
  (h2x/with-database-type-info [:make_time hour minute second] "time"))
(defn- time-trunc [unit expr]
  (let [hour   [::pg-conversion (extract :hour expr) :integer]
        minute (if (#{:minute :second} unit)
                 [::pg-conversion (extract :minute expr) :integer]
                 [:inline 0])
        second (if (= unit :second)
                 [::pg-conversion (extract :second expr) ::double]
                 [:inline 0.0])]
    (make-time hour minute second)))
(mu/defn ^:private date-trunc
  [unit :- ::lib.schema.temporal-bucketing/unit.date-time.truncate
   expr]
  (condp = (h2x/database-type expr)
    ;; apparently there is no convenient way to truncate a TIME column in Postgres, you can try to use `date_trunc`
    ;; but it returns an interval (??) and other insane things. This seems to be slightly less insane.
    "time"
    (time-trunc unit expr)
    "timetz"
    (h2x/cast "timetz" (time-trunc unit expr))
    #_else
    (let [expr' (->timestamp expr)]
      (-> [:date_trunc (h2x/literal unit) expr']
          (h2x/with-database-type-info (h2x/database-type expr'))))))
(defn- extract-from-timestamp [unit expr]
  (extract unit (->timestamp expr)))
(defn- extract-integer [unit expr]
  (h2x/->integer (extract-from-timestamp unit expr)))
(defmethod sql.qp/date [:postgres :default]          [_ _ expr] expr)
(defmethod sql.qp/date [:postgres :second-of-minute] [_ _ expr] (extract-integer :second expr))
(defmethod sql.qp/date [:postgres :minute]           [_ _ expr] (date-trunc :minute expr))
(defmethod sql.qp/date [:postgres :minute-of-hour]   [_ _ expr] (extract-integer :minute expr))
(defmethod sql.qp/date [:postgres :hour]             [_ _ expr] (date-trunc :hour expr))
(defmethod sql.qp/date [:postgres :hour-of-day]      [_ _ expr] (extract-integer :hour expr))
(defmethod sql.qp/date [:postgres :day]              [_ _ expr] (h2x/->date expr))
(defmethod sql.qp/date [:postgres :day-of-month]     [_ _ expr] (extract-integer :day expr))
(defmethod sql.qp/date [:postgres :day-of-year]      [_ _ expr] (extract-integer :doy expr))
(defmethod sql.qp/date [:postgres :month]            [_ _ expr] (date-trunc :month expr))
(defmethod sql.qp/date [:postgres :month-of-year]    [_ _ expr] (extract-integer :month expr))
(defmethod sql.qp/date [:postgres :quarter]          [_ _ expr] (date-trunc :quarter expr))
(defmethod sql.qp/date [:postgres :quarter-of-year]  [_ _ expr] (extract-integer :quarter expr))
(defmethod sql.qp/date [:postgres :year]             [_ _ expr] (date-trunc :year expr))
(defmethod sql.qp/date [:postgres :year-of-era]      [_ _ expr] (extract-integer :year expr))
(defmethod sql.qp/date [:postgres :week-of-year-iso] [_driver _ expr] (extract-integer :week expr))
(defmethod sql.qp/date [:postgres :day-of-week]
  [driver _unit expr]
  ;; Postgres extract(dow ...) returns Sunday(0)...Saturday(6)
  ;;
  ;; Since that's different than what we normally consider the [[metabase.driver/db-start-of-week]] for Postgres
  ;; (Monday) we need to pass in a custom offset here
  (sql.qp/adjust-day-of-week driver
                             (h2x/+ (extract-integer :dow expr) 1)
                             (driver.common/start-of-week-offset-for-day :sunday)))
(defmethod sql.qp/date [:postgres :week]
  [_ _ expr]
  (sql.qp/adjust-start-of-week :postgres (partial date-trunc :week) expr))
(mu/defn ^:private quoted? [database-type :- ::lib.schema.common/non-blank-string]
  (and (str/starts-with? database-type "\)
       (str/ends-with? database-type "\)))
(defmethod sql.qp/->honeysql [:postgres :convert-timezone]
  [driver [_ arg target-timezone source-timezone]]
  (let [expr         (sql.qp/->honeysql driver (cond-> arg
                                                 (string? arg) u.date/parse))
        timestamptz? (h2x/is-of-type? expr "timestamptz")
        _            (sql.u/validate-convert-timezone-args timestamptz? target-timezone source-timezone)
        expr         [:timezone target-timezone (if (not timestamptz?)
                                                  [:timezone source-timezone expr]
                                                  expr)]]
    (h2x/with-database-type-info expr "timestamp")))
(defmethod sql.qp/->honeysql [:postgres :value]
  [driver value]
  (let [[_ value {base-type :base_type, database-type :database_type}] value]
    (when (some? value)
      (condp #(isa? %2 %1) base-type
        :type/UUID         (when (not= "" value) ; support is-empty/non-empty checks
                             (UUID/fromString  value))
        :type/IPAddress    (h2x/cast :inet value)
        :type/PostgresEnum (if (quoted? database-type)
                             (h2x/cast database-type value)
                             (h2x/quoted-cast database-type value))
        (sql.qp/->honeysql driver value)))))
(defmethod sql.qp/->honeysql [:postgres :median]
  [driver [_ arg]]
  (sql.qp/->honeysql driver [:percentile arg 0.5]))
(defmethod sql.qp/datetime-diff [:postgres :year]
  [_driver _unit x y]
  (let [interval [:age (date-trunc :day y) (date-trunc :day x)]]
    (h2x/->integer (extract :year interval))))
(defmethod sql.qp/datetime-diff [:postgres :quarter]
  [driver _unit x y]
  (h2x// (sql.qp/datetime-diff driver :month x y) 3))
(defmethod sql.qp/datetime-diff [:postgres :month]
  [_driver _unit x y]
  (let [interval           [:age (date-trunc :day y) (date-trunc :day x)]
        year-diff          (extract :year interval)
        month-of-year-diff (extract :month interval)]
    (h2x/->integer (h2x/+ month-of-year-diff (h2x/* year-diff 12)))))
(defmethod sql.qp/datetime-diff [:postgres :week]
  [driver _unit x y]
  (h2x// (sql.qp/datetime-diff driver :day x y) 7))
(defmethod sql.qp/datetime-diff [:postgres :day]
  [_driver _unit x y]
  (let [interval (h2x/- (date-trunc :day y) (date-trunc :day x))]
    (h2x/->integer (extract :day interval))))
(defmethod sql.qp/datetime-diff [:postgres :hour]
  [driver _unit x y]
  (h2x// (sql.qp/datetime-diff driver :second x y) 3600))
(defmethod sql.qp/datetime-diff [:postgres :minute]
  [driver _unit x y]
  (h2x// (sql.qp/datetime-diff driver :second x y) 60))
(defmethod sql.qp/datetime-diff [:postgres :second]
  [_driver _unit x y]
  (let [seconds (h2x/- (extract-from-timestamp :epoch y) (extract-from-timestamp :epoch x))]
    (h2x/->integer [:trunc seconds])))
(defn- format-regex-match-first [_fn [identifier pattern]]
  (let [[identifier-sql & identifier-args] (sql/format-expr identifier {:nested true})
        [pattern-sql & pattern-args]       (sql/format-expr pattern {:nested true})]
    (into [(format "substring(%s FROM %s)" identifier-sql pattern-sql)]
          cat
          [identifier-args
           pattern-args])))
(sql/register-fn! ::regex-match-first #'format-regex-match-first)
(defmethod sql.qp/->honeysql [:postgres :regex-match-first]
  [driver [_ arg pattern]]
  (let [identifier (sql.qp/->honeysql driver arg)]
    [::regex-match-first identifier pattern]))
(defmethod sql.qp/->honeysql [:postgres Time]
  [_ time-value]
  (h2x/->time time-value))
(defn- format-pg-conversion [_fn [expr psql-type]]
  (let [[expr-sql & expr-args] (sql/format-expr expr {:nested true})]
    (into [(format "%s::%s" expr-sql (name psql-type))]
          expr-args)))
(sql/register-fn! ::pg-conversion #'format-pg-conversion)

HoneySQL form that adds a Postgres-style :: cast e.g. expr::type.

(pg-conversion :myfield ::integer) -> HoneySQL -[Compile]-> "myfield"::integer

(defn- pg-conversion
  [expr psql-type]
  [::pg-conversion expr psql-type])

Create a Postgres text array literal from a sequence of elements. Used for the ::json-query stuff below.

(sql/format-expr [::text-array "A" 1 "B" 2]) => ["array[?, 1, ?, 2]::text[]" "A" "B"]

(defn- format-text-array
  [_fn [& elements]]
  (let [elements (for [element elements]
                   (if (number? element)
                     [:inline element]
                     (name element)))
        sql-args (map #(sql/format-expr % {:nested true}) elements)
        sqls     (map first sql-args)
        args     (mapcat rest sql-args)]
    (into [(format "array[%s]::text[]" (str/join ", " sqls))]
          args)))
(sql/register-fn! ::text-array #'format-text-array)

e.g.

```clj [::json-query [::h2x/identifier :field ["boop" "bleh"]] "bigint" ["meh"]] => ["(boop.bleh#>> array[?]::text[])::bigint" "meh"] ```

(defn- format-json-query
  [_fn [parent-identifier field-type names]]
  (let [names-text-array                 (into [::text-array] names)
        [parent-id-sql & parent-id-args] (sql/format-expr parent-identifier {:nested true})
        [path-sql & path-args]           (sql/format-expr names-text-array {:nested true})]
    (into [(format "(%s#>> %s)::%s" parent-id-sql path-sql field-type)]
          cat
          [parent-id-args path-args])))
(sql/register-fn! ::json-query #'format-json-query)
(defmethod sql.qp/json-query :postgres
  [_driver unwrapped-identifier nfc-field]
  (assert (h2x/identifier? unwrapped-identifier)
          (format "Invalid identifier: %s" (pr-str unwrapped-identifier)))
  (let [field-type        (:database-type nfc-field)
        nfc-path          (:nfc-path nfc-field)
        parent-identifier (sql.qp.u/nfc-field->parent-identifier unwrapped-identifier nfc-field)]
    [::json-query parent-identifier field-type (rest nfc-path)]))
(defmethod sql.qp/->honeysql [:postgres :field]
  [driver [_ id-or-name opts :as clause]]
  (let [stored-field  (when (integer? id-or-name)
                        (lib.metadata/field (qp.store/metadata-provider) id-or-name))
        parent-method (get-method sql.qp/->honeysql [:sql :field])
        identifier    (parent-method driver clause)]
    (cond
      (= (:database-type stored-field) "money")
      (pg-conversion identifier :numeric)

      (lib.field/json-field? stored-field)
      (if (::sql.qp/forced-alias opts)
        (keyword (::add/source-alias opts))
        (walk/postwalk #(if (h2x/identifier? %)
                          (sql.qp/json-query :postgres % stored-field)
                          %)
                       identifier))

      :else
      identifier)))

Postgres is not happy with JSON fields which are in group-bys or order-bys being described twice instead of using the alias. Therefore, force the alias, but only for JSON fields to avoid ambiguity. The alias names in JSON fields are unique wrt nfc path

(defmethod sql.qp/apply-top-level-clause
  [:postgres :breakout]
  [driver clause honeysql-form {breakout-fields :breakout, _fields-fields :fields :as query}]
  (let [stored-field-ids (map second breakout-fields)
        stored-fields    (map #(when (integer? %)
                                 (lib.metadata/field (qp.store/metadata-provider) %))
                              stored-field-ids)
        parent-method    (partial (get-method sql.qp/apply-top-level-clause [:sql :breakout])
                                  driver clause honeysql-form)
        qualified        (parent-method query)
        unqualified      (parent-method (update query
                                                :breakout
                                                #(sql.qp/rewrite-fields-to-force-using-column-aliases % {:is-breakout true})))]
    (if (some lib.field/json-field? stored-fields)
      (merge qualified
             (select-keys unqualified #{:group-by}))
      qualified)))
(defn- order-by-is-json-field?
  [clause]
  (let [is-aggregation? (= (-> clause (second) (first)) :aggregation)
        stored-field-id (-> clause (second) (second))
        stored-field    (when (and (not is-aggregation?) (integer? stored-field-id))
                          (lib.metadata/field (qp.store/metadata-provider) stored-field-id))]
    (and
      (some? stored-field)
      (lib.field/json-field? stored-field))))
(defmethod sql.qp/->honeysql [:postgres :desc]
  [driver clause]
  (let [new-clause (if (order-by-is-json-field? clause)
                     (sql.qp/rewrite-fields-to-force-using-column-aliases clause)
                     clause)]
    ((get-method sql.qp/->honeysql [:sql :desc]) driver new-clause)))
(defmethod sql.qp/->honeysql [:postgres :asc]
  [driver clause]
  (let [new-clause (if (order-by-is-json-field? clause)
                     (sql.qp/rewrite-fields-to-force-using-column-aliases clause)
                     clause)]
    ((get-method sql.qp/->honeysql [:sql :asc]) driver new-clause)))
(defmethod unprepare/unprepare-value [:postgres Date]
  [_ value]
  (format "'%s'::timestamp" (u.date/format value)))
(prefer-method unprepare/unprepare-value [:sql Time] [:postgres Date])
(defmethod unprepare/unprepare-value [:postgres UUID]
  [_ value]
  (format "'%s'::uuid" value))

+----------------------------------------------------------------------------------------------------------------+ | metabase.driver.sql-jdbc impls | +----------------------------------------------------------------------------------------------------------------+

Map of default Postgres column types -> Field base types. Add more mappings here as you come across them.

(def ^:private default-base-types
  {:bigint        :type/BigInteger
   :bigserial     :type/BigInteger
   :bit           :type/*
   :bool          :type/Boolean
   :boolean       :type/Boolean
   :box           :type/*
   :bpchar        :type/Text ; "blank-padded char" is the internal name of "character"
   :bytea         :type/*    ; byte array
   :cidr          :type/Structured ; IPv4/IPv6 network address
   :circle        :type/*
   :citext        :type/Text ; case-insensitive text
   :date          :type/Date
   :decimal       :type/Decimal
   :float4        :type/Float
   :float8        :type/Float
   :geometry      :type/*
   :inet          :type/IPAddress
   :int           :type/Integer
   :int2          :type/Integer
   :int4          :type/Integer
   :int8          :type/BigInteger
   :interval      :type/*               ; time span
   :json          :type/JSON
   :jsonb         :type/JSON
   :line          :type/*
   :lseg          :type/*
   :macaddr       :type/Structured
   :money         :type/Decimal
   :numeric       :type/Decimal
   :path          :type/*
   :pg_lsn        :type/Integer         ; PG Log Sequence #
   :point         :type/*
   :real          :type/Float
   :serial        :type/Integer
   :serial2       :type/Integer
   :serial4       :type/Integer
   :serial8       :type/BigInteger
   :smallint      :type/Integer
   :smallserial   :type/Integer
   :text          :type/Text
   :time          :type/Time
   :timetz        :type/TimeWithLocalTZ
   :timestamp     :type/DateTime
   :timestamptz   :type/DateTimeWithLocalTZ
   :tsquery       :type/*
   :tsvector      :type/*
   :txid_snapshot :type/*
   :uuid          :type/UUID
   :varbit        :type/*
   :varchar       :type/Text
   :xml           :type/Structured
   (keyword "bit varying")                :type/*
   (keyword "character varying")          :type/Text
   (keyword "double precision")           :type/Float
   (keyword "time with time zone")        :type/Time
   (keyword "time without time zone")     :type/Time
   ;; TODO postgres also supports `timestamp(p) with time zone` where p is the precision
   ;; maybe we should switch this to use `sql-jdbc.sync/pattern-based-database-type->base-type`
   (keyword "timestamp with time zone")    :type/DateTimeWithTZ
   (keyword "timestamp without time zone") :type/DateTime})
(defmethod sql-jdbc.sync/database-type->base-type :postgres
  [_driver column]
  (if (contains? *enum-types* column)
    :type/PostgresEnum
    (default-base-types column)))
(defmethod sql-jdbc.sync/column->semantic-type :postgres
  [_driver database-type _column-name]
  ;; this is really, really simple right now.  if its postgres :json type then it's :type/SerializedJSON semantic-type
  (case database-type
    "json"  :type/SerializedJSON
    "jsonb" :type/SerializedJSON
    "xml"   :type/XML
    "inet"  :type/IPAddress
    nil))

If a value was uploaded for the SSL key, return whether it's using the PKCS-12 format.

(defn- pkcs-12-key-value?
  [ssl-key-value]
  (when ssl-key-value
    (= (second (re-find secret/uploaded-base-64-prefix-pattern ssl-key-value))
       "x-pkcs12")))

Builds the params to include in the JDBC connection spec for an SSL connection.

(defn- ssl-params
  [{:keys [ssl-key-value] :as db-details}]
  (let [ssl-root-cert   (when (contains? #{"verify-ca" "verify-full"} (:ssl-mode db-details))
                          (secret/db-details-prop->secret-map db-details "ssl-root-cert"))
        ssl-client-key  (when (:ssl-use-client-auth db-details)
                          (secret/db-details-prop->secret-map db-details "ssl-key"))
        ssl-client-cert (when (:ssl-use-client-auth db-details)
                          (secret/db-details-prop->secret-map db-details "ssl-client-cert"))
        ssl-key-pw      (when (:ssl-use-client-auth db-details)
                          (secret/db-details-prop->secret-map db-details "ssl-key-password"))
        all-subprops    (apply concat (map :subprops [ssl-root-cert ssl-client-key ssl-client-cert ssl-key-pw]))
        has-value?      (comp some? :value)]
    (cond-> (set/rename-keys db-details {:ssl-mode :sslmode})
      ;; if somehow there was no ssl-mode set, just make it required (preserves existing behavior)
      (nil? (:ssl-mode db-details))
      (assoc :sslmode "require")
      (has-value? ssl-root-cert)
      (assoc :sslrootcert (secret/value->file! ssl-root-cert :postgres))
      (has-value? ssl-client-key)
      (assoc :sslkey (secret/value->file! ssl-client-key :postgres (when (pkcs-12-key-value? ssl-key-value) ".p12")))
      (has-value? ssl-client-cert)
      (assoc :sslcert (secret/value->file! ssl-client-cert :postgres))
      ;; Pass an empty string as password if none is provided; otherwise the driver will prompt for one
      true
      (assoc :sslpassword (or (secret/value->string ssl-key-pw) ""))
      true
      (as-> params ;; from outer cond->
        (dissoc params :ssl-root-cert :ssl-root-cert-options :ssl-client-key :ssl-client-cert :ssl-key-password
                       :ssl-use-client-auth)
        (apply dissoc params all-subprops)))))

Params to include in the JDBC connection spec to disable SSL.

(def ^:private disable-ssl-params
  {:sslmode "disable"})
(defmethod sql-jdbc.conn/connection-details->spec :postgres
  [_ {ssl? :ssl, :as details-map}]
  (let [props (-> details-map
                  (update :port (fn [port]
                                  (if (string? port)
                                    (Integer/parseInt port)
                                    port)))
                  ;; remove :ssl in case it's false; DB will still try (& fail) to connect if the key is there
                  (dissoc :ssl))
        props (if ssl?
                (let [ssl-prms (ssl-params details-map)]
                  ;; if the user happened to specify any of the SSL options directly, allow those to take
                  ;; precedence, but only if they match a key from our own
                  ;; our `ssl-params` function is also removing various internal properties, ex: for secret resolution,
                  ;; so we can't just merge the entire `props` map back in here because it will bring all those
                  ;; internal property values back; only merge in the ones the driver might recognize
                  (merge ssl-prms (select-keys props (keys ssl-prms))))
                (merge disable-ssl-params props))
        props (as-> props it
                (set/rename-keys it {:dbname :db})
                (mdb.spec/spec :postgres it)
                (sql-jdbc.common/handle-additional-options it details-map))]
    props))
(defmethod sql-jdbc.sync/excluded-schemas :postgres [_driver] #{"information_schema" "pg_catalog"})
(defmethod sql-jdbc.execute/set-timezone-sql :postgres
  [_]
  "SET SESSION TIMEZONE TO %s;")

for some reason postgres TIMESTAMP WITH TIME ZONE columns still come back as Type/TIMESTAMP, which seems like a bug with the JDBC driver?

(defmethod sql-jdbc.execute/read-column-thunk [:postgres Types/TIMESTAMP]
  [_ ^ResultSet rs ^ResultSetMetaData rsmeta ^Integer i]
  (let [^Class klass (if (= (u/lower-case-en (.getColumnTypeName rsmeta i)) "timestamptz")
                       OffsetDateTime
                       LocalDateTime)]
    (fn []
      (.getObject rs i klass))))

Sometimes Postgres times come back as strings like 07:23:18.331+00 (no minute in offset) and there's a bug in the JDBC driver where it can't parse those correctly. We can do it ourselves in that case.

(defmethod sql-jdbc.execute/read-column-thunk [:postgres Types/TIME]
  [driver ^ResultSet rs rsmeta ^Integer i]
  (let [parent-thunk ((get-method sql-jdbc.execute/read-column-thunk [:sql-jdbc Types/TIME]) driver rs rsmeta i)]
    (fn []
      (try
        (parent-thunk)
        (catch Throwable e
          (let [s (.getString rs i)]
            (log/tracef e "Error in Postgres JDBC driver reading TIME value, fetching as string '%s'" s)
            (u.date/parse s)))))))

The postgres JDBC driver cannot properly read MONEY columns — see https://github.com/pgjdbc/pgjdbc/issues/425. Work around this by checking whether the column type name is money, and reading it out as a String and parsing to a BigDecimal if so; otherwise, proceeding as normal

(defmethod sql-jdbc.execute/read-column-thunk [:postgres Types/DOUBLE]
  [_driver ^ResultSet rs ^ResultSetMetaData rsmeta ^Integer i]
  (if (= (.getColumnTypeName rsmeta i) "money")
    (fn []
      (some-> (.getString rs i) u/parse-currency))
    (fn []
      (.getObject rs i))))

de-CLOB any CLOB values that come back

(defmethod sql-jdbc.execute/read-column-thunk :postgres
  [_ ^ResultSet rs _ ^Integer i]
  (fn []
    (let [obj (.getObject rs i)]
      (if (instance? org.postgresql.util.PGobject obj)
        (.getValue ^org.postgresql.util.PGobject obj)
        obj))))

Postgres doesn't support OffsetTime

(defmethod sql-jdbc.execute/set-parameter [:postgres OffsetTime]
  [driver prepared-statement i t]
  (let [local-time (t/local-time (t/with-offset-same-instant t (t/zone-offset 0)))]
    (sql-jdbc.execute/set-parameter driver prepared-statement i local-time)))
(defmethod driver/upload-type->database-type :postgres
  [_driver upload-type]
  (case upload-type
    ::upload/varchar-255              [[:varchar 255]]
    ::upload/text                     [:text]
    ::upload/int                      [:bigint]
    ::upload/auto-incrementing-int-pk [:bigserial :primary-key]
    ::upload/float                    [:float]
    ::upload/boolean                  [:boolean]
    ::upload/date                     [:date]
    ::upload/datetime                 [:timestamp]
    ::upload/offset-datetime          [:timestamp-with-time-zone]))
(defmethod driver/table-name-length-limit :postgres
  [_driver]
  ;; https://www.postgresql.org/docs/current/sql-syntax-lexical.html#SQL-SYNTAX-IDENTIFIERS
  ;; This could be incorrect if Postgres has been compiled with a value for NAMEDATALEN other than the default (64), but
  ;; that seems unlikely and there's not an easy way to find out.
  63)
(defn- format-copy
  [_clause table]
  [(str "COPY " (sql/format-entity table))])
(sql/register-clause! ::copy format-copy :insert-into)
(defn- format-from-stdin
  [_clause delimiter]
  [(str "FROM STDIN NULL " delimiter)])
(sql/register-clause! ::from-stdin format-from-stdin :from)
(defn- sanitize-value
  ;; Per https://www.postgresql.org/docs/current/sql-copy.html#id-1.9.3.55.9.2
  ;; "Backslash characters (\) can be used in the COPY data to quote data characters that might otherwise be taken as
  ;; row or column delimiters. In particular, the following characters must be preceded by a backslash if they appear
  ;; as part of a column value: backslash itself, newline, carriage return, and the current delimiter character."
  [v]
  (if (string? v)
    (str/replace v #"\\|\n|\r|\t" {"\\" "\\\\"
                                   "\n" "\\n"
                                   "\r" "\\r"
                                   "\t" "\\t"})
    v))
(defn- row->tsv
  [row]
  (->> row
       (map sanitize-value)
       (str/join "\t")))
(defmethod driver/insert-into! :postgres
  [driver db-id table-name column-names values]
  (jdbc/with-db-transaction [conn (sql-jdbc.conn/db->pooled-connection-spec db-id)]
    (let [copy-manager (CopyManager. (.unwrap ^Connection (:connection conn) PgConnection))
          [sql & _]    (sql/format {::copy       (keyword table-name)
                                    :columns     (map keyword column-names)
                                    ::from-stdin "''"}
                                   :quoted true
                                   :dialect (sql.qp/quote-style driver))
          ;; On Postgres with a large file, 100 (3.76m) was significantly faster than 50 (4.03m) and 25 (4.27m). 1,000 was a
          ;; little faster but not by much (3.63m), and 10,000 threw an error:
          ;;     PreparedStatement can have at most 65,535 parameters
          chunks (partition-all (or driver/*insert-chunk-rows* 1000) values)]
      (doseq [chunk chunks]
        (let [tsvs (->> chunk
                        (map row->tsv)
                        (str/join "\n")
                        (StringReader.))]
          (.copyIn copy-manager ^String sql tsvs))))))
(defmethod driver/current-user-table-privileges :postgres
  [_driver database]
  (let [conn-spec (sql-jdbc.conn/db->pooled-connection-spec database)]
    (jdbc/query
     conn-spec
     (str/join
      "\n"
      ["with table_privileges as ("
       "select"
       "  NULL as role,"
       "  t.schemaname as schema,"
       "  t.tablename as table,"
       "  pg_catalog.has_table_privilege(current_user, concat('\"', t.schemaname, '\"', '.', '\"', t.tablename, '\"'), 'SELECT') as select,"
       "  pg_catalog.has_table_privilege(current_user, concat('\"', t.schemaname, '\"', '.', '\"', t.tablename, '\"'), 'UPDATE') as update,"
       "  pg_catalog.has_table_privilege(current_user, concat('\"', t.schemaname, '\"', '.', '\"', t.tablename, '\"'), 'INSERT') as insert,"
       "  pg_catalog.has_table_privilege(current_user, concat('\"', t.schemaname, '\"', '.', '\"', t.tablename, '\"'), 'DELETE') as delete"
       "from pg_catalog.pg_tables t"
       "where t.schemaname !~ '^pg_'"
       "  and t.schemaname <> 'information_schema'"
       "  and pg_catalog.has_schema_privilege(current_user, t.schemaname, 'USAGE')"
       ")"
       "select t.*"
       "from table_privileges t"
       "where t.select or t.update or t.insert or t.delete"]))))

------------------------------------------------- User Impersonation --------------------------------------------------

(defmethod driver.sql/set-role-statement :postgres
  [_ role]
  (let [special-chars-pattern #"[^a-zA-Z0-9_]"
        needs-quote           (re-find special-chars-pattern role)]
    (if needs-quote
      (format "SET ROLE \"%s\";" role)
      (format "SET ROLE %s;" role))))
(defmethod driver.sql/default-database-role :postgres
  [_ _]
  "NONE")
 

Method impls for [[metabase.driver.sql-jdbc.actions]] for :postgres.

(ns metabase.driver.postgres.actions
  (:require
   [clojure.java.jdbc :as jdbc]
   [clojure.string :as str]
   [metabase.actions.error :as actions.error]
   [metabase.driver.sql-jdbc.actions :as sql-jdbc.actions]
   [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-trun tru]]))
(set! *warn-on-reflection* true)

Given a constraint with constraint-name fetch the column names associated with that constraint.

TODO -- we should probably be TTL caching this information. Otherwise parsing 100 errors for a bulk action will result in 100 identical data warehouse queries. It's not like constraint columns are something we would expect to change regularly anyway.

(defn- constraint->column-names
  [database constraint-name]
  (let [jdbc-spec (sql-jdbc.conn/db->pooled-connection-spec (u/the-id database))
        sql-args  ["select column_name from information_schema.constraint_column_usage where constraint_name = ?" constraint-name]]
    (into []
          (map :column_name)
          (jdbc/reducible-query jdbc-spec sql-args {:identifers identity, :transaction? false}))))
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:postgres actions.error/violate-not-null-constraint]
  [_driver error-type _database _action-type error-message]
  (when-let [[_ column]
             (re-find #"null value in column \"([^\"]+)\".*violates not-null constraint"  error-message)]
    {:type    error-type
     :message (tru "{0} must have values." (str/capitalize column))
     :errors  {column (tru "You must provide a value.")}}))
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:postgres actions.error/violate-unique-constraint]
  [_driver error-type database _action-type error-message]
  (when-let [[_match constraint _value]
             (re-find #"duplicate key value violates unique constraint \"([^\"]+)\"" error-message)]
    (let [columns (constraint->column-names database constraint)]
      {:type    error-type
       :message (tru "{0} already {1}." (u/build-sentence (map str/capitalize columns) :stop? false) (deferred-trun "exists" "exist" (count columns)))
       :errors  (reduce (fn [acc col]
                          (assoc acc col (tru "This {0} value already exists." (str/capitalize col))))
                        {}
                        columns)})))
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:postgres actions.error/violate-foreign-key-constraint]
  [_driver error-type _database action-type error-message]
  (or (when-let [[_match _table _constraint _ref-table column _value _ref-table-2]
                 (re-find #"update or delete on table \"([^\"]+)\" violates foreign key constraint \"([^\"]+)\" on table \"([^\"]+)\"\n  Detail: Key \((.*?)\)=\((.*?)\) is still referenced from table \"([^\"]+)\"" error-message)]
        (merge {:type error-type}
               (case action-type
                 :row/delete
                 {:message (tru "Other tables rely on this row so it cannot be deleted.")
                  :errors  {}}

                 :row/update
                 {:message (tru "Unable to update the record.")
                  :errors  {column (tru "This {0} does not exist." (str/capitalize column))}})))
      (when-let [[_match _table _constraint column _value _ref-table]
                 (re-find #"insert or update on table \"([^\"]+)\" violates foreign key constraint \"([^\"]+)\"\n  Detail: Key \((.*?)\)=\((.*?)\) is not present in table \"([^\"]+)\"" error-message)]
          {:type    error-type
           :message (case action-type
                      :row/create
                      (tru "Unable to create a new record.")

                      :row/update
                      (tru "Unable to update the record."))
           :errors  {column (tru "This {0} does not exist." (str/capitalize column))}})))
(defmethod sql-jdbc.actions/maybe-parse-sql-error [:postgres actions.error/incorrect-value-type]
  [_driver error-type _database _action-type error-message]
  (when-let [[_] (re-find #"invalid input syntax for .*" error-message)]
    {:type    error-type
     :message (tru "Some of your values aren’t of the correct type for the database.")
     :errors  {}}))
(defmethod sql-jdbc.actions/base-type->sql-type-map :postgres
  [_driver]
  {:type/BigInteger          "BIGINT"
   :type/Boolean             "BOOL"
   :type/Date                "DATE"
   :type/DateTime            "TIMESTAMP"
   :type/DateTimeWithTZ      "TIMESTAMP WITH TIME ZONE"
   :type/DateTimeWithLocalTZ "TIMESTAMP WITH TIME ZONE"
   :type/Decimal             "DECIMAL"
   :type/Float               "FLOAT"
   :type/Integer             "INTEGER"
   :type/IPAddress           "INET"
   :type/JSON                "JSON"
   :type/Text                "TEXT"
   :type/Time                "TIME"
   :type/TimeWithTZ          "TIME WITH TIME ZONE"
   :type/UUID                "UUID"})

For Postgres creating a Savepoint and rolling it back on error seems to be enough to let the parent transaction proceed if some particular statement encounters an error.

(defmethod sql-jdbc.actions/do-nested-transaction :postgres
  [_driver ^java.sql.Connection conn thunk]
  (let [savepoint (.setSavepoint conn)]
    (try
      (thunk)
      (catch Throwable e
        (.rollback conn savepoint)
        (throw e))
      (finally
        (.releaseSavepoint conn savepoint)))))

Add returning * so that we don't have to make an additional query.

(defmethod sql-jdbc.actions/prepare-query* [:postgres :row/create]
  [_driver _action hsql-query]
  (assoc hsql-query :returning [:*]))

Result is already the created row.

(defmethod sql-jdbc.actions/select-created-row :postgres
  [_driver _create-hsql _conn result]
  result)
 
(ns metabase.driver.postgres.ddl
  (:require
   [clojure.java.jdbc :as jdbc]
   [honey.sql :as sql]
   [java-time.api :as t]
   [metabase.driver.ddl.interface :as ddl.i]
   [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute]
   [metabase.driver.sql.ddl :as sql.ddl]
   [metabase.public-settings :as public-settings]
   [metabase.query-processor :as qp]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]))
(set! *warn-on-reflection* true)

Must be called within a transaction. Sets the current transaction statement_timeout to the minimum of the current (non-zero) value and ten minutes.

This helps to address unexpectedly large/long running queries.

(defn- set-statement-timeout!
  [tx]
  (let [existing-timeout (->> #_{:clj-kondo/ignore [:discouraged-var]}
                              (sql/format {:select [:setting]
                                           :from   [:pg_settings]
                                           :where  [:= :name "statement_timeout"]}
                                          {:quoted false})
                              (sql.ddl/jdbc-query tx)
                              first
                              :setting
                              parse-long)
        ten-minutes      (.toMillis (t/minutes 10))
        new-timeout      (if (zero? existing-timeout)
                           ten-minutes
                           (min ten-minutes existing-timeout))]
    ;; Can't use a prepared parameter with these statements
    (sql.ddl/execute! tx [(format "SET LOCAL statement_timeout TO '%s'" (str new-timeout))])))
(defmethod ddl.i/refresh! :postgres
  [driver database definition dataset-query]
  (let [{:keys [query params]} (qp/compile dataset-query)]
    (sql-jdbc.execute/do-with-connection-with-options
     driver
     database
     {:write? true}
     (fn [^java.sql.Connection conn]
       (jdbc/with-db-transaction [tx {:connection conn}]
         (set-statement-timeout! tx)
         (sql.ddl/execute! tx [(sql.ddl/drop-table-sql database (:table-name definition))])
         (sql.ddl/execute! tx (into [(sql.ddl/create-table-sql database definition query)] params)))
       {:state :success}))))
(defmethod ddl.i/unpersist! :postgres
  [driver database persisted-info]
  (sql-jdbc.execute/do-with-connection-with-options
   driver
   database
   {:write? true}
   (fn [conn]
     (try
       (sql.ddl/execute! conn [(sql.ddl/drop-table-sql database (:table_name persisted-info))])
       (catch Exception e
         (log/warn e)
         (throw e))))))
(defmethod ddl.i/check-can-persist :postgres
  [{driver :engine, :as database}]
  (let [schema-name (ddl.i/schema-name database (public-settings/site-uuid))
        table-name  (format "persistence_check_%s" (rand-int 10000))
        steps       [[:persist.check/create-schema
                      (fn check-schema [conn]
                        (let [existing-schemas (->> ["select schema_name from information_schema.schemata"]
                                                    (sql.ddl/jdbc-query conn)
                                                    (map :schema_name)
                                                    (into #{}))]
                          (or (contains? existing-schemas schema-name)
                              (sql.ddl/execute! conn [(sql.ddl/create-schema-sql database)]))))]
                     [:persist.check/create-table
                      (fn create-table [conn]
                        (sql.ddl/execute! conn [(sql.ddl/create-table-sql database
                                                                          {:table-name table-name
                                                                           :field-definitions [{:field-name "field"
                                                                                                :base-type :type/Text}]}
                                                                          "select 1")]))]
                     [:persist.check/read-table
                      (fn read-table [conn]
                        (sql.ddl/jdbc-query conn [(format "select * from %s.%s"
                                                          schema-name table-name)]))]
                     [:persist.check/delete-table
                      (fn delete-table [conn]
                        (sql.ddl/execute! conn [(sql.ddl/drop-table-sql database table-name)]))]
                     [:persist.check/create-kv-table
                      (fn create-kv-table [conn]
                        (sql.ddl/execute! conn [(format "drop table if exists %s.cache_info"
                                                        schema-name)])
                        (sql.ddl/execute! conn (sql/format
                                                (ddl.i/create-kv-table-honey-sql-form schema-name)
                                                {:dialect :ansi})))]
                     [:persist.check/populate-kv-table
                      (fn create-kv-table [conn]
                        (sql.ddl/execute! conn (sql/format
                                                (ddl.i/populate-kv-table-honey-sql-form
                                                 schema-name)
                                                {:dialect :ansi})))]]]
    (sql-jdbc.execute/do-with-connection-with-options
     driver
     database
     {:write? true}
     (fn [^java.sql.Connection conn]
       (jdbc/with-db-transaction
         [tx {:connection conn}]
         (set-statement-timeout! tx)
         (loop [[[step stepfn] & remaining] steps]
           (let [result (try (stepfn tx)
                             (log/info (trs "Step {0} was successful for db {1}"
                                            step (:name database)))
                             ::valid
                             (catch Exception e
                               (log/warn (trs "Error in `{0}` while checking for model persistence permissions." step))
                               (log/warn e)
                               step))]
             (cond (and (= result ::valid) remaining)
                   (recur remaining)

                   (= result ::valid)
                   [true :persist.check/valid]

                   :else [false step]))))))))
 

Shared code for all drivers that use SQL under the hood.

(ns metabase.driver.sql
  (:require
   [metabase.driver :as driver]
   [metabase.driver.common.parameters.parse :as params.parse]
   [metabase.driver.common.parameters.values :as params.values]
   [metabase.driver.sql.parameters.substitute :as sql.params.substitute]
   [metabase.driver.sql.parameters.substitution
    :as sql.params.substitution]
   [metabase.driver.sql.query-processor :as sql.qp]
   [metabase.driver.sql.util :as sql.u]
   [metabase.driver.sql.util.unprepare :as unprepare]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [potemkin :as p]))
(comment sql.params.substitution/keep-me) ; this is so `cljr-clean-ns` and the linter don't remove the `:require`
(driver/register! :sql, :abstract? true)
(doseq [feature [:standard-deviation-aggregations
                 :foreign-keys
                 :expressions
                 :expression-aggregations
                 :native-parameters
                 :nested-queries
                 :binning
                 :advanced-math-expressions
                 :percentile-aggregations
                 :regex]]
  (defmethod driver/database-supports? [:sql feature] [_driver _feature _db] true))
(doseq [join-feature [:left-join
                      :right-join
                      :inner-join
                      :full-join]]
  (defmethod driver/database-supports? [:sql join-feature]
    [driver _feature db]
    (driver/database-supports? driver :foreign-keys db)))
(defmethod driver/database-supports? [:sql :persist-models-enabled]
  [driver _feat db]
  (and
    (driver/database-supports? driver :persist-models db)
    (-> db :settings :persist-models-enabled)))
(defmethod driver/mbql->native :sql
  [driver query]
  (sql.qp/mbql->native driver query))
(defmethod driver/prettify-native-form :sql
  [driver native-form]
  (sql.u/format-sql-and-fix-params driver native-form))
(mu/defmethod driver/substitute-native-parameters :sql
  [_driver {:keys [query] :as inner-query} :- [:and [:map-of :keyword :any] [:map {:query ms/NonBlankString}]]]
  (let [[query params] (-> query
                           params.parse/parse
                           (sql.params.substitute/substitute (params.values/query->params-map inner-query)))]
    (assoc inner-query
           :query query
           :params params)))

:sql drivers almost certainly don't need to override this method, and instead can implement unprepare/unprepare-value for specific classes, or, in extereme cases, unprepare/unprepare itself.

(defmethod driver/splice-parameters-into-native-query :sql
  [driver {:keys [params], sql :query, :as query}]
  (cond-> query
    (seq params)
    (merge {:params nil
            :query  (unprepare/unprepare driver (cons sql params))})))

+----------------------------------------------------------------------------------------------------------------+ | Connection Impersonation | +----------------------------------------------------------------------------------------------------------------+

SQL for setting the active role for a connection, such as USE ROLE or equivalent, for the given driver.

(defmulti set-role-statement
  {:added "0.47.0" :arglists '([driver role])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
(defmethod set-role-statement :default
  [_ _ _]
  nil)

The name of the default role for a given database, used for queries that do not have custom user impersonation rules configured for them. This must be implemented for each driver that supports user impersonation.

(defmulti default-database-role
  {:added "0.47.0" :arglists '(^String [driver database])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
(defmethod default-database-role :default
  [_ _database]
  nil)

+----------------------------------------------------------------------------------------------------------------+ | Convenience Imports | +----------------------------------------------------------------------------------------------------------------+

(p/import-vars [sql.params.substitution ->prepared-substitution PreparedStatementSubstitution])

TODO - we should add imports for sql.qp and other namespaces to make driver implementation more straightforward

 

Shared code for drivers for SQL databases using their respective JDBC drivers under the hood.

(ns metabase.driver.sql-jdbc
  (:require
   [clojure.java.jdbc :as jdbc]
   [honey.sql :as sql]
   [metabase.driver :as driver]
   [metabase.driver.sql :as driver.sql]
   [metabase.driver.sql-jdbc.actions :as sql-jdbc.actions]
   [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn]
   [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute]
   [metabase.driver.sql-jdbc.sync :as sql-jdbc.sync]
   [metabase.driver.sql-jdbc.sync.interface :as sql-jdbc.sync.interface]
   [metabase.driver.sql.query-processor :as sql.qp]
   [metabase.driver.sync :as driver.s]
   [metabase.query-processor.writeback :as qp.writeback]
   [metabase.util.honey-sql-2 :as h2x])
  (:import
   (java.sql Connection)))
(set! *warn-on-reflection* true)
(comment sql-jdbc.actions/keep-me)
(driver/register! :sql-jdbc, :parent :sql, :abstract? true)

+----------------------------------------------------------------------------------------------------------------+ | Run a Query | +----------------------------------------------------------------------------------------------------------------+

Execute a honeysql-form query against database, driver, and optionally table.

TODO - Seems like this is only used in a handful of places, consider moving to util namespace

(defn query
  ([driver database honeysql-form]
   (jdbc/query (sql-jdbc.conn/db->pooled-connection-spec database)
               (sql.qp/format-honeysql driver honeysql-form)))
  ([driver database table honeysql-form]
   (let [table-identifier (sql.qp/->honeysql driver (h2x/identifier :table (:schema table) (:name table)))]
     (query driver database (merge {:from [[table-identifier]]}
                                   honeysql-form)))))

+----------------------------------------------------------------------------------------------------------------+ | Default SQL JDBC metabase.driver impls | +----------------------------------------------------------------------------------------------------------------+

(defmethod driver/can-connect? :sql-jdbc
  [driver details]
  (sql-jdbc.conn/can-connect? driver details))
(defmethod driver/table-rows-seq :sql-jdbc
  [driver database table]
  (query driver database table {:select [:*]}))
(defn- has-method? [driver multifn]
  {:pre [(keyword? driver)]}
  (when-let [driver-method (get-method multifn driver)]
    (and driver-method
         (not (identical? driver-method (get-method multifn :sql-jdbc)))
         (not (identical? driver-method (get-method multifn :default))))))

TODO - this implementation should itself be deprecated! And have drivers implement it directly instead.

(defmethod driver/database-supports? [:sql-jdbc :set-timezone]
  [driver _feature _db]
  (boolean (seq (sql-jdbc.execute/set-timezone-sql driver))))
(defmethod driver/db-default-timezone :sql-jdbc
  [driver database]
  ;; if the driver has a non-default implementation of [[sql-jdbc.sync/db-default-timezone]], use that.
  #_{:clj-kondo/ignore [:deprecated-var]}
  (if (has-method? driver sql-jdbc.sync/db-default-timezone)
    (sql-jdbc.sync/db-default-timezone driver (sql-jdbc.conn/db->pooled-connection-spec database))
    ;; otherwise fall back to the default implementation.
    ((get-method driver/db-default-timezone :metabase.driver/driver) driver database)))
(defmethod driver/execute-reducible-query :sql-jdbc
  [driver query chans respond]
  (sql-jdbc.execute/execute-reducible-query driver query chans respond))
(defmethod driver/notify-database-updated :sql-jdbc
  [_ database]
  (sql-jdbc.conn/invalidate-pool-for-db! database))
(defmethod driver/dbms-version :sql-jdbc
  [driver database]
  (sql-jdbc.sync/dbms-version driver (sql-jdbc.conn/db->pooled-connection-spec database)))
(defmethod driver/describe-database :sql-jdbc
  [driver database]
  (sql-jdbc.sync/describe-database driver database))
(defmethod driver/describe-table :sql-jdbc
  [driver database table]
  (sql-jdbc.sync/describe-table driver database table))
(defmethod driver/describe-table-fks :sql-jdbc
  [driver database table]
  (sql-jdbc.sync/describe-table-fks driver database table))
(defmethod driver/describe-table-indexes :sql-jdbc
  [driver database table]
  (sql-jdbc.sync/describe-table-indexes driver database table))
(defmethod sql.qp/cast-temporal-string [:sql-jdbc :Coercion/ISO8601->DateTime]
  [_driver _semantic_type expr]
  (h2x/->timestamp expr))
(defmethod sql.qp/cast-temporal-string [:sql-jdbc :Coercion/ISO8601->Date]
  [_driver _semantic_type expr]
  (h2x/->date expr))
(defmethod sql.qp/cast-temporal-string [:sql-jdbc :Coercion/ISO8601->Time]
  [_driver _semantic_type expr]
  (h2x/->time expr))
(defmethod sql.qp/cast-temporal-string [:sql-jdbc :Coercion/YYYYMMDDHHMMSSString->Temporal]
  [_driver _semantic_type expr]
  (h2x/->timestamp expr))
(defn- create-table-sql
  [driver table-name col->type]
  (first (sql/format {:create-table (keyword table-name)
                      :with-columns (map (fn [[name type-spec]]
                                           (vec (cons name type-spec)))
                                         col->type)}
                     :quoted true
                     :dialect (sql.qp/quote-style driver))))
(defmethod driver/create-table! :sql-jdbc
  [driver db-id table-name col->type]
  (let [sql (create-table-sql driver table-name col->type)]
    (qp.writeback/execute-write-sql! db-id sql)))
(defmethod driver/drop-table! :sql-jdbc
  [driver db-id table-name]
  (let [sql (first (sql/format {:drop-table [:if-exists (keyword table-name)]}
                               :quoted true
                               :dialect (sql.qp/quote-style driver)))]
    (qp.writeback/execute-write-sql! db-id sql)))
(defmethod driver/insert-into! :sql-jdbc
  [driver db-id table-name column-names values]
  (let [table-name (keyword table-name)
        columns    (map keyword column-names)
        ;; We need to partition the insert into multiple statements for both performance and correctness.
        ;;
        ;; On Postgres with a large file, 100 (3.76m) was significantly faster than 50 (4.03m) and 25 (4.27m). 1,000 was a
        ;; little faster but not by much (3.63m), and 10,000 threw an error:
        ;;     PreparedStatement can have at most 65,535 parameters
        ;; One imagines that `(long (/ 65535 (count columns)))` might be best, but I don't trust the 65K limit to apply
        ;; across all drivers. With that in mind, 100 seems like a safe compromise.
        ;; There's nothing magic about 100, but it felt good in testing. There could well be a better number.
        chunks     (partition-all (or driver/*insert-chunk-rows* 100) values)
        sqls       (map #(sql/format {:insert-into table-name
                                      :columns     columns
                                      :values      %}
                                     :quoted true
                                     :dialect (sql.qp/quote-style driver))
                        chunks)]
    (jdbc/with-db-transaction [conn (sql-jdbc.conn/db->pooled-connection-spec db-id)]
      (doseq [sql sqls]
        (jdbc/execute! conn sql)))))
(defmethod driver/add-columns! :sql-jdbc
  [driver db-id table-name col->type]
  (let [sql (first (sql/format {:alter-table (keyword table-name)
                                :add-column (map (fn [[name type-spec]]
                                                   (vec (cons name type-spec)))
                                                 col->type)}
                               :quoted true
                               :dialect (sql.qp/quote-style driver)))]
    (qp.writeback/execute-write-sql! db-id sql)))
(defmethod driver/syncable-schemas :sql-jdbc
  [driver database]
  (sql-jdbc.execute/do-with-connection-with-options
   driver
   database
   nil
   (fn [^java.sql.Connection conn]
     (let [[inclusion-patterns
            exclusion-patterns] (driver.s/db-details->schema-filter-patterns database)]
       (into #{} (sql-jdbc.sync.interface/filtered-syncable-schemas driver conn (.getMetaData conn) inclusion-patterns exclusion-patterns))))))
(defmethod driver/set-role! :sql-jdbc
  [driver conn role]
  (let [sql (driver.sql/set-role-statement driver role)]
    (with-open [stmt (.createStatement ^Connection conn)]
      (.execute stmt sql))))
 
(ns metabase.driver.sql-jdbc.actions
  (:require
   [clojure.java.jdbc :as jdbc]
   [clojure.set :as set]
   [clojure.string :as str]
   [flatland.ordered.set :as ordered-set]
   [medley.core :as m]
   [metabase.actions :as actions]
   [metabase.driver :as driver]
   [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute]
   [metabase.driver.sql.query-processor :as sql.qp]
   [metabase.driver.util :as driver.u]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.query-processor :as qp]
   [metabase.query-processor.store :as qp.store]
   [metabase.util :as u]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [schema.core :as s])
  (:import
   (java.sql Connection SQLException)))
(set! *warn-on-reflection* true)

+----------------------------------------------------------------------------------------------------------------+ | Error handling | +----------------------------------------------------------------------------------------------------------------+

Try to parse the SQL error message returned by JDBC driver.

The methods should returns a map of: - type: the error type. Check [[metabase.actions.error]] for the full list - message: a nice message summarized of what went wrong - errors: a map from field-name => sepcific error message. This is used by UI to display per fields error If non per-column error is available, returns an empty map.

Or return nil if the parser doesn't match.

(defmulti maybe-parse-sql-error
  {:changelog-test/ignore true, :arglists '([driver error-type database action-type error-message]), :added "0.48.0"}
  (fn [driver error-type _database _action-type _error-message]
   [(driver/dispatch-on-initialized-driver driver) error-type])
  :hierarchy #'driver/hierarchy)
(defmethod maybe-parse-sql-error :default
  [_driver _error-type _database _e]
  nil)
(defn- parse-sql-error
  [driver database action-type e]
  (let [parsers-for-driver (keep (fn [[[method-driver error-type] method]]
                                   (when (= method-driver driver)
                                     (partial method driver error-type)))
                                 (dissoc (methods maybe-parse-sql-error) :default))]
    (try
     (some #(% database action-type (ex-message e)) parsers-for-driver)
     ;; Catch errors in parse-sql-error and log them so more errors in the future don't break the entire action.
     ;; We'll still get the original unparsed error message.
     (catch Throwable new-e
       (log/error new-e (trs "Error parsing SQL error message {0}: {1}" (pr-str (ex-message e)) (ex-message new-e)))
       nil))))
(defn- do-with-auto-parse-sql-error
  [driver database action thunk]
  (try
   (thunk)
   (catch SQLException e
     (throw (ex-info (or (ex-message e) "Error executing action.")
                     (merge (or (some-> (parse-sql-error driver database action e)
                                        ;; the columns in error message should match with columns
                                        ;; in the parameter. It's usually got from calling
                                        ;; GET /api/action/:id/execute, and in there all column names are slugified
                                        (m/update-existing :errors update-keys u/slugify))
                                (assoc (ex-data e) :message (ex-message e)))
                            {:status-code 400}))))))

Execute body and if there is an exception, try to parse the error message to search for known sql errors then throw a regular (and easier to understand/process) exception.

(defmacro ^:private with-auto-parse-sql-exception
  [driver database action-type & body]
  `(do-with-auto-parse-sql-error ~driver ~database ~action-type (fn [] ~@body)))
(defn- mbql-query->raw-hsql
  [driver {database-id :database, :as query}]
  (qp.store/with-metadata-provider database-id
    ;; catch errors in the query
    (qp/preprocess query)
    (sql.qp/mbql->honeysql driver query)))

+----------------------------------------------------------------------------------------------------------------+ | Action Execution | +----------------------------------------------------------------------------------------------------------------+

Return a map of [[metabase.types]] type to SQL string type name. Used for casting. Looks like we're just copypasting this from implementations of [[metabase.test.data.sql/field-base-type->sql-type]] so go find that stuff if you need to write more implementations for this.

(defmulti base-type->sql-type-map
  {:changelog-test/ignore true, :arglists '([driver]), :added "0.44.0"}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

Certain value types need to have their honeysql form updated to work properly during update/creation. This function uses honeysql casting to wrap values in the map that need to be cast with their column's type, and passes through types that do not need casting like integer or string.

(defn- cast-values
  [driver column->value database-id table-id]
  (let [type->sql-type (base-type->sql-type-map driver)
        column->field  (actions/cached-value
                        [::cast-values table-id]
                        (fn []
                          (into {}
                                #_{:clj-kondo/ignore [:deprecated-var]}
                                (map (juxt :name qp.store/->legacy-metadata))
                                (qp.store/with-metadata-provider database-id
                                  (lib.metadata.protocols/fields (qp.store/metadata-provider) table-id)))))]
    (m/map-kv-vals (fn [col-name value]
                     (let [col-name                         (u/qualified-name col-name)
                           {base-type :base_type :as field} (get column->field col-name)]
                       (if-let [sql-type (type->sql-type base-type)]
                         (h2x/cast sql-type value)
                         (try
                           (sql.qp/->honeysql driver [:value value field])
                           (catch Exception e
                             (throw (ex-info (str "column cast failed: " (pr-str col-name))
                                             {:column      col-name
                                              :status-code 400}
                                             e)))))))
                   column->value)))

Data warehouse JDBC Connection to use for doing CRUD Actions. Bind this to reuse the same Connection/transaction throughout a single bulk Action.

(def ^:private ^:dynamic ^Connection *connection*
  nil)

Impl function for [[with-jdbc-transaction]].

Why not just use [[jdbc/with-db-transaction]] to do this stuff? Why reinvent the wheel?

There are a few reasons:

  1. [[jdbc/with-db-transaction]] "absorbs" nested transactions, but this only works if you take the transaction connection spec bound there and pass it around explicitly to subsequent calls to [[jdbc/with-db-transaction]]. This makes it hard to write bulk Actions as loops with repeated calls to single-row Actions. Of course, we could just tweak the Actions so there was some way you could pass in an existing Connection or Connection spec for it to use. But that would be a little more ugly and complicated than having a dynamic var. So we'd likely end up with some sort of dynamic var and with- macro anyway to avoid repeated boilerplate. And it would likely make [[do-nested-transaction]] harder to use or implement.

  2. [[jdbc/with-db-transaction]] does a lot of magic that we don't necessarily want. Writing raw JDBC code is barely any more code and lets us have complete control over what happens and lets us see at a glance exactly what's happening without having to keep [[clojure.java.jdbc]] magic in mind or work around it.

(defn do-with-jdbc-transaction
  [database-id f]
  (if *connection*
    (f *connection*)
    (let [driver (driver.u/database->driver database-id)]
      (sql-jdbc.execute/do-with-connection-with-options
       driver
       database-id
       {:write? true}
       (fn [^Connection conn]
         ;; execute inside of a transaction.
         (.setAutoCommit conn false)
         (log/tracef "BEGIN transaction on conn %s@0x%s" (.getCanonicalName (class conn)) (System/identityHashCode conn))
         (try
           (let [result (binding [*connection* conn]
                          (f conn))]
             (log/debug "f completed successfully; committing transaction.")
             (log/tracef "COMMIT transaction on conn %s@0x%s" (.getCanonicalName (class conn)) (System/identityHashCode conn))
             (.commit conn)
             result)
           (catch Throwable e
             (log/debugf "f threw Exception; rolling back transaction. Error: %s" (ex-message e))
             (log/tracef "ROLLBACK transaction on conn %s@0x%s" (.getCanonicalName (class conn)) (System/identityHashCode conn))
             (.rollback conn)
             (throw e))))))))

Execute f with a JDBC Connection for the Database with database-id. Uses [[connection]] if already bound, otherwise fetches a new Connection from the Database's Connection pool and executes f inside of a transaction.

(defmacro with-jdbc-transaction
  {:style/indent 1}
  [[connection-binding database-id] & body]
  `(do-with-jdbc-transaction ~database-id (fn [~(vary-meta connection-binding assoc :tag 'Connection)] ~@body)))

Multimethod for preparing a honeysql query hsql-query for a given action type action. action is a keyword like :row/create or :bulk/create; hsql-query is a generic query of the type corresponding to action.

(defmulti prepare-query*
  {:changelog-test/ignore true, :arglists '([driver action hsql-query]), :added "0.46.0"}
  (fn [driver action _]
    [(driver/dispatch-on-initialized-driver driver)
     (keyword action)])
  :hierarchy #'driver/hierarchy)
(defmethod prepare-query* :default
  [_driver _action hsql-query]
  hsql-query)
(defn- prepare-query [hsql-query driver action]
  (prepare-query* driver action hsql-query))
(defmethod actions/perform-action!* [:sql-jdbc :row/delete]
  [driver action database {database-id :database, :as query}]
  (let [raw-hsql    (mbql-query->raw-hsql driver query)
        delete-hsql (-> raw-hsql
                        (dissoc :select)
                        (assoc :delete [])
                        (prepare-query driver action))
        sql-args    (sql.qp/format-honeysql driver delete-hsql)]
    (with-jdbc-transaction [conn database-id]
      ;; TODO -- this should probably be using [[metabase.driver/execute-write-query!]]
      (let [rows-deleted (with-auto-parse-sql-exception driver database action
                           (first (jdbc/execute! {:connection conn} sql-args {:transaction? false})))]
        (when-not (= rows-deleted 1)
          (throw (ex-info (if (zero? rows-deleted)
                            (tru "Sorry, the row you''re trying to delete doesn''t exist")
                            (tru "Sorry, this would delete {0} rows, but you can only act on 1" rows-deleted))
                          {:staus-code 400})))
        {:rows-deleted [1]}))))
(defmethod actions/perform-action!* [:sql-jdbc :row/update]
  [driver action database {database-id :database :keys [update-row] :as query}]
  (let [update-row   (update-keys update-row keyword)
        raw-hsql     (mbql-query->raw-hsql driver query)
        target-table (first (:from raw-hsql))
        update-hsql  (-> raw-hsql
                         (select-keys [:where])
                         (assoc :update target-table
                                :set (cast-values driver update-row database-id (get-in query [:query :source-table])))
                         (prepare-query driver action))
        sql-args     (sql.qp/format-honeysql driver update-hsql)]
    (with-jdbc-transaction [conn database-id]
      ;; TODO -- this should probably be using [[metabase.driver/execute-write-query!]]
      (let [rows-updated (with-auto-parse-sql-exception driver database action
                           (first (jdbc/execute! {:connection conn} sql-args {:transaction? false})))]
        (when-not (= rows-updated 1)
          (throw (ex-info (if (zero? rows-updated)
                            (tru "Sorry, the row you''re trying to update doesn''t exist")
                            (tru "Sorry, this would update {0} rows, but you can only act on 1" rows-updated))
                          {:staus-code 400})))
        {:rows-updated [1]}))))

Multimethod for converting the result of an insert into the created row. create-hsql is the honeysql query used to insert the new row, conn is the DB connection used to insert the new row and result is the value returned by the insert command.

(defmulti select-created-row
  {:changelog-test/ignore true, :arglists '([driver create-hsql conn result]), :added "0.46.0"}
  (fn [driver _ _ _]
    (driver/dispatch-on-initialized-driver driver))
  :hierarchy #'driver/hierarchy)

H2 and MySQL are dumb and RETURN_GENERATED_KEYS only returns the ID of the newly created row. This function will SELECT the newly created row assuming that result is a map from column names to the generated values.

(defmethod select-created-row :default
  [driver create-hsql conn result]
  (let [select-hsql     (-> create-hsql
                            (dissoc :insert-into :values)
                            (assoc :select [:*]
                                   :from [(:insert-into create-hsql)]
                                   ;; :and with a single clause will be optimized in HoneySQL
                                   :where (into [:and]
                                                (for [[col val] result]
                                                  [:= (keyword col) val]))))
        select-sql-args (sql.qp/format-honeysql driver select-hsql)]
    (log/tracef ":row/create SELECT HoneySQL:\n\n%s" (u/pprint-to-str select-hsql))
    (log/tracef ":row/create SELECT SQL + args:\n\n%s" (u/pprint-to-str select-sql-args))
    (first (jdbc/query {:connection conn} select-sql-args {:identifiers identity, :transaction? false}))))
(defmethod actions/perform-action!* [:sql-jdbc :row/create]
  [driver action database {database-id :database :keys [create-row] :as query}]
  (let [create-row  (update-keys create-row keyword)
        raw-hsql    (mbql-query->raw-hsql driver query)
        create-hsql (-> raw-hsql
                        (assoc :insert-into (first (:from raw-hsql)))
                        (assoc :values [(cast-values driver create-row database-id (get-in query [:query :source-table]))])
                        (dissoc :select :from)
                        (prepare-query driver action))
        sql-args    (sql.qp/format-honeysql driver create-hsql)]
    (log/tracef ":row/create HoneySQL:\n\n%s" (u/pprint-to-str create-hsql))
    (log/tracef ":row/create SQL + args:\n\n%s" (u/pprint-to-str sql-args))
    (with-jdbc-transaction [conn database-id]
      (let [result (with-auto-parse-sql-exception driver database action
                     (jdbc/execute! {:connection conn} sql-args {:return-keys true, :identifiers identity, :transaction? false}))
            _      (log/tracef ":row/create INSERT returned\n\n%s" (u/pprint-to-str result))
            row    (select-created-row driver create-hsql conn result)]
        (log/tracef ":row/create returned row %s" (pr-str row))
        {:created-row row}))))

Bulk actions

Execute thunk inside a nested transaction inside connection, which is currently in a transaction. If thunk throws an Exception, the nested transaction should be rolled back, but the parent transaction should be able to proceed.

Why do we need this?

With things like bulk insert, we want to collect all the errors for all the rows in one go. Say you have 4 rows, 1 2 3 and 4. If 1 errors then depending on the DBMS, the transaction enters an error state that disallows doing anything else. 2, 3, and 4 will error with a "transaction has been aborted" error that you can't clear (AFAIK). This affects Postgres but not H2. Not sure about other DBs yet.

Without using nested transactions, if you have errors in rows 2 and 4 you'd only see the error in row 2 since 3 and 4 would fail with "transaction has been aborted" or whatever.

So the point of using nested transactions is that if 2 is done inside a nested transaction we can rollback the nested transaction which allows the top-level transaction to proceed even tho part of it errored.

(defmulti do-nested-transaction
  {:changelog-test/ignore true :arglists '([driver ^java.sql.Connection connection thunk]), :added "0.44.0"}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
(defn- perform-bulk-action-with-repeated-single-row-actions!
  [{:keys [driver database action rows xform]
    :or   {xform identity}}]
  (assert (seq rows))
  (with-jdbc-transaction [conn (u/the-id database)]
    (transduce
     (comp xform (m/indexed))
     (fn
       ([]
        [[] []])
       ([[errors successes]]
        (when (seq errors)
          (.rollback conn))
        [errors successes])
       ([[errors successes] [row-index arg-map]]
        (try
          (let [result (do-nested-transaction
                        driver
                        conn
                        (fn []
                          (actions/perform-action!* driver action database arg-map)))]
            [errors
             (conj successes result)])
          (catch Throwable e
            [(conj errors {:index row-index, :error (ex-message e)})
             successes]))))
     rows)))

:bulk/create

(defmethod actions/perform-action!* [:sql-jdbc :bulk/create]
  [driver _action database {:keys [table-id rows]}]
  (log/tracef "Inserting %d rows" (count rows))
  (perform-bulk-action-with-repeated-single-row-actions!
   {:driver   driver
    :database database
    :action   :row/create
    :rows     rows
    :xform    (comp (map (fn [row]
                           {:database   (u/the-id database)
                            :type       :query
                            :query      {:source-table table-id}
                            :create-row row}))
                    #(completing % (fn [[errors successes]]
                                     (when (seq errors)
                                       (throw (ex-info (tru "Error(s) inserting rows.")
                                                       {:status-code 400, :errors errors})))
                                     {:created-rows (map :created-row successes)})))}))

Shared stuff for both :bulk/delete and :bulk/update

(mu/defn ^:private table-id->pk-field-name->id :- [:map-of ::lib.schema.common/non-blank-string ::lib.schema.id/field]
  "Given a `table-id` return a map of string Field name -> Field ID for the primary key columns for that Table."
  [database-id :- ::lib.schema.id/database
   table-id    :- ::lib.schema.id/table]
  (into {}
        (comp (filter (fn [{:keys [semantic-type], :as _field}]
                        (isa? semantic-type :type/PK)))
              (map (juxt :name :id)))
        (qp.store/with-metadata-provider database-id
          (lib.metadata.protocols/fields
           (qp.store/metadata-provider)
           table-id))))

Given [[field-name->id]] as returned by [[table-id->pk-field-name->id]] or similar and a row of column name to value build an appropriate MBQL filter clause.

(defn- row->mbql-filter-clause
  [field-name->id row]
  (when (empty? row)
    (throw (ex-info (tru "Cannot build filter clause: row cannot be empty.")
                    {:field-name->id field-name->id, :row row, :status-code 400})))
  (into [:and] (for [[field-name value] row
                     :let               [field-id (get field-name->id (u/qualified-name field-name))
                                         ;; if the field isn't in `field-name->id` then it's an error in our code. Not
                                         ;; i18n'ed because this is not something that should be User facing unless our
                                         ;; backend code is broken.
                                         ;;
                                         ;; Unknown column names in user input WILL NOT trigger this error.
                                         ;; [[row->mbql-filter-clause]] is only used for *known* PK columns that are
                                         ;; used for the MBQL `:filter` clause. Unknown columns will trigger an error in
                                         ;; the DW but not here.
                                         _ (assert field-id
                                                   (format "Field %s is not present in field-name->id map"
                                                           (pr-str field-name)))]]
                 [:= [:field field-id nil] value])))

:bulk/delete

Make sure all rows have all the keys in expected-columns and no other keys, or return a 400.

(defn- check-rows-have-expected-columns-and-no-other-keys
  [rows expected-columns]
  ;; we only actually need to check the first map since [[check-consistent-row-keys]] should have checked that
  ;; they all have the same keys.
  (let [expected-columns (set expected-columns)
        actual-columns   (set (keys (first rows)))]
    (when-not (= actual-columns expected-columns)
      (throw (ex-info (tru "Rows have the wrong columns: expected {0}, but got {1}" expected-columns actual-columns)
                      {:status-code 400, :expected-columns expected-columns, :actual-columns actual-columns})))))

Make sure all rows have the same keys, or return a 400 response.

(defn- check-consistent-row-keys
  [rows]
  (let [all-row-column-sets (reduce
                             (fn [seen-set row]
                               (conj seen-set (set (keys row))))
                             #{}
                             rows)]
    (when (> (count all-row-column-sets) 1)
      (throw (ex-info (tru "Some rows have different sets of columns: {0}"
                           (str/join ", " (map pr-str all-row-column-sets)))
                      {:status-code 400, :column-sets all-row-column-sets})))))

Make sure all rows are unique, or return a 400 response. It makes no sense to try to delete the same row twice. It would fail anyway because the first call would delete it while the second would fail because it deletes zero rows.

(defn- check-unique-rows
  [rows]
  (when-let [repeats (not-empty
                      (into
                       ;; ordered set so the results are deterministic for test purposes
                       (ordered-set/ordered-set)
                       (filter (fn [[_row repeat-count]]
                                 (> repeat-count 1)))
                       (frequencies rows)))]
    (throw (ex-info (tru "Rows need to be unique: repeated rows {0}"
                         (str/join ", " (for [[row repeat-count] repeats]
                                          (format "%s × %d" (pr-str row) repeat-count))))
                    {:status-code 400, :repeated-rows repeats}))))
(defmethod actions/perform-action!* [:sql-jdbc :bulk/delete]
  [driver _action {database-id :id, :as database} {:keys [table-id rows]}]
  (log/tracef "Deleting %d rows" (count rows))
  (let [pk-name->id (table-id->pk-field-name->id database-id table-id)]
    ;; validate the keys in `rows`
    (check-consistent-row-keys rows)
    (check-rows-have-expected-columns-and-no-other-keys rows (keys pk-name->id))
    (check-unique-rows rows)
    ;; now do one `:row/delete` for each row
    (perform-bulk-action-with-repeated-single-row-actions!
     {:driver   driver
      :database database
      :action   :row/delete
      :rows     rows
      :xform    (comp (map (fn [row]
                             {:database database-id
                              :type     :query
                              :query    {:source-table table-id
                                         :filter       (row->mbql-filter-clause pk-name->id row)}}))
                      #(completing % (fn [[errors _successes]]
                                       (when (seq errors)
                                         (throw (ex-info (tru "Error(s) deleting rows.")
                                                         {:status-code 400, :errors errors})))
                                       ;; `:bulk/delete` just returns a simple status message on success.
                                       {:success true})))})))

bulk/update

Return a 400 if row doesn't have all the required PK columns.

(s/defn ^:private check-row-has-all-pk-columns
  [row :- {s/Str s/Any} pk-names :- #{s/Str}]
  (doseq [pk-key pk-names
          :when  (not (contains? row pk-key))]
    (throw (ex-info (tru "Row is missing required primary key column. Required {0}; got {1}"
                         (pr-str pk-names)
                         (pr-str (set (keys row))))
                    {:row row, :pk-names pk-names, :status-code 400}))))

Return a 400 if row doesn't have any non-PK columns to update.

(s/defn ^:private check-row-has-some-non-pk-columns
  [row :- {s/Str s/Any} pk-names :- #{s/Str}]
  (let [non-pk-names (set/difference (set (keys row)) pk-names)]
    (when (empty? non-pk-names)
      (throw (ex-info (tru "Invalid update row map: no non-PK columns. Got {0}, all of which are PKs."
                           (pr-str (set (keys row))))
                      {:status-code 400
                       :row         row
                       :all-keys    (set (keys row))
                       :pk-names    pk-names})))))

Create a function to use to transform each row coming in to a :bulk/update request into an MBQL query that can be passed to :row/update.

(defn- bulk-update-row-xform
  [{database-id :id, :as _database} table-id]
  ;; TODO -- make sure all rows specify the PK columns
  (let [pk-name->id (table-id->pk-field-name->id database-id table-id)
        pk-names    (set (keys pk-name->id))]
    (fn [row]
      (check-row-has-all-pk-columns row pk-names)
      (let [pk-column->value (select-keys row pk-names)]
        (check-row-has-some-non-pk-columns row pk-names)
        {:database   database-id
         :type       :query
         :query      {:source-table table-id
                      :filter       (row->mbql-filter-clause pk-name->id pk-column->value)}
         :update-row (apply dissoc row pk-names)}))))
(defmethod actions/perform-action!* [:sql-jdbc :bulk/update]
  [driver _action database {:keys [table-id rows]}]
  (log/tracef "Updating %d rows" (count rows))
  (perform-bulk-action-with-repeated-single-row-actions!
   {:driver   driver
    :database database
    :action   :row/update
    :rows     rows
    :xform    (comp (map (bulk-update-row-xform database table-id))
                    #(completing % (fn [[errors successes]]
                                     (when (seq errors)
                                       (throw (ex-info (tru "Error(s) updating rows.")
                                                       {:status-code 400, :errors errors})))
                                     ;; `:bulk/update` returns {:rows-updated <number-of-rows-updated>} on success.
                                     (transduce
                                      (map (comp first :rows-updated))
                                      (completing +
                                                  (fn [num-rows-updated]
                                                    {:rows-updated num-rows-updated}))
                                      0
                                      successes))))}))
 
(ns metabase.driver.sql-jdbc.common
  (:require
   [clojure.string :as str]
   [metabase.util :as u]))
(def ^:private valid-separator-styles #{:url :comma :semicolon})
(def ^:private ^:const default-name-value-separator "=")
(def ^:private separator-style->entry-separator {:comma ",", :semicolon ";", :url "&"})

Adds additional-opts (a string) to the given connection-string based on the given separator-style. See documentation for handle-additional-options for further details.

(defn conn-str-with-additional-opts
  {:added "0.41.0", :arglists '([connection-string separator-style additional-opts])}
  [connection-string separator-style additional-opts]
  {:pre [(string? connection-string)
         (or (nil? additional-opts) (string? additional-opts))
         (contains? valid-separator-styles separator-style)]}
  (str connection-string (when-not (str/blank? additional-opts)
                           (str (case separator-style
                                  :comma     ","
                                  :semicolon ";"
                                  :url       (if (str/includes? connection-string "?")
                                               "&"
                                               "?"))
                                additional-opts))))

Turns a map of additional-opts into a single string, based on the separator-style.

(defn additional-opts->string
  {:added "0.41.0"}
  [separator-style additional-opts & [name-value-separator]]
  {:pre [(or (nil? additional-opts) (map? additional-opts)) (contains? valid-separator-styles separator-style)]}
  (when (some? additional-opts)
    (reduce-kv (fn [m k v]
                 (str m
                      (when (seq m)
                        (separator-style->entry-separator separator-style))
                      (if (keyword? k)
                        (name k)
                        (str k))
                      (or name-value-separator default-name-value-separator)
                      v)) "" additional-opts)))

If details contains an :addtional-options key, append those options to the connection string in connection-spec. (Some drivers like MySQL provide this details field to allow special behavior where needed).

Optionally specify seperator-style, which defaults to :url (e.g. ?a=1&b=2). You may instead set it to :semicolon or :comma, which will separate different options with semicolons or commas instead (e.g. ;a=1;b=2). (While most drivers require the former style, some require semicolon or even comma.)

(defn handle-additional-options
  {:arglists '([connection-spec] [connection-spec details & {:keys [seperator-style]}])}
  ;; single arity provided for cases when `connection-spec` is built by applying simple transformations to `details`
  ([connection-spec]
   (handle-additional-options connection-spec connection-spec))
  ;; two-arity+options version provided for when `connection-spec` is being built up separately from `details` source
  ([{connection-string :subname, :as connection-spec} {additional-options :additional-options, :as _details} & {:keys [seperator-style]
                                                                                                                :or   {seperator-style :url}}]
   (-> (dissoc connection-spec :additional-options)
       (assoc :subname (conn-str-with-additional-opts connection-string seperator-style additional-options)))))

Attempts to parse the entires within the additional-options string into a map of keys to values. separator-style works as in the other functions in this namespace (since it influences the separator that appears between pairs).

opt-name-val-separator? is an optional parameter that indicates the string that appears between keys and values. If provided, it must be a single-character string. If not, then a default separator of "=" is used.

lowercase-keys? is an optional parameter that indicates the keys should be lowercased before being placed into the returned map (defaults to true).

(defn additional-options->map
  [additional-options separator-style & [name-value-separator? lowercase-keys?]]
  {:pre [(or (nil? additional-options) (string? additional-options))
         (contains? valid-separator-styles separator-style)
         (or (nil? name-value-separator?) (and (string? name-value-separator?)
                                            (= 1 (count name-value-separator?))))
         (or (nil? lowercase-keys?) (boolean? lowercase-keys?))]}
  (if (str/blank? additional-options)
    {}
    (let [entry-sep (separator-style->entry-separator separator-style)
          nv-sep    (or name-value-separator? default-name-value-separator)
          pairs     (str/split additional-options (re-pattern entry-sep))
          k-fn      (if (or (nil? lowercase-keys?) (true? lowercase-keys?)) u/lower-case-en identity)
          kv-fn     (fn [part]
                      (let [[k v] (str/split part (re-pattern (str "\\" nv-sep)))]
                        [(k-fn k) v]))
          kvs       (map kv-fn pairs)]
      (into {} kvs))))
 

Logic for creating and managing connection pools for SQL JDBC drivers. Implementations for connection-related driver multimethods for SQL JDBC drivers.

(ns metabase.driver.sql-jdbc.connection
  (:require
   [clojure.java.jdbc :as jdbc]
   [metabase.connection-pool :as connection-pool]
   [metabase.db.connection :as mdb.connection]
   [metabase.driver :as driver]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.jvm :as lib.metadata.jvm]
   [metabase.models.interface :as mi]
   [metabase.models.setting :as setting]
   [metabase.query-processor.context.default :as context.default]
   [metabase.query-processor.store :as qp.store]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.ssh :as ssh]
   #_{:clj-kondo/ignore [:discouraged-namespace]}
   [toucan2.core :as t2])
  (:import
   (com.mchange.v2.c3p0 DataSources)
   (javax.sql DataSource)))
(set! *warn-on-reflection* true)

+----------------------------------------------------------------------------------------------------------------+ | Interface | +----------------------------------------------------------------------------------------------------------------+

Given a Database details-map, return an unpooled JDBC connection spec. Driver authors should implement this method, but you probably shouldn't be USE this method directly! If you want a pooled connection spec (which you almost certainly do), use [[db->pooled-connection-spec]] instead.

DO NOT USE THIS METHOD DIRECTLY UNLESS YOU KNOW WHAT YOU ARE DOING! THIS RETURNS AN UNPOOLED CONNECTION SPEC! IF YOU WANT A CONNECTION SPEC FOR RUNNING QUERIES USE [[db->pooled-connection-spec]] INSTEAD WHICH WILL RETURN A POOLED CONNECTION SPEC.

(defmulti connection-details->spec
  {:added "0.32.0" :arglists '([driver details-map])}
  driver/dispatch-on-initialized-driver-safe-keys
  :hierarchy #'driver/hierarchy)

+----------------------------------------------------------------------------------------------------------------+ | Creating Connection Pools | +----------------------------------------------------------------------------------------------------------------+

c3p0 connection pool properties for connected data warehouse DBs. See https://www.mchange.com/projects/c3p0/#configuration_properties for descriptions of properties.

The c3p0 dox linked above do a good job of explaining the purpose of these properties and why you might set them. Generally, I have tried to choose configuration options for the data warehouse connection pools that minimize memory usage and maximize reliability, even when it comes with some added performance overhead. These pools are used for powering Cards and the sync process, which are less sensitive to overhead than something like the application DB.

Drivers that need to override the default properties below can provide custom implementations of this method.

(defmulti data-warehouse-connection-pool-properties
  {:added "0.33.4" :arglists '([driver database])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

Name, from connection details, to use to identify a database in the c3p0 dataSourceName. This is used for so the DataSource has a useful identifier for debugging purposes.

The default method uses the first non-nil value of the keys :db, :dbname, :sid, or :catalog; implement a new method if your driver does not have any of these keys in its details.

(defmulti data-source-name
  {:changelog-test/ignore true, :arglists '([driver details]), :added "0.45.0"}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
(defmethod data-source-name :default
  [_driver details]
  ((some-fn :db
            :dbname
            :sid
            :service-name
            :catalog)
   details))

Maximum size of the c3p0 connection pool.

(setting/defsetting jdbc-data-warehouse-max-connection-pool-size
  :visibility :internal
  :type       :integer
  :default    15
  :audit      :getter)

Kill connections if they are unreturned after this amount of time. In theory this should not be needed because the QP will kill connections that time out, but in practice it seems that connections disappear into the ether every once in a while; rather than exhaust the connection pool, let's be extra safe. This should be the same as the query timeout in [[metabase.query-processor.context.default/query-timeout-ms]] by default.

(setting/defsetting jdbc-data-warehouse-unreturned-connection-timeout-seconds
  :visibility :internal
  :type       :integer
  :getter     (fn []
                (or (setting/get-value-of-type :integer :jdbc-data-warehouse-unreturned-connection-timeout-seconds)
                    (long (/ context.default/query-timeout-ms 1000))))
  :setter     :none)
(defmethod data-warehouse-connection-pool-properties :default
  [driver database]
  { ;; only fetch one new connection at a time, rather than batching fetches (default = 3 at a time). This is done in
   ;; interest of minimizing memory consumption
   "acquireIncrement"             1
   ;; [From dox] Seconds a Connection can remain pooled but unused before being discarded.
   "maxIdleTime"                  (* 3 60 60) ; 3 hours
   "minPoolSize"                  1
   "initialPoolSize"              1
   "maxPoolSize"                  (jdbc-data-warehouse-max-connection-pool-size)
   ;; [From dox] If true, an operation will be performed at every connection checkout to verify that the connection is
   ;; valid. [...] ;; Testing Connections in checkout is the simplest and most reliable form of Connection testing,
   ;; but for better performance, consider verifying connections periodically using `idleConnectionTestPeriod`. [...]
   ;; If clients usually make complex queries and/or perform multiple operations, adding the extra cost of one fast
   ;; test per checkout will not much affect performance.
   ;;
   ;; As noted in the C3P0 dox, this does add some overhead, but since all of our drivers are JDBC 4 drivers, they can
   ;; call `Connection.isValid()`, which is reasonably efficient. In my profiling enabling this adds ~100µs for
   ;; Postgres databases on the same machince and ~70ms for remote databases on AWS east testing against a local
   ;; server on the West Coast.
   ;;
   ;; This suggests the additional cost of this test is more or less based entirely to the network latency of the
   ;; request. IRL the Metabase server and data warehouse are likely to be located in closer geographical proximity to
   ;; one another than my trans-contintental tests. Thus in the majority of cases the overhead should be next to
   ;; nothing, and in the worst case close to imperceptible.
   "testConnectionOnCheckout"     true
   ;; [From dox] Number of seconds that Connections in excess of minPoolSize should be permitted to remain idle in the
   ;; pool before being culled. Intended for applications that wish to aggressively minimize the number of open
   ;; Connections, shrinking the pool back towards minPoolSize if, following a spike, the load level diminishes and
   ;; Connections acquired are no longer needed. If maxIdleTime is set, maxIdleTimeExcessConnections should be smaller
   ;; if the parameter is to have any effect.
   ;;
   ;; Kill idle connections above the minPoolSize after 5 minutes.
   "maxIdleTimeExcessConnections" (* 5 60)
   ;; kill connections after this amount of time if they haven't been returned -- this should be the same as the query
   ;; timeout. This theoretically shouldn't happen since the QP should kill things after a certain timeout but it's
   ;; better to be safe than sorry -- it seems like in practice some connections disappear into the ether
   "unreturnedConnectionTimeout"  (jdbc-data-warehouse-unreturned-connection-timeout-seconds)
   ;; Set the data source name so that the c3p0 JMX bean has a useful identifier, which incorporates the DB ID, driver,
   ;; and name from the details
   "dataSourceName"               (format "db-%d-%s-%s"
                                          (u/the-id database)
                                          (name driver)
                                          (data-source-name driver (:details database)))})

Like [[connection-pool/connection-pool-spec]] but also handles situations when the unpooled spec is a :datasource.

(defn- connection-pool-spec
  [{:keys [^DataSource datasource], :as spec} pool-properties]
  (if datasource
    {:datasource (DataSources/pooledDataSource datasource (connection-pool/map->properties pool-properties))}
    (connection-pool/connection-pool-spec spec pool-properties)))
(defn ^:private default-ssh-tunnel-target-port  [driver]
  (when-let [port-info (some
                        #(when (= "port" (:name %)) %)
                        (driver/connection-properties driver))]
    (or (:default port-info)
        (:placeholder port-info))))

Create a new C3P0 ComboPooledDataSource for connecting to the given database.

(defn- create-pool!
  [{:keys [id details], driver :engine, :as database}]
  {:pre [(map? database)]}
  (log/debug (u/format-color 'cyan (trs "Creating new connection pool for {0} database {1} ..." driver id)))
  (let [details-with-tunnel (driver/incorporate-ssh-tunnel-details  ;; If the tunnel is disabled this returned unchanged
                             driver
                             (update details :port #(or % (default-ssh-tunnel-target-port driver))))
        spec                (connection-details->spec driver details-with-tunnel)
        properties          (data-warehouse-connection-pool-properties driver database)]
    (merge
      (connection-pool-spec spec properties)
      ;; also capture entries related to ssh tunneling for later use
      (select-keys spec [:tunnel-enabled :tunnel-session :tunnel-tracker :tunnel-entrance-port :tunnel-entrance-host]))))
(defn- destroy-pool! [database-id pool-spec]
  (log/debug (u/format-color 'red (trs "Closing old connection pool for database {0} ..." database-id)))
  (connection-pool/destroy-connection-pool! pool-spec)
  (ssh/close-tunnel! pool-spec))

A map of our currently open connection pools, keyed by Database :id.

(defonce ^:private 
  database-id->connection-pool
  (atom {}))

A map of DB details hash values, keyed by Database :id.

(defonce ^:private 
  database-id->jdbc-spec-hash
  (atom {}))

Computes a hash value for the JDBC connection spec based on database's :details map, for the purpose of determining if details changed and therefore the existing connection pool needs to be invalidated.

(mu/defn ^:private jdbc-spec-hash
  [{driver :engine, :keys [details], :as database} :- [:maybe :map]]
  (when (some? database)
    (hash (connection-details->spec driver details))))

Atomically update the current connection pool for Database database with database-id. Use this function instead of modifying database-id->connection-pool` directly because it properly closes down old pools in a thread-safe way, ensuring no more than one pool is ever open for a single database. Also modifies the [[database-id->jdbc-spec-hash]] map with the hash value of the given DB's details map.

(defn- set-pool!
  [database-id pool-spec-or-nil database]
  {:pre [(integer? database-id)]}
  (let [[old-id->pool] (if pool-spec-or-nil
                         (swap-vals! database-id->connection-pool assoc database-id pool-spec-or-nil)
                         (swap-vals! database-id->connection-pool dissoc database-id))]
    ;; if we replaced a different pool with the new pool that is different from the old one, destroy the old pool
    (when-let [old-pool-spec (get old-id->pool database-id)]
      (when-not (identical? old-pool-spec pool-spec-or-nil)
        (destroy-pool! database-id old-pool-spec))))
  ;; update the db details hash cache with the new hash value
  (swap! database-id->jdbc-spec-hash assoc database-id (jdbc-spec-hash database))
  nil)

Invalidates the connection pool for the given database by closing it and removing it from the cache.

(defn invalidate-pool-for-db!
  [database]
  (set-pool! (u/the-id database) nil nil))
(defn- log-ssh-tunnel-reconnect-msg! [db-id]
  (log/warn (u/format-color 'red (trs "ssh tunnel for database {0} looks closed; marking pool invalid to reopen it"
                                      db-id)))
  nil)
(defn- log-jdbc-spec-hash-change-msg! [db-id]
  (log/warn (u/format-color 'yellow (trs "Hash of database {0} details changed; marking pool invalid to reopen it"
                                          db-id)))
  nil)

Return a JDBC connection spec that includes a cp30 ComboPooledDataSource. These connection pools are cached so we don't create multiple ones for the same DB.

(defn db->pooled-connection-spec
  [db-or-id-or-spec]
  (cond
    ;; db-or-id-or-spec is a Database instance or an integer ID
    (u/id db-or-id-or-spec)
    (let [database-id (u/the-id db-or-id-or-spec)
          ;; we need the Database instance no matter what (in order to compare details hash with cached value)
          db          (or (when (mi/instance-of? :model/Database db-or-id-or-spec)
                            (lib.metadata.jvm/instance->metadata db-or-id-or-spec :metadata/database))
                          (when (= (:lib/type db-or-id-or-spec) :metadata/database)
                            db-or-id-or-spec)
                          (qp.store/with-metadata-provider database-id
                            (lib.metadata/database (qp.store/metadata-provider))))
          get-fn      (fn [db-id log-invalidation?]
                        (let [details (get @database-id->connection-pool db-id ::not-found)]
                          (cond
                            ;; for the audit db, we pass the datasource for the app-db. This lets us use fewer db
                            ;; connections with *application-db* and 1 less connection pool. Note: This data-source is
                            ;; not in [[database-id->connection-pool]].
                            (:is-audit db)
                            {:datasource (mdb.connection/data-source)}
                            (= ::not-found details)
                            nil
                            ;; details hash changed from what is cached; invalid
                            (let [curr-hash (get @database-id->jdbc-spec-hash db-id)
                                  new-hash  (jdbc-spec-hash db)]
                              (when (and (some? curr-hash) (not= curr-hash new-hash))
                                ;; the hash didn't match, but it's possible that a stale instance of `DatabaseInstance`
                                ;; was passed in (ex: from a long-running sync operation); fetch the latest one from
                                ;; our app DB, and see if it STILL doesn't match
                                (not= curr-hash (-> (t2/select-one [:model/Database :id :engine :details] :id database-id)
                                                    jdbc-spec-hash))))
                            (when log-invalidation?
                              (log-jdbc-spec-hash-change-msg! db-id))
                            (nil? (:tunnel-session details)) ; no tunnel in use; valid
                            details
                            (ssh/ssh-tunnel-open? details) ; tunnel in use, and open; valid
                            details
                            :else ; tunnel in use, and not open; invalid
                            (when log-invalidation?
                              (log-ssh-tunnel-reconnect-msg! db-id)))))]
      (or
       ;; we have an existing pool for this database, so use it
       (get-fn database-id true)
       ;; Even tho `set-pool!` will properly shut down old pools if two threads call this method at the same time, we
       ;; don't want to end up with a bunch of simultaneous threads creating pools only to have them destroyed the
       ;; very next instant. This will cause their queries to fail. Thus we should do the usual locking here and make
       ;; sure only one thread will be creating a pool at a given instant.
       (locking database-id->connection-pool
         (or
          ;; check if another thread created the pool while we were waiting to acquire the lock
          (get-fn database-id false)
          ;; create a new pool and add it to our cache, then return it
          (u/prog1 (create-pool! db)
            (set-pool! database-id <> db))))))
    ;; already a `clojure.java.jdbc` spec map
    (map? db-or-id-or-spec)
    db-or-id-or-spec
    ;; invalid. Throw Exception
    :else
    (throw (ex-info (tru "Not a valid Database/Database ID/JDBC spec")
                    ;; don't log the actual spec lest we accidentally expose credentials
                    {:input (class db-or-id-or-spec)}))))

+----------------------------------------------------------------------------------------------------------------+ | metabase.driver impls | +----------------------------------------------------------------------------------------------------------------+

Impl for [[with-connection-spec-for-testing-connection]].

(defn do-with-connection-spec-for-testing-connection
  [driver details f]
  (let [details (update details :port #(or % (default-ssh-tunnel-target-port driver)))]
    (ssh/with-ssh-tunnel [details-with-tunnel details]
      (let [spec (connection-details->spec driver details-with-tunnel)]
        (f spec)))))

Execute body with an appropriate [[clojure.java.jdbc]] connection spec based on connection details. Handles SSH tunneling as needed and properly cleans up after itself.

(with-connection-spec-for-testing-connection [jdbc-spec [:my-driver conn-details]] (do-something-with-spec jdbc-spec)

(defmacro with-connection-spec-for-testing-connection
  {:added "0.45.0", :style/indent 1}
  [[jdbc-spec-binding [driver details]] & body]
  `(do-with-connection-spec-for-testing-connection ~driver ~details (^:once fn* [~jdbc-spec-binding] ~@body)))

Can we connect to a JDBC database with [[clojure.java.jdbc]] jdbc-spec and run a simple query?

(defn can-connect-with-spec?
  [jdbc-spec]
  (let [[first-row] (jdbc/query jdbc-spec ["SELECT 1"])
        [result]    (vals first-row)]
    (= result 1)))

Default implementation of [[driver/can-connect?]] for SQL JDBC drivers. Checks whether we can perform a simple SELECT 1 query.

(defn can-connect?
  [driver details]
  (with-connection-spec-for-testing-connection [jdbc-spec [driver details]]
    (can-connect-with-spec? jdbc-spec)))
 

Code related to actually running a SQL query against a JDBC database and for properly encoding/decoding types going in and out of the database. Old, non-reducible implementation can be found in metabase.driver.sql-jdbc.execute.old-impl, which will be removed in a future release; implementations of methods for JDBC drivers that do not support java.time classes can be found in metabase.driver.sql-jdbc.execute.legacy-impl.

(ns metabase.driver.sql-jdbc.execute
  (:require
   [clojure.core.async :as a]
   [clojure.java.jdbc :as jdbc]
   [clojure.string :as str]
   [java-time.api :as t]
   [metabase.driver :as driver]
   [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn]
   [metabase.driver.sql-jdbc.execute.diagnostic
    :as sql-jdbc.execute.diagnostic]
   [metabase.driver.sql-jdbc.execute.old-impl :as sql-jdbc.execute.old]
   [metabase.driver.sql-jdbc.sync.interface :as sql-jdbc.sync.interface]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.schema.expression.temporal
    :as lib.schema.expression.temporal]
   [metabase.lib.schema.literal.jvm :as lib.schema.literal.jvm]
   [metabase.models.setting :refer [defsetting]]
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.query-processor.context :as qp.context]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.middleware.limit :as limit]
   [metabase.query-processor.reducible :as qp.reducible]
   [metabase.query-processor.store :as qp.store]
   [metabase.query-processor.timezone :as qp.timezone]
   [metabase.query-processor.util :as qp.util]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [potemkin :as p])
  (:import
   (java.sql Connection JDBCType PreparedStatement ResultSet ResultSetMetaData Statement Types)
   (java.time Instant LocalDate LocalDateTime LocalTime OffsetDateTime OffsetTime ZonedDateTime)
   (javax.sql DataSource)))
(set! *warn-on-reflection* true)

+----------------------------------------------------------------------------------------------------------------+ | SQL JDBC Reducible QP Interface | +----------------------------------------------------------------------------------------------------------------+

Malli schema for the options passed to [[do-with-connection-with-options]].

(def ConnectionOptions
  [:maybe
   [:map
    ;; a string like 'US/Pacific' or something like that.
    [:session-timezone {:optional true} [:maybe [:ref ::lib.schema.expression.temporal/timezone-id]]]
    ;; whether this Connection should NOT be read-only, e.g. for DDL stuff or inserting data or whatever.
    [:write? {:optional true} [:maybe :boolean]]]])

Fetch a [[java.sql.Connection]] from a driver/db-or-id-or-spec, and invoke

(f connection)

If db-or-id-or-spec is a Database or Database ID, the default implementation fetches a pooled connection spec for that Database using [[datasource]].

If db-or-id-or-spec is a clojure.java.jdbc spec, it fetches a Connection using [[clojure.java..jdbc/get-connection]]. Note that this will not be a pooled connection unless your spec is for a pooled DataSource.

options matches the [[ConnectionOptions]] schema above.

  • If :session-timezone is passed, it should be used to set the Session timezone for the Connection. If not passed, leave as-is

  • If :write? is NOT passed or otherwise falsey, make the connection read-only if possible; if it is truthy, make the connection read-write. Note that this current does not run things inside a transaction automatically; you'll have to do that yourself if you want it

The normal 'happy path' is more or less

(with-open [conn (.getConnection (datasource driver db-or-id-or-spec))] (set-best-transaction-level! driver conn) (set-time-zone-if-supported! driver conn session-timezone) (.setReadOnly conn true) (.setAutoCommit conn true) ; so the query(s) are not ran inside a transaction (.setHoldability conn ResultSet/CLOSECURSORSAT_COMMIT) (f conn))

This default implementation is abstracted out into two functions, [[do-with-resolved-connection]] and [[set-default-connection-options!]], that you can use as needed in custom implementations. See various driver implementations for examples. You should only set connection options on top-level calls to [[do-with-connection-with-options]]; check whether this is a [[recursive-connection?]] before setting options.

There are two usual ways to set the session timezone if your driver supports them:

  1. Specifying the session timezone based on the value of [[metabase.driver/report-timezone]] as a JDBC connection parameter in the JDBC connection spec returned by [[metabase.driver.sql-jdbc.connection/connection-details->spec]]. If the spec returned by this method changes, connection pools associated with it will be flushed automatically. This is the preferred way to set session timezones; if you set them this way, you DO NOT need to implement this method unless you need to do something special with regards to setting the transaction level.

  2. Setting the session timezone manually on the [[java.sql.Connection]] returned by [[datasource]] based on the value of session-timezone.

    2a. The default implementation will do this for you by executing SQL if you implement [[set-timezone-sql]].

    2b. You can implement this method, [[do-with-connection-with-options]], yourself and set the timezone however you wish. Only set it if session-timezone is not nil!

    Custom implementations should set transaction isolation to the least-locking level supported by the driver, and make connections read-only (after setting timezone, if needed).

(defmulti do-with-connection-with-options
  {:added    "0.47.0"
   :arglists '([driver db-or-id-or-spec options f])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

Set the PreparedStatement parameter at index i to object. Dispatches on driver and class of object. By default, this calls .setObject, but drivers can override this method to convert the object to a different class or set it with a different intended JDBC type as needed.

(defmulti set-parameter
  {:added "0.34.0" :arglists '([driver prepared-statement i object])}
  (fn [driver _ _ object]
    [(driver/dispatch-on-initialized-driver driver) (class object)])
  :hierarchy #'driver/hierarchy)

TODO -- maybe like [[do-with-connection-with-options]] we should replace [[prepared-statment]] and [[statement]] with do-with-prepared-statement and do-with-statement methods -- that way you can't accidentally forget to wrap things in a try-catch and call .close

Create a PreparedStatement with sql query, and set any params. You shouldn't need to override the default implementation for this method; if you do, take care to set options to maximize result set read performance (e.g. ResultSet/TYPE_FORWARD_ONLY); refer to the default implementation.

(defmulti ^PreparedStatement prepared-statement
  {:added "0.35.0",
   :arglists '(^java.sql.PreparedStatement [driver ^java.sql.Connection connection ^String sql params])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

Indicates whether the given driver supports creating a java.sql.Statement, via the Connection. By default, this is true for all :sql-jdbc drivers. If the underlying driver does not support Statement creation, override this as false.

(defmulti ^Statement statement-supported?
  {:added "0.39.0", :arglists '([driver])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

Create a Statement object using the given connection. Only called if statement-supported? above returns true. This is to be used to execute native queries, which implies there are no parameters. As with prepared-statement, you shouldn't need to override the default implementation for this method; if you do, take care to set options to maximize result set read performance (e.g. ResultSet/TYPE_FORWARD_ONLY); refer to the default implementation.

(defmulti ^Statement statement
  {:added "0.39.0", :arglists '(^java.sql.Statement [driver ^java.sql.Connection connection])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

Execute a PreparedStatement, returning a ResultSet. Default implementation simply calls .executeQuery(). It is unlikely you will need to override this. Prior to 0.39, this was named execute-query!

(defmulti execute-prepared-statement!
  {:added "0.39.0", :arglists '(^java.sql.ResultSet [driver ^java.sql.PreparedStatement stmt])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

Runs a SQL select query with a given Statement, returning a ResultSet. Default implementation simply calls .execute() for the given sql on the given statement, and then .getResultSet() if that returns true (throwing an exception if not). It is unlikely you will need to override this.

(defmulti execute-statement!
  {:added "0.39.0", :arglists '(^java.sql.ResultSet [driver ^java.sql.Statement stmt ^String sql])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

Return a sequence of maps containing information about the corresponding columns in query results. The default implementation fetches this information via the result set metadata. It is unlikely you will need to override this.

(defmulti column-metadata
  {:added "0.35.0", :arglists '([driver ^java.sql.ResultSetMetaData rsmeta])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

Return a zero-arg function that, when called, will fetch the value of the column from the current row. This also supports defaults for the entire driver:

;; default method for Postgres not covered by any [driver jdbc-type] methods (defmethod read-column-thunk :postgres ...)

(defmulti read-column-thunk
  {:added "0.35.0", :arglists '([driver ^java.sql.ResultSet rs ^java.sql.ResultSetMetaData rsmeta i])}
  (fn [driver _rs ^ResultSetMetaData rsmeta ^Long col-idx]
    [(driver/dispatch-on-initialized-driver driver) (.getColumnType rsmeta col-idx)])
  :hierarchy #'driver/hierarchy)

+----------------------------------------------------------------------------------------------------------------+ | Default Impl | +----------------------------------------------------------------------------------------------------------------+

Fetch the connection pool DataSource associated with db-or-id-or-spec.

(defn datasource
  {:added "0.35.0"}
  ^DataSource [db-or-id-or-spec]
  (:datasource (sql-jdbc.conn/db->pooled-connection-spec db-or-id-or-spec)))

Fetch the connection pool DataSource associated with database, while also recording diagnostic info for the pool. To be used in conjunction with sql-jdbc.execute.diagnostic/capturing-diagnostic-info.

(defn datasource-with-diagnostic-info!
  {:added "0.40.0"}
  ^DataSource [driver db-or-id]
  (let [ds (datasource db-or-id)]
    (sql-jdbc.execute.diagnostic/record-diagnostic-info-for-pool! driver (u/the-id db-or-id) ds)
    ds))

Execute set-timezone-sql, if implemented by driver, to set the session time zone. This way of setting the time zone should be considered deprecated in favor of implementing connection-with-timezone directly.

(defn set-time-zone-if-supported!
  {:deprecated "0.35.0"}
  [driver ^Connection conn ^String timezone-id]
  (when timezone-id
    (when-let [format-string (sql-jdbc.execute.old/set-timezone-sql driver)]
      (try
        (let [sql (format format-string (str \' timezone-id \'))]
          (log/debug (trs "Setting {0} database timezone with statement: {1}" driver (pr-str sql)))
          (try
            (.setReadOnly conn false)
            (catch Throwable e
              (log/debug e (trs "Error setting connection to readwrite"))))
          (with-open [stmt (.createStatement conn)]
            (.execute stmt sql)
            (log/tracef "Successfully set timezone for %s database to %s" driver timezone-id)))
        (catch Throwable e
          (log/error e (trs "Failed to set timezone ''{0}'' for {1} database" timezone-id driver)))))))

OSS no-op implementation of set-role-if-supported!.

(defenterprise set-role-if-supported!
  metabase-enterprise.advanced-permissions.driver.impersonation
  [_ _ _])

Set the connection transaction isolation level to the least-locking level supported by the DB. See https://docs.oracle.com/cd/E19830-01/819-4721/beamv/index.html for an explanation of these levels.

TODO - since we're not running the queries in a transaction, does this make any difference at all?

(defn set-best-transaction-level!
  {:added "0.35.0"}
  [driver ^Connection conn]
  (let [dbmeta (.getMetaData conn)]
    (loop [[[level-name ^Integer level] & more] [[:read-uncommitted Connection/TRANSACTION_READ_UNCOMMITTED]
                                                 [:repeatable-read  Connection/TRANSACTION_REPEATABLE_READ]
                                                 [:read-committed   Connection/TRANSACTION_READ_COMMITTED]]]
      (cond
        (.supportsTransactionIsolationLevel dbmeta level)
        (do
          (log/tracef "Set transaction isolation level for %s database to %s" (name driver) level-name)
          (try
            (.setTransactionIsolation conn level)
            (catch Throwable e
              (log/debug e (trs "Error setting transaction isolation level for {0} database to {1}" (name driver) level-name)))))
        (seq more)
        (recur more)))))
(mu/defn do-with-resolved-connection-data-source :- (lib.schema.literal.jvm/instance-of DataSource)
  "Part of the default implementation for [[do-with-connection-with-options]]: get an appropriate `java.sql.DataSource`
  for `db-or-id-or-spec`. Not for use with a JDBC spec wrapping a `java.sql.Connection` (a spec with the key
  `:connection`), since we do not have control over its lifecycle and would thus not be able to use [[with-open]] with
  Connections provided by this DataSource."
  {:added "0.47.0", :arglists '(^javax.sql.DataSource [driver db-or-id-or-spec options])}
  [driver           :- :keyword
   db-or-id-or-spec :- [:and
                        [:or :int :map]
                        [:fn
                         ;; can't wrap a java.sql.Connection here because we're not
                         ;; responsible for its lifecycle and that means you can't use
                         ;; `with-open` on the Connection you'd get from the DataSource
                         {:error/message "Cannot be a JDBC spec wrapping a java.sql.Connection"}
                         (complement :connection)]]
   {:keys [^String session-timezone], :as _options} :- ConnectionOptions]
  (if-not (u/id db-or-id-or-spec)
    ;; not a Database or Database ID... this is a raw `clojure.java.jdbc` spec, use that
    ;; directly.
    (reify DataSource
      (getConnection [_this]
        #_{:clj-kondo/ignore [:discouraged-var]}
        (jdbc/get-connection db-or-id-or-spec)))
    ;; otherwise this is either a Database or Database ID.
    (if-let [old-method-impl (get-method
                              #_{:clj-kondo/ignore [:deprecated-var]} sql-jdbc.execute.old/connection-with-timezone
                              driver)]
      ;; use the deprecated impl for `connection-with-timezone` if one exists.
      (do
        (log/warn (trs "{0} is deprecated in Metabase 0.47.0. Implement {1} instead."
                       #_{:clj-kondo/ignore [:deprecated-var]}
                       `connection-with-timezone
                       `do-with-connection-with-options))
        ;; for compatibility, make sure we pass it an actual Database instance.
        (let [database (if (integer? db-or-id-or-spec)
                         (qp.store/with-metadata-provider db-or-id-or-spec
                           (lib.metadata/database (qp.store/metadata-provider)))
                         db-or-id-or-spec)]
          (reify DataSource
            (getConnection [_this]
              (old-method-impl driver database session-timezone)))))
      (datasource-with-diagnostic-info! driver db-or-id-or-spec))))

In recursive calls to [[do-with-connection-with-options]] we don't want to set options AGAIN, because this might break things. For example in a top-level :write? call, we might disable auto-commit and run things in a transaction; a read-only call inside of this transaction block should not go in and change the connection to be auto-commit. So only set options at the top-level call, and use this to keep track of whether we're at the top level or not.

This gets incremented inside [[do-with-resolved-connection]], so the top level call with have a depth of 0, a nested call will get 1, and so forth. This is done this way and inside [[do-with-resolved-connection]] and [[set-default-connection-options!]] so drivers that implement

(def ^:private ^:dynamic ^{:added "0.47.0"} *connection-recursion-depth*
  -1)

Whether or not we are in a recursive call to [[do-with-connection-with-options]]. If we are, you shouldn't set Connection options AGAIN, as that may override previous options that we don't want to override.

(defn recursive-connection?
  []
  {:added "0.47.0"}
  (pos? *connection-recursion-depth*))

Execute

(f ^java.sql.Connection conn)

with a resolved JDBC connection. Part of the default implementation for [[do-with-connection-with-options]]. Generally does not set any options, but may set session-timezone if driver implements the deprecated [[sql-jdbc.execute.old/connection-with-timezone]] method.

(mu/defn do-with-resolved-connection
  {:added "0.47.0"}
  [driver           :- :keyword
   db-or-id-or-spec :- [:or :int :map]
   options          :- ConnectionOptions
   f                :- fn?]
  (binding [*connection-recursion-depth* (inc *connection-recursion-depth*)]
    (if-let [conn (:connection db-or-id-or-spec)]
      (f conn)
      (with-open [conn (.getConnection (do-with-resolved-connection-data-source driver db-or-id-or-spec options))]
        (f conn)))))

Part of the default implementation of [[do-with-connection-with-options]]: set options for a newly fetched Connection.

(mu/defn set-default-connection-options!
  {:added "0.47.0"}
  [driver                                                 :- :keyword
   db-or-id-or-spec
   ^Connection conn                                       :- (lib.schema.literal.jvm/instance-of Connection)
   {:keys [^String session-timezone write?], :as options} :- ConnectionOptions]
  (when-not (recursive-connection?)
    (log/tracef "Setting default connection options with options %s" (pr-str options))
    (set-best-transaction-level! driver conn)
    (set-time-zone-if-supported! driver conn session-timezone)
    (set-role-if-supported! driver conn (cond (integer? db-or-id-or-spec) (qp.store/with-metadata-provider db-or-id-or-spec
                                                                            (lib.metadata/database (qp.store/metadata-provider)))
                                              (u/id db-or-id-or-spec)     db-or-id-or-spec))
    (let [read-only? (not write?)]
      (try
        ;; Setting the connection to read-only does not prevent writes on some databases, and is meant
        ;; to be a hint to the driver to enable database optimizations
        ;; See https://docs.oracle.com/javase/8/docs/api/java/sql/Connection.html#setReadOnly-boolean-
        (log/trace (pr-str (list '.setReadOnly 'conn read-only?)))
        (.setReadOnly conn read-only?)
        (catch Throwable e
          (log/debugf e "Error setting connection readOnly to %s" (pr-str read-only?)))))
    ;; If this is (supposedly) a read-only connection, we would prefer enable auto-commit
    ;; so this IS NOT ran inside of a transaction, but without transaction the read-only
    ;; flag has no effect for most of the drivers.
    ;; TODO Enable auto-commit after having communicated this change in behvaior to our users.
    ;;
    ;; TODO -- for `write?` connections, we should probably disable autoCommit and then manually call `.commit` at after
    ;; `f`... we need to check and make sure that won't mess anything up, since some existing code is already doing it
    ;; manually.
    (when-not write?
      (try
        (log/trace (pr-str '(.setAutoCommit conn true)))
        (.setAutoCommit conn true)
        (catch Throwable e
          (log/debug e "Error enabling connection autoCommit"))))
    (try
      (log/trace (pr-str '(.setHoldability conn ResultSet/CLOSE_CURSORS_AT_COMMIT)))
      (.setHoldability conn ResultSet/CLOSE_CURSORS_AT_COMMIT)
      (catch Throwable e
        (log/debug e (trs "Error setting default holdability for connection"))))))
(defmethod do-with-connection-with-options :sql-jdbc
  [driver db-or-id-or-spec options f]
  (do-with-resolved-connection
   driver
   db-or-id-or-spec
   options
   (fn [^Connection conn]
     (set-default-connection-options! driver db-or-id-or-spec conn options)
     (f conn))))

TODO - would a more general method to convert a parameter to the desired class (and maybe JDBC type) be more useful? Then we can actually do things like log what transformations are taking place

(defn- set-object
  ([^PreparedStatement prepared-statement, ^Integer index, object]
   (log/tracef "(set-object prepared-statement %d ^%s %s)" index (some-> object class .getName) (pr-str object))
   (.setObject prepared-statement index object))
  ([^PreparedStatement prepared-statement, ^Integer index, object, ^Integer target-sql-type]
   (log/tracef "(set-object prepared-statement %d ^%s %s java.sql.Types/%s)" index (some-> object class .getName)
               (pr-str object) (.getName (JDBCType/valueOf target-sql-type)))
   (.setObject prepared-statement index object target-sql-type)))
(defmethod set-parameter :default
  [_ prepared-statement i object]
  (set-object prepared-statement i object))
(defmethod set-parameter [::driver/driver LocalDate]
  [_ prepared-statement i t]
  (set-object prepared-statement i t Types/DATE))
(defmethod set-parameter [::driver/driver LocalTime]
  [_ prepared-statement i t]
  (set-object prepared-statement i t Types/TIME))
(defmethod set-parameter [::driver/driver LocalDateTime]
  [_ prepared-statement i t]
  (set-object prepared-statement i t Types/TIMESTAMP))
(defmethod set-parameter [::driver/driver OffsetTime]
  [_ prepared-statement i t]
  (set-object prepared-statement i t Types/TIME_WITH_TIMEZONE))
(defmethod set-parameter [::driver/driver OffsetDateTime]
  [_ prepared-statement i t]
  (set-object prepared-statement i t Types/TIMESTAMP_WITH_TIMEZONE))
(defmethod set-parameter [::driver/driver ZonedDateTime]
  [_ prepared-statement i t]
  (set-object prepared-statement i t Types/TIMESTAMP_WITH_TIMEZONE))
(defmethod set-parameter [::driver/driver Instant]
  [driver prepared-statement i t]
  (set-parameter driver prepared-statement i (t/offset-date-time t (t/zone-offset 0))))

TODO - this might not be needed for all drivers. It is at least needed for H2 and Postgres. Not sure which, if any JDBC drivers support ZonedDateTime.

(defmethod set-parameter [::driver/driver ZonedDateTime]
  [driver prepared-statement i t]
  (set-parameter driver prepared-statement i (t/offset-date-time t)))

Set parameters for the prepared statement by calling set-parameter for each parameter.

(defn set-parameters!
  {:added "0.35.0"}
  [driver stmt params]
  (when (< (try (.. ^PreparedStatement stmt getParameterMetaData getParameterCount)
                (catch Throwable _ (count params)))
           (count params))
    (throw (ex-info (tru "It looks like we got more parameters than we can handle, remember that parameters cannot be used in comments or as identifiers.")
                    {:driver driver
                     :type   qp.error-type/driver
                     :statement (str/split-lines (str stmt))
                     :params params})))
  (dorun
   (map-indexed
    (fn [i param]
      (log/tracef "Set param %d -> %s" (inc i) (pr-str param))
      (set-parameter driver stmt (inc i) param))
    params)))

Fetch size for result sets. We want to ensure that the jdbc ResultSet objects are not realizing the entire results in memory.

(defsetting sql-jdbc-fetch-size
  :default 500
  :type :integer
  :visibility :internal)
(defmethod prepared-statement :sql-jdbc
  [driver ^Connection conn ^String sql params]
  (let [stmt (.prepareStatement conn
                                sql
                                ResultSet/TYPE_FORWARD_ONLY
                                ResultSet/CONCUR_READ_ONLY
                                ResultSet/CLOSE_CURSORS_AT_COMMIT)]
    (try
      (try
        (.setFetchDirection stmt ResultSet/FETCH_FORWARD)
        (catch Throwable e
          (log/debug e (trs "Error setting prepared statement fetch direction to FETCH_FORWARD"))))
      (try
        (when (zero? (.getFetchSize stmt))
          (.setFetchSize stmt (sql-jdbc-fetch-size)))
        (catch Throwable e
          (log/debug e (trs "Error setting prepared statement fetch size to fetch-size"))))
      (set-parameters! driver stmt params)
      stmt
      (catch Throwable e
        (.close stmt)
        (throw e)))))

by default, drivers support .createStatement

(defmethod statement-supported? :sql-jdbc
  [_]
  true)
(defmethod statement :sql-jdbc
  [_ ^Connection conn]
  (let [stmt (.createStatement conn
                               ResultSet/TYPE_FORWARD_ONLY
                               ResultSet/CONCUR_READ_ONLY
                               ResultSet/CLOSE_CURSORS_AT_COMMIT)]
    (try
      (try
        (.setFetchDirection stmt ResultSet/FETCH_FORWARD)
        (catch Throwable e
          (log/debug e (trs "Error setting statement fetch direction to FETCH_FORWARD"))))
      (try
        (when (zero? (.getFetchSize stmt))
          (.setFetchSize stmt (sql-jdbc-fetch-size)))
        (catch Throwable e
          (log/debug e (trs "Error setting statement fetch size to fetch-size"))))
      stmt
      (catch Throwable e
        (.close stmt)
        (throw e)))))

If canceled-chan gets a message, cancel the Statement stmt.

(defn- wire-up-canceled-chan-to-cancel-Statement!
  [^Statement stmt canceled-chan]
  (when canceled-chan
    (a/go
      (when (a/<! canceled-chan)
        (log/debug (trs "Query canceled, calling Statement.cancel()"))
        (u/ignore-exceptions
          (.cancel stmt))))))
(defn- prepared-statement*
  ^PreparedStatement [driver conn sql params canceled-chan]
  ;; sometimes preparing the statement fails, usually if the SQL syntax is invalid.
  (doto (try
          (prepared-statement driver conn sql params)
          (catch Throwable e
            (throw (ex-info (tru "Error preparing statement: {0}" (ex-message e))
                            {:driver driver
                             :type   qp.error-type/driver
                             :sql    (str/split-lines (driver/prettify-native-form driver sql))
                             :params params}
                            e))))
    (wire-up-canceled-chan-to-cancel-Statement! canceled-chan)))
(defn- use-statement? [driver params]
  (and (statement-supported? driver) (empty? params)))
(defn- statement* ^Statement [driver conn canceled-chan]
  (doto (statement driver conn)
    (wire-up-canceled-chan-to-cancel-Statement! canceled-chan)))

Create a statement or a prepared statement. Should be called from [[with-open]].

(defn statement-or-prepared-statement
  ^Statement [driver conn sql params canceled-chan]
  (if (use-statement? driver params)
    (statement* driver conn canceled-chan)
    (prepared-statement* driver conn sql params canceled-chan)))
(defmethod execute-prepared-statement! :sql-jdbc
  [_ ^PreparedStatement stmt]
  (.executeQuery stmt))
(defmethod execute-statement! :sql-jdbc
  [driver ^Statement stmt ^String sql]
  (if (.execute stmt sql)
    (.getResultSet stmt)
    (throw (ex-info (str (tru "Select statement did not produce a ResultSet for native query"))
                    {:sql sql :driver driver}))))
(defn- execute-statement-or-prepared-statement! ^ResultSet [driver ^Statement stmt max-rows params sql]
  (let [st (doto stmt (.setMaxRows max-rows))]
    (if (use-statement? driver params)
      (execute-statement! driver st sql)
      (execute-prepared-statement! driver st))))
(defmethod read-column-thunk :default
  [driver ^ResultSet rs rsmeta ^long i]
  (let [driver-default-method (get-method read-column-thunk driver)]
    (if-not (= driver-default-method (get-method read-column-thunk :default))
      ^{:name (format "(read-column-thunk %s)" driver)} (driver-default-method driver rs rsmeta i)
      ^{:name (format "(.getObject rs %d)" i)} (fn []
                                                 (.getObject rs i)))))
(defn- get-object-of-class-thunk [^ResultSet rs, ^long i, ^Class klass]
  ^{:name (format "(.getObject rs %d %s)" i (.getCanonicalName klass))}
  (fn []
    (.getObject rs i klass)))
(defmethod read-column-thunk [:sql-jdbc Types/TIMESTAMP]
  [_ rs _ i]
  (get-object-of-class-thunk rs i java.time.LocalDateTime))
(defmethod read-column-thunk [:sql-jdbc Types/TIMESTAMP_WITH_TIMEZONE]
  [_ rs _ i]
  (get-object-of-class-thunk rs i java.time.OffsetDateTime))
(defmethod read-column-thunk [:sql-jdbc Types/DATE]
  [_ rs _ i]
  (get-object-of-class-thunk rs i java.time.LocalDate))
(defmethod read-column-thunk [:sql-jdbc Types/TIME]
  [_ rs _ i]
  (get-object-of-class-thunk rs i java.time.LocalTime))
(defmethod read-column-thunk [:sql-jdbc Types/TIME_WITH_TIMEZONE]
  [_ rs _ i]
  (get-object-of-class-thunk rs i java.time.OffsetTime))
(defn- column-range [^ResultSetMetaData rsmeta]
  (range 1 (inc (.getColumnCount rsmeta))))
(defn- log-readers [driver ^ResultSetMetaData rsmeta fns]
  (log/trace
   (str/join
    "\n"
    (for [^Integer i (column-range rsmeta)]
      (format "Reading %s column %d %s (JDBC type: %s, DB type: %s) with %s"
              driver
              i
              (pr-str (.getColumnName rsmeta i))
              (or (u/ignore-exceptions
                    (.getName (JDBCType/valueOf (.getColumnType rsmeta i))))
                  (.getColumnType rsmeta i))
              (.getColumnTypeName rsmeta i)
              (let [f (nth fns (dec i))]
                (or (:name (meta f))
                    f)))))))

Returns a thunk that can be called repeatedly to get the next row in the result set, using appropriate methods to fetch each value in the row. Returns nil when the result set has no more rows.

(defn row-thunk
  [driver ^ResultSet rs ^ResultSetMetaData rsmeta]
  (let [fns (for [i (column-range rsmeta)]
              (read-column-thunk driver rs rsmeta (long i)))]
    (log-readers driver rsmeta fns)
    (let [thunk (if (seq fns)
                  (apply juxt fns)
                  (constantly []))]
      (fn row-thunk* []
        (when (.next rs)
          (thunk))))))
(defmethod column-metadata :sql-jdbc
  [driver ^ResultSetMetaData rsmeta]
  (mapv
   (fn [^Integer i]
     (let [col-name     (.getColumnLabel rsmeta i)
           db-type-name (.getColumnTypeName rsmeta i)
           base-type    (sql-jdbc.sync.interface/database-type->base-type driver (keyword db-type-name))]
       (log/tracef "Column %d '%s' is a %s which is mapped to base type %s for driver %s\n"
                   i col-name db-type-name base-type driver)
       {:name      col-name
        ;; TODO - disabled for now since it breaks a lot of tests. We can re-enable it when the tests are in a better
        ;; state
        #_:original_name #_(.getColumnName rsmeta i)
        #_:jdbc_type #_ (u/ignore-exceptions
                          (.getName (JDBCType/valueOf (.getColumnType rsmeta i))))
        #_:db_type   #_db-type-name
        :base_type   (or base-type :type/*)}))
   (column-range rsmeta)))

Returns an object that can be reduced to fetch the rows and columns in a ResultSet in a driver-specific way (e.g. by using read-column-thunk to fetch values).

(defn reducible-rows
  {:added "0.35.0"}
  [driver ^ResultSet rs ^ResultSetMetaData rsmeta canceled-chan]
  (let [row-thunk (row-thunk driver rs rsmeta)]
    (qp.reducible/reducible-rows row-thunk canceled-chan)))

Injects the remark into the SQL query text.

(defmulti inject-remark
  {:added "0.48.0", :arglists '([driver sql remark])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
(defmethod inject-remark :default
  [_ sql remark]
  (str "-- " remark "\n" sql))

Default impl of execute-reducible-query for sql-jdbc drivers.

(defn execute-reducible-query
  {:added "0.35.0", :arglists '([driver query context respond] [driver sql params max-rows context respond])}
  ([driver {{sql :query, params :params} :native, :as outer-query} context respond]
   {:pre [(string? sql) (seq sql)]}
   (let [database (lib.metadata/database (qp.store/metadata-provider))
         sql      (if (get-in database [:details :include-user-id-and-hash] true)
                    (->> (qp.util/query->remark driver outer-query)
                         (inject-remark driver sql))
                    sql)
         max-rows (limit/determine-query-max-rows outer-query)]
     (execute-reducible-query driver sql params max-rows context respond)))
  ([driver sql params max-rows context respond]
   (do-with-connection-with-options
    driver
    (lib.metadata/database (qp.store/metadata-provider))
    {:session-timezone (qp.timezone/report-timezone-id-if-supported driver (lib.metadata/database (qp.store/metadata-provider)))}
    (fn [^Connection conn]
      (with-open [stmt          (statement-or-prepared-statement driver conn sql params (qp.context/canceled-chan context))
                  ^ResultSet rs (try
                                  (execute-statement-or-prepared-statement! driver stmt max-rows params sql)
                                  (catch Throwable e
                                    (throw (ex-info (tru "Error executing query: {0}" (ex-message e))
                                                    {:driver driver
                                                     :sql    (str/split-lines (driver/prettify-native-form driver sql))
                                                     :params params
                                                     :type   qp.error-type/invalid-query}
                                                    e))))]
        (let [rsmeta           (.getMetaData rs)
              results-metadata {:cols (column-metadata driver rsmeta)}]
          (respond results-metadata (reducible-rows driver rs rsmeta (qp.context/canceled-chan context)))))))))

+----------------------------------------------------------------------------------------------------------------+ | Actions Stuff | +----------------------------------------------------------------------------------------------------------------+

(defmethod driver/execute-write-query! :sql-jdbc
  [driver {{sql :query, :keys [params]} :native}]
  {:pre [(string? sql)]}
  (try
    (do-with-connection-with-options
     driver
     (lib.metadata/database (qp.store/metadata-provider))
     {:write? true
      :session-timezone (qp.timezone/report-timezone-id-if-supported driver (lib.metadata/database (qp.store/metadata-provider)))}
     (fn [^Connection conn]
       (with-open [stmt (statement-or-prepared-statement driver conn sql params nil)]
         {:rows-affected (if (instance? PreparedStatement stmt)
                           (.executeUpdate ^PreparedStatement stmt)
                           (.executeUpdate stmt sql))})))
    (catch Throwable e
      (throw (ex-info (tru "Error executing write query: {0}" (ex-message e))
                      {:sql sql, :params params, :type qp.error-type/invalid-query}
                      e)))))

+----------------------------------------------------------------------------------------------------------------+ | Convenience Imports from Old Impl | +----------------------------------------------------------------------------------------------------------------+

#_{:clj-kondo/ignore [:deprecated-var]}
(p/import-vars
 [sql-jdbc.execute.old
  connection-with-timezone
  set-timezone-sql])
 

Code related to capturing diagnostic information for JDBC connection pools at execution time.

(ns metabase.driver.sql-jdbc.execute.diagnostic
  (:import
   (com.mchange.v2.c3p0 PoolBackedDataSource)))
(set! *warn-on-reflection* true)

Atom used to hold diagnostic info for the current query execution, to be made available via a helper macro/fn below.

(def ^:private ^:dynamic *diagnostic-info*
  nil)

Execute f with diagnostic info capturing enabled. f is passed a single argument, a function that can be used to retrieve the current diagnostic info. Prefer to use the macro form instead: capturing-diagnostic-info.

(defn do-with-diagnostic-info
  {:style/indent 0}
  [f]
  (binding [*diagnostic-info* (atom {})]
    (f (partial deref *diagnostic-info*))))

Execute body and store diagnostic info related to the query execution. diagnostic-info-fn-binding is bound to a zero-arity function that can be used to fetch the current diagnostic info.

``` (sql-jdbc.execute.diagnostic/capturing-diagnostic-info [diag-info-fn] ;; various body forms ;; fetch the diagnostic info, which should be available if execute code called record-diagnostic-info-for-pool! (diag-info-fn)) ```

(defmacro capturing-diagnostic-info
  {:style/indent 1}
  [[diagnostic-info-fn-binding] & body]
  `(do-with-diagnostic-info (fn [~diagnostic-info-fn-binding] ~@body)))

Captures diagnostic info related to the given driver, database-id, and datasource (which are all related). The current information that is captured (in a map whose keys are namespaced keywords in this ns) is:

  • ::database-id: the database ID (from the parameter value)
  • ::driver: the driver (from the parameter value)
  • ::active-connections: the number of active connections in the given datasource's pool
  • ::total-connections: the number of total connections in the given datasource's pool
  • ::threads-waiting: the number of threads waiting to get a connection to the given datasource's pool (which happens when the number of active connections has reached the max size).
(defn record-diagnostic-info-for-pool!
  [driver database-id ^PoolBackedDataSource datasource]
  (when *diagnostic-info*
    (swap! *diagnostic-info* #(assoc % ::database-id        database-id
                                       ::driver             driver
                                       ::active-connections (.getNumBusyConnectionsAllUsers datasource)
                                       ::total-connections  (.getNumConnectionsAllUsers datasource)
                                       ::threads-waiting    (.getNumThreadsAwaitingCheckoutDefaultUser datasource)))))
 

Implementations of sql-jdbc.execute methods for JDBC drivers that aren't fully JDBC 4.2 compliant or otherwise don't fully support the new JSR-310 java.time classes. Drivers with ::use-legacy-classes-for-read-and-set as a parent will use these implementations instead of the defaults.

(ns metabase.driver.sql-jdbc.execute.legacy-impl
  (:require
   [java-time.api :as t]
   [metabase.driver :as driver]
   [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute]
   [metabase.util.date-2 :as u.date]
   [metabase.util.log :as log])
  (:import
   (java.sql PreparedStatement ResultSet Types)
   (java.time LocalDate LocalDateTime LocalTime OffsetDateTime OffsetTime ZonedDateTime)
   (java.util Calendar TimeZone)))
(set! *warn-on-reflection* true)

TODO - need to do a legacy implementation using the new methods as well...

method impls for JDBC drivers that aren't fully JDBC 4.2 compliant/don't support the new java.time methods

(driver/register! ::use-legacy-classes-for-read-and-set, :abstract? true)
(defmethod sql-jdbc.execute/set-parameter [::use-legacy-classes-for-read-and-set LocalDate]
  [_ ^PreparedStatement ps ^Integer i t]
  (let [t (t/sql-date t)]
    (log/tracef "(.setDate ps %d ^%s %s)" i (.getName (class t)) (pr-str t))
    (.setDate ps i t)))
(defmethod sql-jdbc.execute/set-parameter [::use-legacy-classes-for-read-and-set LocalDateTime]
  [_ ^PreparedStatement ps ^Integer i t]
  (let [t (t/sql-timestamp t)]
    (log/tracef "(.setTimestamp %d ^%s %s)" i (.getName (class t)) (pr-str t))
    (.setTimestamp ps i t)))
(defmethod sql-jdbc.execute/set-parameter [::use-legacy-classes-for-read-and-set LocalTime]
  [_ ^PreparedStatement ps ^Integer i t]
  (let [t (t/sql-time t)]
    (log/tracef "(.setTime %d ^%s %s)" i (.getName (class t)) (pr-str t))
    (.setTime ps i t)))
(defmethod sql-jdbc.execute/set-parameter [::use-legacy-classes-for-read-and-set OffsetTime]
  [_ ^PreparedStatement ps ^Integer i t]
  (let [cal (Calendar/getInstance (TimeZone/getTimeZone (t/zone-id t)))
        t   (t/sql-time t)]
    (log/tracef "(.setTime %d ^%s %s <%s Calendar>)" i (.getName (class t)) (pr-str t) (.. cal getTimeZone getID))
    (.setTime ps i t cal)))
(defmethod sql-jdbc.execute/set-parameter [::use-legacy-classes-for-read-and-set OffsetDateTime]
  [_ ^PreparedStatement ps ^Integer i t]
  (let [cal (Calendar/getInstance (TimeZone/getTimeZone (t/zone-id t)))
        t   (t/sql-timestamp t)]
    (log/tracef "(.setTimestamp %d ^%s %s <%s Calendar>)" i (.getName (class t)) (pr-str t) (.. cal getTimeZone getID))
    (.setTimestamp ps i t cal)))
(defmethod sql-jdbc.execute/set-parameter [::use-legacy-classes-for-read-and-set ZonedDateTime]
  [_ ^PreparedStatement ps ^Integer i t]
  (let [cal (Calendar/getInstance (TimeZone/getTimeZone (t/zone-id t)))
        t   (t/sql-timestamp t)]
    (log/tracef "(.setTimestamp %d ^%s %s <%s Calendar>)" i (.getName (class t)) (pr-str t) (.. cal getTimeZone getID))
    (.setTimestamp ps i t cal)))
(defmethod sql-jdbc.execute/read-column-thunk [::use-legacy-classes-for-read-and-set Types/TIME]
  [_ ^ResultSet rs _ ^Integer i]
  (fn []
    (when-let [s (.getString rs i)]
      (let [t (u.date/parse s)]
        (log/tracef "(.getString rs i) [TIME] -> %s -> %s" (pr-str s) (pr-str t))
        t))))
(defmethod sql-jdbc.execute/read-column-thunk [::use-legacy-classes-for-read-and-set Types/DATE]
  [_ ^ResultSet rs _ ^Integer i]
  (fn []
    (when-let [s (.getString rs i)]
      (let [t (u.date/parse s)]
        (log/tracef "(.getString rs i) [DATE] -> %s -> %s" (pr-str s) (pr-str t))
        t))))
(defmethod sql-jdbc.execute/read-column-thunk [::use-legacy-classes-for-read-and-set Types/TIMESTAMP]
  [_ ^ResultSet rs _ ^Integer i]
  (fn []
    (when-let [s (.getString rs i)]
      (let [t (u.date/parse s)]
        (log/tracef "(.getString rs i) [TIMESTAMP] -> %s -> %s" (pr-str s) (pr-str t))
        t))))
(doseq [dispatch-val (keys (methods sql-jdbc.execute/read-column-thunk))
        :when        (sequential? dispatch-val)
        :let         [[driver jdbc-type] dispatch-val]
        :when        (= driver ::use-legacy-classes-for-read-and-set)]
  (prefer-method sql-jdbc.execute/read-column-thunk dispatch-val [:sql-jdbc jdbc-type]))
 

Old implementations of [[metabase.driver.sql-jdbc.execute]] methods. All methods and functions in this namespace should be considered deprecated and will be removed in future releases.

(ns metabase.driver.sql-jdbc.execute.old-impl
  (:require
   [metabase.driver :as driver]))
(set! *warn-on-reflection* true)

Deprecated in Metabase 47. Implement [[metabase.driver.sql-jdbc.execute/do-with-connection-with-options]] instead. This method will be removed in or after Metabase 50.

(defmulti connection-with-timezone
  {:added "0.35.0", :deprecated "0.47.0", :arglists '(^java.sql.Connection [driver database ^String timezone-id])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

Return a format string containing a SQL statement to be used to set the timezone for the current transaction. The %s will be replaced with a string literal for a timezone, e.g. US/Pacific. (Timezone ID will come already wrapped in single quotes.)

"SET @@session.time_zone = %s;"

This method is only called for drivers using the default implementation of [[metabase.driver.sql-jdbc.execute/do-with-connection-with-options]]; it should be considered deprecated in favor of implementing [[metabase.driver.sql-jdbc.execute/do-with-connection-with-options]] directly.

(defmulti set-timezone-sql
  {:added "0.35.0", :deprecated "0.35.0", :arglists '([driver])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
(defmethod set-timezone-sql :sql-jdbc [_] nil)
 

Implementations for sync-related driver multimethods for SQL JDBC drivers, using JDBC DatabaseMetaData.

(ns metabase.driver.sql-jdbc.sync
  (:require
   [metabase.driver.sql-jdbc.sync.dbms-version :as sql-jdbc.dbms-version]
   [metabase.driver.sql-jdbc.sync.describe-database
    :as sql-jdbc.describe-database]
   [metabase.driver.sql-jdbc.sync.describe-table
    :as sql-jdbc.describe-table]
   [metabase.driver.sql-jdbc.sync.interface :as sql-jdbc.sync.interface]
   [potemkin :as p]))
(comment sql-jdbc.dbms-version/keep-me sql-jdbc.sync.interface/keep-me sql-jdbc.describe-database/keep-me sql-jdbc.describe-table/keep-me)
#_{:clj-kondo/ignore [:deprecated-var]}
(p/import-vars
 [sql-jdbc.sync.interface
  active-tables
  column->semantic-type
  database-type->base-type
  db-default-timezone
  describe-nested-field-columns
  excluded-schemas
  fallback-metadata-query
  filtered-syncable-schemas
  have-select-privilege?]

 [sql-jdbc.describe-table
  add-table-pks
  describe-table
  describe-table-fields
  describe-table-fks
  describe-table-indexes
  get-catalogs
  pattern-based-database-type->base-type]

 [sql-jdbc.describe-database
  describe-database
  fast-active-tables
  post-filtered-active-tables]

 [sql-jdbc.dbms-version
  dbms-version])
 
(ns metabase.driver.sql-jdbc.sync.common
  (:require
   [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute])
  (:import
   (java.sql Connection PreparedStatement ResultSet)))
(set! *warn-on-reflection* true)

Create a PreparedStatement for metadata queries; set TYPE_FORWARD_ONLY/CONCUR_READ_ONLY/FETCH_FORWARD options if possible. These queries return no rows.

(defn prepare-statement
  ^PreparedStatement [driver ^Connection conn ^String sql params]
  ;; `sql-jdbc.execute/prepared-statement` will set `TYPE_FORWARD_ONLY`/`CONCUR_READ_ONLY`/`FETCH_FORWARD` if
  ;; possible, although I'm not sure if that will make a difference if we don't actually realize the ResultSet
  (doto ^PreparedStatement (sql-jdbc.execute/prepared-statement driver conn sql params)
    (.setMaxRows 0)))

Creates an IReduceInit for a function that returns a ResultSet, and a function that is called once for each row. rs-thunk should return a ResultSet; rs->row-thunk has the signature

(rs->row-thunk rs)-> row-thunk

rs->row-thunk is called once with the ResultSet, and should return a thunk; the resulting thunk is called once for each row. Example:

(reducible-results ;; rs-thunk should return a ResultSet #(.getSchemas metadata) ;; rs->row-thunk is called once with the ResultSet, and returns a thunk (fn [rs] ;; the thunk is called once for each row to get results (fn [] (.getString rs "TABLE_SCHEM"))))

(defn reducible-results
  [rs-thunk rs->row-thunk]
  (reify clojure.lang.IReduceInit
    (reduce [_ rf init]
      (with-open [^ResultSet rs (rs-thunk)]
        (reduce
         ((take-while some?) rf)
         init
         (let [row-thunk (rs->row-thunk rs)]
           (repeatedly #(when (.next rs)
                          (row-thunk)))))))))
 
(ns metabase.driver.sql-jdbc.sync.dbms-version
  (:require
   [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute]))
(set! *warn-on-reflection* true)

Default implementation of driver/dbms-version for SQL JDBC drivers. Uses JDBC DatabaseMetaData.

(defn dbms-version
  [driver jdbc-spec]
  (sql-jdbc.execute/do-with-connection-with-options
   driver
   jdbc-spec
   nil
   (fn [^java.sql.Connection conn]
     (let [metadata (.getMetaData conn)]
       {:flavor           (.getDatabaseProductName metadata)
        :version          (.getDatabaseProductVersion metadata)
        :semantic-version [(.getDatabaseMajorVersion metadata)
                           (.getDatabaseMinorVersion metadata)]}))))
 

SQL JDBC impl for describe-database.

(ns metabase.driver.sql-jdbc.sync.describe-database
  (:require
   [clojure.string :as str]
   [metabase.driver :as driver]
   [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute]
   [metabase.driver.sql-jdbc.sync.common :as sql-jdbc.sync.common]
   [metabase.driver.sql-jdbc.sync.interface :as sql-jdbc.sync.interface]
   [metabase.driver.sql.query-processor :as sql.qp]
   [metabase.driver.sync :as driver.s]
   [metabase.driver.util :as driver.u]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.models :refer [Database]]
   [metabase.models.interface :as mi]
   [metabase.query-processor.store :as qp.store]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms])
  (:import
   (java.sql Connection DatabaseMetaData ResultSet)))
(set! *warn-on-reflection* true)
(defmethod sql-jdbc.sync.interface/excluded-schemas :sql-jdbc [_] nil)

Get a reducible sequence of all string schema names for the current database from its JDBC database metadata.

(defn all-schemas
  [^DatabaseMetaData metadata]
  {:added "0.39.0", :pre [(instance? DatabaseMetaData metadata)]}
  (sql-jdbc.sync.common/reducible-results
   #(.getSchemas metadata)
   (fn [^ResultSet rs]
     #(.getString rs "TABLE_SCHEM"))))
(defmethod sql-jdbc.sync.interface/filtered-syncable-schemas :sql-jdbc
  [driver _ metadata schema-inclusion-patterns schema-exclusion-patterns]
  (eduction (remove (set (sql-jdbc.sync.interface/excluded-schemas driver)))
            ;; remove the persisted_model schemas
            (remove (fn [schema] (re-find #"^metabase_cache.*" schema)))
            (filter (partial driver.s/include-schema? schema-inclusion-patterns schema-exclusion-patterns))
            (all-schemas metadata)))
(mu/defn simple-select-probe-query :- [:cat ms/NonBlankString [:* :any]]
  "Simple (ie. cheap) SELECT on a given table to test for access and get column metadata. Doesn't return
  anything useful (only used to check whether we can execute a SELECT query)
    (simple-select-probe-query :postgres \"public\" \"my_table\")
    ;; -> [\"SELECT TRUE FROM public.my_table WHERE 1 <> 1 LIMIT 0\"]"
  [driver :- :keyword
   schema :- [:maybe :string]        ; I think technically some DBs like SQL Server support empty schema and table names
   table  :- :string]
  ;; Using our SQL compiler here to get portable LIMIT (e.g. `SELECT TOP n ...` for SQL Server/Oracle)
  (let [tru      (sql.qp/->honeysql driver true)
        table    (sql.qp/->honeysql driver (h2x/identifier :table schema table))
        honeysql {:select [[tru :_]]
                  :from   [[table]]
                  :where  [:inline [:not= 1 1]]}
        honeysql (sql.qp/apply-top-level-clause driver :limit honeysql {:limit 0})]
    (sql.qp/format-honeysql driver honeysql)))

Execute the simple SELECT query defined above. The main goal here is to check whether we're able to execute a SELECT query against the Table in question -- we don't care about the results themselves -- so the query and the logic around executing it should be as simple as possible. We need to highly optimize this logic because it's executed for every Table on every sync.

(defn- execute-select-probe-query
  [driver ^Connection conn [sql & params]]
  {:pre [(string? sql)]}
  (with-open [stmt (sql-jdbc.sync.common/prepare-statement driver conn sql params)]
    (log/tracef "[%s] %s" (name driver) sql)
    ;; attempting to execute the SQL statement will throw an Exception if we don't have permissions; otherwise it will
    ;; truthy wheter or not it returns a ResultSet, but we can ignore that since we have enough info to proceed at
    ;; this point.
    (.execute stmt)))
(defmethod sql-jdbc.sync.interface/have-select-privilege? :sql-jdbc
  [driver ^Connection conn table-schema table-name]
  ;; Query completes = we have SELECT privileges
  ;; Query throws some sort of no permissions exception = no SELECT privileges
  (let [sql-args (simple-select-probe-query driver table-schema table-name)]
    (log/tracef "Checking for SELECT privileges for %s with query %s"
                (str (when table-schema
                       (str (pr-str table-schema) \.))
                     (pr-str table-name))
                (pr-str sql-args))
    (try
      (execute-select-probe-query driver conn sql-args)
      (log/trace "SELECT privileges confirmed")
      true
      (catch Throwable e
        (log/trace e "Assuming no SELECT privileges: caught exception")
        (when-not (.getAutoCommit conn)
          (.rollback conn))
        false))))

Fetch a JDBC Metadata ResultSet of tables in the DB, optionally limited to ones belonging to a given schema. Returns a reducible sequence of results.

(defn db-tables
  [driver ^DatabaseMetaData metadata ^String schema-or-nil ^String db-name-or-nil]
  (with-open [rset (.getTables metadata db-name-or-nil (some->> schema-or-nil (driver/escape-entity-name-for-metadata driver)) "%"
                               (into-array String ["TABLE" "PARTITIONED TABLE" "VIEW" "FOREIGN TABLE" "MATERIALIZED VIEW"
                                                   "EXTERNAL TABLE" "DYNAMIC_TABLE"]))]
    (loop [acc []]
      (if-not (.next rset)
        acc
        (recur (conj acc {:name        (.getString rset "TABLE_NAME")
                          :schema      (.getString rset "TABLE_SCHEM")
                          :description (when-let [remarks (.getString rset "REMARKS")]
                                         (when-not (str/blank? remarks)
                                           remarks))}))))))

Default, fast implementation of active-tables best suited for DBs with lots of system tables (like Oracle). Fetch list of schemas, then for each one not in excluded-schemas, fetch its Tables, and combine the results.

This is as much as 15x faster for Databases with lots of system tables than post-filtered-active-tables (4 seconds vs 60).

(defn fast-active-tables
  [driver ^Connection conn & [db-name-or-nil schema-inclusion-filters schema-exclusion-filters]]
  {:pre [(instance? Connection conn)]}
  (let [metadata (.getMetaData conn)]
    (eduction
     (comp (mapcat (fn [schema]
                     (db-tables driver metadata schema db-name-or-nil)))
           (filter (fn [{table-schema :schema table-name :name}]
                     (sql-jdbc.sync.interface/have-select-privilege? driver conn table-schema table-name))))
     (sql-jdbc.sync.interface/filtered-syncable-schemas driver conn metadata
                                                        schema-inclusion-filters schema-exclusion-filters))))
(defmethod sql-jdbc.sync.interface/active-tables :sql-jdbc
  [driver connection schema-inclusion-filters schema-exclusion-filters]
  (fast-active-tables driver connection nil schema-inclusion-filters schema-exclusion-filters))

Alternative implementation of active-tables best suited for DBs with little or no support for schemas. Fetch all Tables, then filter out ones whose schema is in excluded-schemas Clojure-side.

(defn post-filtered-active-tables
  [driver ^Connection conn & [db-name-or-nil schema-inclusion-filters schema-exclusion-filters]]
  {:pre [(instance? Connection conn)]}
  (eduction
   (filter (let [excluded (sql-jdbc.sync.interface/excluded-schemas driver)]
             (fn [{table-schema :schema, table-name :name}]
               (and (not (contains? excluded table-schema))
                    (driver.s/include-schema? schema-inclusion-filters schema-exclusion-filters table-schema)
                    (sql-jdbc.sync.interface/have-select-privilege? driver conn table-schema table-name)))))
   (db-tables driver (.getMetaData conn) nil db-name-or-nil)))
(defn- db-or-id-or-spec->database [db-or-id-or-spec]
  (cond (mi/instance-of? Database db-or-id-or-spec)
        db-or-id-or-spec
        (int? db-or-id-or-spec)
        (qp.store/with-metadata-provider db-or-id-or-spec
          (lib.metadata/database (qp.store/metadata-provider)))
        :else
        nil))

Default implementation of [[metabase.driver/describe-database]] for SQL JDBC drivers. Uses JDBC DatabaseMetaData.

(mu/defn describe-database
  [driver           :- :keyword
   db-or-id-or-spec :- [:or :int :map]]
  {:tables
   (sql-jdbc.execute/do-with-connection-with-options
    driver
    db-or-id-or-spec
    nil
    (fn [^Connection conn]
      (let [schema-filter-prop      (driver.u/find-schema-filters-prop driver)
            has-schema-filter-prop? (some? schema-filter-prop)
            default-active-tbl-fn   #(into #{} (sql-jdbc.sync.interface/active-tables driver conn nil nil))]
        (if has-schema-filter-prop?
          (if-let [database (db-or-id-or-spec->database db-or-id-or-spec)]
            (let [prop-nm                                 (:name schema-filter-prop)
                  [inclusion-patterns exclusion-patterns] (driver.s/db-details->schema-filter-patterns
                                                           prop-nm
                                                           database)]
              (into #{} (sql-jdbc.sync.interface/active-tables driver conn inclusion-patterns exclusion-patterns)))
            (default-active-tbl-fn))
          (default-active-tbl-fn)))))})
 

SQL JDBC impl for describe-table, describe-table-fks, and describe-nested-field-columns.

(ns metabase.driver.sql-jdbc.sync.describe-table
  (:require
   [cheshire.core :as json]
   [clojure.java.jdbc :as jdbc]
   [clojure.set :as set]
   [clojure.string :as str]
   [medley.core :as m]
   [metabase.db.metadata-queries :as metadata-queries]
   [metabase.driver :as driver]
   [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn]
   [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute]
   [metabase.driver.sql-jdbc.sync.common :as sql-jdbc.sync.common]
   [metabase.driver.sql-jdbc.sync.interface :as sql-jdbc.sync.interface]
   [metabase.driver.sql.query-processor :as sql.qp]
   [metabase.lib.schema.literal :as lib.schema.literal]
   [metabase.models :refer [Field]]
   [metabase.models.table :as table]
   [metabase.util :as u]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.log :as log]
   [metabase.util.malli.registry :as mr]
   #_{:clj-kondo/ignore [:discouraged-namespace]}
   [toucan2.core :as t2])
  (:import
   (java.sql Connection DatabaseMetaData ResultSet)))
(set! *warn-on-reflection* true)
(defmethod sql-jdbc.sync.interface/column->semantic-type :sql-jdbc
  [_driver _database-type _column-name]
  nil)

Return a database-type->base-type function that matches types based on a sequence of pattern / base-type pairs. pattern->type is a map of regex pattern to MBQL type keyword.

(defn pattern-based-database-type->base-type
  [pattern->type]
  (fn database-type->base-type [column-type]
    (let [column-type (name column-type)]
      (some
       (fn [[pattern base-type]]
         (when (re-find pattern column-type)
           base-type))
       pattern->type))))

Returns a set of all of the catalogs found via metadata

(defn get-catalogs
  [^DatabaseMetaData metadata]
  (with-open [rs (.getCatalogs metadata)]
    (set (map :table_cat (jdbc/metadata-result rs)))))

Given a database-type (e.g. VARCHAR) return the mapped Metabase type (e.g. :type/Text).

(defn- database-type->base-type-or-warn
  [driver database-type]
  (or (sql-jdbc.sync.interface/database-type->base-type driver (keyword database-type))
      (do (log/warn (format "Don't know how to map column type '%s' to a Field base_type, falling back to :type/*."
                            database-type))
          :type/*)))

Get an appropriate semantic type for a column with column-name of type database-type.

(defn- calculated-semantic-type
  [driver ^String column-name ^String database-type]
  (when-let [semantic-type (sql-jdbc.sync.interface/column->semantic-type driver database-type column-name)]
    (assert (isa? semantic-type :type/*)
      (str "Invalid type: " semantic-type))
    semantic-type))
(defmethod sql-jdbc.sync.interface/fallback-metadata-query :sql-jdbc
  [driver db-name-or-nil schema-name table-name]
  {:pre [(string? table-name)]}
  ;; Using our SQL compiler here to get portable LIMIT (e.g. `SELECT TOP n ...` for SQL Server/Oracle)
  (let [table    (sql.qp/->honeysql driver (h2x/identifier :table db-name-or-nil schema-name table-name))
        honeysql {:select [:*]
                  :from   [[table]]
                  :where  [:not= (sql.qp/inline-num 1) (sql.qp/inline-num 1)]}
        honeysql (sql.qp/apply-top-level-clause driver :limit honeysql {:limit 0})]
    (sql.qp/format-honeysql driver honeysql)))

In some rare cases :column_name is blank (eg. SQLite's views with group by) fallback to sniffing the type from a SELECT * query.

(defn fallback-fields-metadata-from-select-query
  [driver ^Connection conn db-name-or-nil schema table]
  ;; some DBs (:sqlite) don't actually return the correct metadata for LIMIT 0 queries
  (let [[sql & params] (sql-jdbc.sync.interface/fallback-metadata-query driver db-name-or-nil schema table)]
    (reify clojure.lang.IReduceInit
      (reduce [_ rf init]
        (with-open [stmt (sql-jdbc.sync.common/prepare-statement driver conn sql params)
                    rs   (.executeQuery stmt)]
          (let [metadata (.getMetaData rs)]
            (reduce
             ((map (fn [^Integer i]
                     ;; TODO: missing :database-required column as ResultSetMetadata does not have information about
                     ;; the default value of a column, so we can't make sure whether a column is required or not
                     {:name                       (.getColumnName metadata i)
                      :database-type              (.getColumnTypeName metadata i)
                      :database-is-auto-increment (.isAutoIncrement metadata i)})) rf)
             init
             (range 1 (inc (.getColumnCount metadata))))))))))

Reducible metadata about the Fields belonging to a Table, fetching using JDBC DatabaseMetaData methods.

(defn- jdbc-fields-metadata
  [driver ^Connection conn db-name-or-nil schema table-name]
  (sql-jdbc.sync.common/reducible-results
    #(.getColumns (.getMetaData conn)
                  db-name-or-nil
                  (some->> schema (driver/escape-entity-name-for-metadata driver))
                  (some->> table-name (driver/escape-entity-name-for-metadata driver))
                  nil)
    (fn [^ResultSet rs]
      ;; https://docs.oracle.com/javase/7/docs/api/java/sql/DatabaseMetaData.html#getColumns(java.lang.String,%20java.lang.String,%20java.lang.String,%20java.lang.String)
      #(let [default            (.getString rs "COLUMN_DEF")
             no-default?        (contains? #{nil "NULL" "null"} default)
             nullable           (.getInt rs "NULLABLE")
             not-nullable?      (= 0 nullable)
             ;; IS_AUTOINCREMENT could return nil
             auto-increment     (.getString rs "IS_AUTOINCREMENT")
             auto-increment?    (= "YES" auto-increment)
             no-auto-increment? (= "NO" auto-increment)
             column-name        (.getString rs "COLUMN_NAME")
             required?          (and no-default? not-nullable? no-auto-increment?)]
         (merge
           {:name                       column-name
            :database-type              (.getString rs "TYPE_NAME")
            :database-is-auto-increment auto-increment?
            :database-required          required?}
           (when-let [remarks (.getString rs "REMARKS")]
             (when-not (str/blank? remarks)
               {:field-comment remarks})))))))
(defn ^:private fields-metadata
  [driver ^Connection conn {schema :schema, table-name :name} ^String db-name-or-nil]
  {:pre [(instance? Connection conn) (string? table-name)]}
  (reify clojure.lang.IReduceInit
    (reduce [_ rf init]
      ;; 1. Return all the Fields that come back from DatabaseMetaData that include type info.
      ;;
      ;; 2. Iff there are some Fields that don't have type info, concatenate
      ;;    `fallback-fields-metadata-from-select-query`, which fetches the same Fields using a different method.
      ;;
      ;; 3. Filter out any duplicates between the two methods using `m/distinct-by`.
      (let [has-fields-without-type-info? (volatile! false)
            ;; intented to fix syncing dynamic tables for snowflake.
            ;; currently there is a bug in snowflake jdbc (snowflake#1574) in which it doesn't return columns for dynamic tables
            jdbc-returns-no-field?        (volatile! true)
            jdbc-metadata                 (eduction
                                           (remove (fn [{:keys [database-type]}]
                                                     (when @jdbc-returns-no-field?
                                                       (vreset! jdbc-returns-no-field? false))
                                                     (when (str/blank? database-type)
                                                       (vreset! has-fields-without-type-info? true)
                                                       true)))
                                           (jdbc-fields-metadata driver conn db-name-or-nil schema table-name))
            fallback-metadata             (reify clojure.lang.IReduceInit
                                            (reduce [_ rf init]
                                              (reduce
                                               rf
                                               init
                                               (when (or @jdbc-returns-no-field? @has-fields-without-type-info?)
                                                 (fallback-fields-metadata-from-select-query driver conn db-name-or-nil schema table-name)))))]
        ;; VERY IMPORTANT! DO NOT REWRITE THIS TO BE LAZY! IT ONLY WORKS BECAUSE AS NORMAL-FIELDS GETS REDUCED,
        ;; HAS-FIELDS-WITHOUT-TYPE-INFO? WILL GET SET TO TRUE IF APPLICABLE AND THEN FALLBACK-FIELDS WILL RUN WHEN
        ;; IT'S TIME TO START EVALUATING THAT.
        (reduce
         ((comp cat (m/distinct-by :name)) rf)
         init
         [jdbc-metadata fallback-metadata])))))

Returns a transducer for computing metadata about the fields in table.

(defn describe-table-fields-xf
  [driver table]
  (map-indexed (fn [i {:keys [database-type], column-name :name, :as col}]
                 (let [base-type      (database-type->base-type-or-warn driver database-type)
                       semantic-type  (calculated-semantic-type driver column-name database-type)
                       db             (table/database table)
                       json?          (isa? base-type :type/JSON)]
                   (merge
                    (u/select-non-nil-keys col [:name :database-type :field-comment :database-required :database-is-auto-increment])
                    {:base-type         base-type
                     :database-position i
                     ;; json-unfolding is true by default for JSON fields, but this can be overridden at the DB level
                     :json-unfolding    json?}
                    (when semantic-type
                      {:semantic-type semantic-type})
                    (when (and json? (driver/database-supports? driver :nested-field-columns db))
                      {:visibility-type :details-only}))))))

Returns a set of column metadata for table using JDBC Connection conn.

(defmulti describe-table-fields
  {:added    "0.45.0"
   :arglists '([driver ^Connection conn table ^String db-name-or-nil])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
(defmethod describe-table-fields :sql-jdbc
  [driver conn table db-name-or-nil]
  (into
   #{}
   (describe-table-fields-xf driver table)
   (fields-metadata driver conn table db-name-or-nil)))

Returns a vector of primary keys for table using a JDBC DatabaseMetaData from JDBC Connection conn. The PKs should be ordered by column names if there are multiple PKs. Ref: https://docs.oracle.com/javase/8/docs/api/java/sql/DatabaseMetaData.html#getPrimaryKeys-java.lang.String-java.lang.String-java.lang.String-

Note: If db-name, schema, and table-name are not passed, this may return all pks that the metadata's connection can access.

(defmulti get-table-pks
  {:changelog-test/ignore true
   :added    "0.45.0"
   :arglists '([driver ^Connection conn db-name-or-nil table])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
(defmethod get-table-pks :default
  [_driver ^Connection conn db-name-or-nil table]
  (let [^DatabaseMetaData metadata (.getMetaData conn)]
    (into [] (sql-jdbc.sync.common/reducible-results
              #(.getPrimaryKeys metadata db-name-or-nil (:schema table) (:name table))
              (fn [^ResultSet rs] #(.getString rs "COLUMN_NAME"))))))

Using conn, find any primary keys for table (or more, see: [[get-table-pks]]) and finally assoc :pk? to true for those columns.

(defn add-table-pks
  [driver ^Connection conn db-name-or-nil table]
  (let [pks (set (get-table-pks driver conn db-name-or-nil table))]
    (update table :fields (fn [fields]
                            (set (for [field fields]
                                   (if-not (contains? pks (:name field))
                                     field
                                     (assoc field :pk? true))))))))
(defn- describe-table*
  ([driver ^Connection conn table]
   (describe-table* driver conn nil table))
  ([driver ^Connection conn db-name-or-nil table]
   {:pre [(instance? Connection conn)]}
   (->> (assoc (select-keys table [:name :schema])
               :fields (describe-table-fields driver conn table nil))
        ;; find PKs and mark them
        (add-table-pks driver conn db-name-or-nil))))

Default implementation of driver/describe-table for SQL JDBC drivers. Uses JDBC DatabaseMetaData.

(defn describe-table
  [driver db-or-id-or-spec-or-conn table]
  (if (instance? Connection db-or-id-or-spec-or-conn)
    (describe-table* driver db-or-id-or-spec-or-conn table)
    (sql-jdbc.execute/do-with-connection-with-options
     driver
     db-or-id-or-spec-or-conn
     nil
     (fn [^Connection conn]
       (describe-table* driver conn table)))))
(defn- describe-table-fks*
  [_driver ^Connection conn {^String schema :schema, ^String table-name :name} & [^String db-name-or-nil]]
  (into
   #{}
   (sql-jdbc.sync.common/reducible-results #(.getImportedKeys (.getMetaData conn) db-name-or-nil schema table-name)
                                           (fn [^ResultSet rs]
                                             (fn []
                                               {:fk-column-name   (.getString rs "FKCOLUMN_NAME")
                                                :dest-table       {:name   (.getString rs "PKTABLE_NAME")
                                                                   :schema (.getString rs "PKTABLE_SCHEM")}
                                                :dest-column-name (.getString rs "PKCOLUMN_NAME")})))))

Default implementation of [[metabase.driver/describe-table-fks]] for SQL JDBC drivers. Uses JDBC DatabaseMetaData.

(defn describe-table-fks
  [driver db-or-id-or-spec-or-conn table & [db-name-or-nil]]
  (if (instance? Connection db-or-id-or-spec-or-conn)
    (describe-table-fks* driver db-or-id-or-spec-or-conn table db-name-or-nil)
    (sql-jdbc.execute/do-with-connection-with-options
     driver
     db-or-id-or-spec-or-conn
     nil
     (fn [^Connection conn]
       (describe-table-fks* driver conn table db-name-or-nil)))))

Default implementation of [[metabase.driver/describe-table-indexes]] for SQL JDBC drivers. Uses JDBC DatabaseMetaData.

(defn describe-table-indexes
  [driver db table]
  (sql-jdbc.execute/do-with-connection-with-options
   driver
   db
   nil
   (fn [^Connection conn]
     ;; https://docs.oracle.com/javase/8/docs/api/java/sql/DatabaseMetaData.html#getIndexInfo-java.lang.String-java.lang.String-java.lang.String-boolean-boolean-
     (with-open [index-info-rs (.getIndexInfo (.getMetaData conn)
                                              nil ;; catalog
                                              (:schema table)
                                              (:name table)
                                              ;; when true, return only indices for unique values when
                                              ;; false, return indices regardless of whether unique or not
                                              false
                                              ;; when true, result is allowed to reflect approximate or out of data
                                              ;; values. when false, results are requested to be accurate
                                              false)]
       (->> (vals (group-by :index_name (into []
                                              ;; filtered indexes are ignored
                                              (filter #(nil? (:filter_condition %)))
                                              (jdbc/reducible-result-set index-info-rs {}))))
            (keep (fn [idx-values]
                    ;; we only sync columns that are either singlely indexed or is the first key in a composite index
                    (when-let [index-name (some :column_name (sort-by :ordinal_position idx-values))]
                      {:type  :normal-column-index
                       :value index-name})))
            set)))))

Max string length for a row for nested field column before we just give up on parsing it. Marked as mutable because we mutate it for tests.

(def ^:dynamic *nested-field-column-max-row-length*
  50000)
(defn- flattened-row [field-name row]
  (letfn [(flatten-row [row path]
            (lazy-seq
              (when-let [[[k v] & xs] (seq row)]
                (cond (and (map? v) (not-empty v))
                      (into (flatten-row v (conj path k))
                            (flatten-row xs path))
                      :else
                      (cons [(conj path k) v]
                            (flatten-row xs path))))))]
    (into {} (flatten-row row [field-name]))))

Returns whether a string can be parsed to an ISO 8601 datetime or not.

(def ^:private ^{:arglists '([s])} can-parse-datetime?
  (mr/validator ::lib.schema.literal/string.datetime))

Mostly just (type member) but with a bit to suss out strings which are ISO8601 and say that they are datetimes

(defn- type-by-parsing-string
  [member]
  (let [member-type (type member)]
    (if (and (instance? String member)
             (can-parse-datetime? member))
      java.time.LocalDateTime
      member-type)))
(defn- row->types [row]
  (into {} (for [[field-name field-val] row
                 ;; We put top-level array row type semantics on JSON roadmap but skip for now
                 :when (map? field-val)]
             (let [flat-row (flattened-row field-name field-val)]
               (into {} (map (fn [[k v]] [k (type-by-parsing-string v)]) flat-row))))))
(defn- describe-json-xform [member]
  ((comp (map #(for [[k v] %
                     :when (< (count v) *nested-field-column-max-row-length*)]
                 [k (json/parse-string v)]))
         (map #(into {} %))
         (map row->types)) member))

Maximum number of nested field columns.

(def ^:const max-nested-field-columns
  100)

Reducing function that takes a bunch of maps from row->types, and gets them to conform to the type hierarchy, going through and taking the lowest common denominator type at each pass, ignoring the nils.

(defn- describe-json-rf
  ([] nil)
  ([acc-field-type-map] acc-field-type-map)
  ([acc-field-type-map second-field-type-map]
   (into {}
         (for [json-column (set/union (set (keys second-field-type-map))
                                      (set (keys acc-field-type-map)))]
           (cond
             (or (nil? acc-field-type-map)
                 (nil? (acc-field-type-map json-column))
                 (= (hash (acc-field-type-map json-column))
                    (hash (second-field-type-map json-column))))
             [json-column (second-field-type-map json-column)]
             (or (nil? second-field-type-map)
                 (nil? (second-field-type-map json-column)))
             [json-column (acc-field-type-map json-column)]
             (every? #(isa? % Number) [(acc-field-type-map json-column)
                                       (second-field-type-map json-column)])
             [json-column java.lang.Number]
             (every?
               (fn [column-type]
                 (some (fn [allowed-type]
                         (isa? column-type allowed-type))
                       [String Number Boolean java.time.LocalDateTime]))
               [(acc-field-type-map json-column) (second-field-type-map json-column)])
             [json-column java.lang.String]
             :else
             [json-column nil])))))

Map from Java types for deserialized JSON (so small subset of Java types) to MBQL types.

We actually do deserialize the JSON in order to determine types, so the java / clojure types we get have to be matched to MBQL types

(def field-type-map
  {java.lang.String                :type/Text
   ;; JSON itself has the single number type, but Java serde of JSON is stricter
   java.lang.Long                  :type/Integer
   clojure.lang.BigInt             :type/BigInteger
   java.math.BigInteger            :type/BigInteger
   java.lang.Integer               :type/Integer
   java.lang.Double                :type/Float
   java.lang.Float                 :type/Float
   java.math.BigDecimal            :type/Decimal
   java.lang.Number                :type/Number
   java.lang.Boolean               :type/Boolean
   java.time.LocalDateTime         :type/DateTime
   clojure.lang.PersistentVector   :type/Array
   clojure.lang.PersistentArrayMap :type/Structured
   clojure.lang.PersistentHashMap  :type/Structured})

Map from MBQL types to database types.

This is the lowest common denominator of types, hopefully, although as of writing this is just geared towards Postgres types

(def db-type-map
  {:type/Text       "text"
   :type/Integer    "bigint"
   ;; You might think that the ordinary 'bigint' type in Postgres and MySQL should be this.
   ;; However, Bigint in those DB's maxes out at 2 ^ 64.
   ;; JSON, like Javascript itself, will happily represent 1.8 * (10^308),
   ;; Losing digits merrily along the way.
   ;; We can't really trust anyone to use MAX_SAFE_INTEGER, in JSON-land..
   ;; So really without forcing arbitrary precision ('decimal' type),
   ;; we have too many numerical regimes to test.
   ;; (#22732) was basically the consequence of missing one.
   :type/BigInteger "decimal"
   :type/Float      "double precision"
   :type/Number     "double precision"
   :type/Decimal    "decimal"
   :type/Boolean    "boolean"
   :type/DateTime   "timestamp"
   :type/Array      "text"
   :type/Structured "text"})
(defn- field-types->fields [field-types]
  (let [valid-fields (for [[field-path field-type] (seq field-types)]
                       (if (nil? field-type)
                         nil
                         (let [curr-type (get field-type-map field-type :type/*)]
                           {:name              (str/join " \u2192 " (map name field-path)) ;; right arrow
                            :database-type     (db-type-map curr-type)
                            :base-type         curr-type
                            ;; Postgres JSONB field, which gets most usage, doesn't maintain JSON object ordering...
                            :database-position 0
                            :json-unfolding    false
                            :visibility-type   :normal
                            :nfc-path          field-path})))
        field-hash   (apply hash-set (filter some? valid-fields))]
    field-hash))

Given a table return a list of json fields that need to unfold.

(defn- table->unfold-json-fields
  [driver conn table]
  (let [table-fields (describe-table-fields driver conn table nil)
        json-fields  (filter #(isa? (:base-type %) :type/JSON) table-fields)]
    (if-not (seq json-fields)
      #{}
      (let [existing-fields-by-name (m/index-by :name (t2/select Field :table_id (u/the-id table)))
            should-not-unfold?      (fn [field]
                                      (when-let [existing-field (existing-fields-by-name (:name field))]
                                        (false? (:json_unfolding existing-field))))]
        (remove should-not-unfold? json-fields)))))

Return a honeysql query used to get row sample to describe json columns.

If the table has PKs, try to fetch both first and last rows (see #25744). Else fetch the first n rows only.

(defn- sample-json-row-honey-sql
  [table-identifier json-field-identifiers pk-identifiers]
  (let [pks-expr         (mapv vector pk-identifiers)
        table-expr       [table-identifier]
        json-field-exprs (mapv vector json-field-identifiers)]
    (if (seq pk-identifiers)
      {:select json-field-exprs
       :from   [table-expr]
       ;; mysql doesn't support limit in subquery, so we're using inner join here
       :join  [[{:union [{:nest {:select   pks-expr
                                 :from     [table-expr]
                                 :order-by (mapv #(vector % :asc) pk-identifiers)
                                 :limit    (/ metadata-queries/nested-field-sample-limit 2)}}
                         {:nest {:select   pks-expr
                                 :from     [table-expr]
                                 :order-by (mapv #(vector % :desc) pk-identifiers)
                                 :limit    (/ metadata-queries/nested-field-sample-limit 2)}}]}
                :result]
               (into [:and]
                     (for [pk-identifier pk-identifiers]
                       [:=
                        (h2x/identifier :field :result (last (h2x/identifier->components pk-identifier)))
                        pk-identifier]))]}
      {:select json-field-exprs
       :from   [table-expr]
       :limit  metadata-queries/nested-field-sample-limit})))
(defn- describe-json-fields
  [driver jdbc-spec table json-fields pks]
  (let [table-identifier-info [(:schema table) (:name table)]
        json-field-identifiers (mapv #(apply h2x/identifier :field (into table-identifier-info [(:name %)])) json-fields)
        table-identifier (apply h2x/identifier :table table-identifier-info)
        pk-identifiers   (when (seq pks)
                           (mapv #(apply h2x/identifier :field (into table-identifier-info [%])) pks))
        sql-args         (sql.qp/format-honeysql
                          driver
                          (sample-json-row-honey-sql table-identifier json-field-identifiers pk-identifiers))
        query            (jdbc/reducible-query jdbc-spec sql-args {:identifiers identity})
        field-types      (transduce describe-json-xform describe-json-rf query)
        fields           (field-types->fields field-types)]
    (if (> (count fields) max-nested-field-columns)
      (do
        (log/warn
         (format
          "More nested field columns detected than maximum. Limiting the number of nested field columns to %d."
          max-nested-field-columns))
        (set (take max-nested-field-columns fields)))
      fields)))

The name's nested field columns but what the people wanted (issue #708) was JSON so what they're getting is JSON.

(defmethod sql-jdbc.sync.interface/describe-nested-field-columns :sql-jdbc
  [driver database table]
  (let [jdbc-spec (sql-jdbc.conn/db->pooled-connection-spec database)]
    (sql-jdbc.execute/do-with-connection-with-options
      driver
      jdbc-spec
      nil
      (fn [^Connection conn]
        (let [unfold-json-fields (table->unfold-json-fields driver conn table)
              pks                (get-table-pks driver conn (:name database) table)]
          (if (empty? unfold-json-fields)
            #{}
            (describe-json-fields driver jdbc-spec table unfold-json-fields pks)))))))
 
(ns metabase.driver.sql-jdbc.sync.interface
  (:require
   [metabase.driver :as driver]))

Return a reducible sequence of maps containing information about the active tables/views, collections, or equivalent that currently exist in a database. Each map should contain the key :name, which is the string name of the table. For databases that have a concept of schemas, this map should also include the string name of the table's :schema.

Two different implementations are provided in this namespace: fast-active-tables (the default), and post-filtered-active-tables. You should be fine using the default, but refer to the documentation for those functions for more details on the differences.

metabase is an instance of DatabaseMetaData.

(defmulti active-tables
  {:added "0.37.1"
   :arglists '([driver
                ^java.sql.Connection connection
                ^String schema-inclusion-filters
                ^String schema-exclusion-filters])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

Return set of string names of schemas to skip syncing tables from.

(defmulti excluded-schemas
  {:added "0.37.1" :arglists '([driver])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

Check if we have SELECT privileges for given table.

Default impl is in [[metabase.driver.sql-jdbc.sync.describe-database]].

(defmulti have-select-privilege?
  {:added "0.37.1" :arglists '([driver ^java.sql.Connection connection ^String table-schema ^String table-name])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

Return a reducible sequence of string names of schemas that should be synced for the given database. Schemas for which the current DB user has no SELECT permissions should be filtered out. The default implementation will fetch a sequence of all schema names from the JDBC database metadata and filter out any schemas in excluded-schemas, along with any that shouldn't be included based on the given inclusion and exclusion patterns (see the metabase.driver.sync namespace for full explanation).

(defmulti filtered-syncable-schemas
  {:changelog-test/ignore true
   :added "0.43.0"
   :arglists '([driver
                ^java.sql.Connection connection
                ^java.sql.DatabaseMetaData metadata
                ^String schema-inclusion-patterns
                ^String schema-exclusion-patterns])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

Given a native DB column type (as a keyword), return the corresponding Field base-type, which should derive from :type/*. You can use pattern-based-database-type->base-type in this namespace to implement this using regex patterns.

(defmulti database-type->base-type
  {:added "0.37.1" :arglists '([driver database-type])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

Attempt to determine the semantic-type of a field given the column name and native type. For example, the Postgres driver can mark Postgres JSON type columns as :type/SerializedJSON semantic type.

database-type and column-name will be strings.

(defmulti column->semantic-type
  {:added "0.37.1" :arglists '([driver database-type column-name])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

SELECT columns from a given table so we can get column metadata. By default doesn't return any rows. This can be overriden because SQLite is silly and only returns column information for views if the query returns a non-zero number of rows.

(fallback-metadata-query :postgres "mydatabase" "public" "mytable") ;; -> ["SELECT * FROM mydatabase.public.mytable WHERE 1 <> 1 LIMIT 0"]

(defmulti fallback-metadata-query
  {:added "0.37.1" :arglists '([driver db-name-or-nil schema-name table-name])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

JDBC-specific version of of [[metabase.driver/db-default-timezone]] that takes a [[clojure.java.jdbc]] connection spec rather than a set of DB details. If an implementation of this method is provided, it will be used automatically in the default :sql-jdbc implementation of [[metabase.driver/db-default-timezone]].

This exists so we can reuse this code with the application database without having to create a new Connection pool for the application DB.

DEPRECATED: you can implement [[metabase.driver/db-default-timezone]] directly; use [[metabase.driver.sql-jdbc.execute/do-with-connection-with-options]] to get a java.sql.Connection for a Database.

(defmulti db-default-timezone
  {:added "0.38.0", :arglists '([driver jdbc-spec]), :deprecated "0.48.0"}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
#_{:clj-kondo/ignore [:deprecated-var]}
(defmethod db-default-timezone :sql-jdbc
  [_driver _jdbc-spec]
  nil)

Return information about the nestable columns in a table. Required for drivers that support :nested-field-columns. Results should match the [[metabase.sync.interface/NestedFCMetadata]] schema.

(defmulti describe-nested-field-columns
  {:added "0.43.0", :arglists '([driver database table])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
 
(ns metabase.driver.sql.ddl
  (:require
   [clojure.java.jdbc :as jdbc]
   [metabase.driver.ddl.interface :as ddl.i]
   [metabase.driver.sql.util :as sql.u]
   [metabase.public-settings :as public-settings]))
(defn- quote-fn [driver]
  (fn quote [ident entity]
    (sql.u/quote-name driver ident (ddl.i/format-name driver entity))))
(defn- add-remark [sql-str]
  (str "-- Metabase\n"
       sql-str))
(defn- jdbc-spec [connection-or-spec]
  (cond
    (instance? java.sql.Connection connection-or-spec) {:connection connection-or-spec}
    (map? connection-or-spec)                          connection-or-spec
    :else                                              (throw (ex-info "Invalid JDBC connection spec" {:spec connection-or-spec}))))

Executes sql and params with a standard remark prepended to the statement.

TODO -- move the JDBC stuff to something like [[metabase.driver.sql-jdbc.ddl]]. JDBC-specific stuff does not belong IN [[metabase.driver.sql]] !!

(defn execute!
  [connection-or-spec [sql & params]]
  (jdbc/execute! (jdbc-spec connection-or-spec) (into [(add-remark sql)] params)))

Queries sql and params with a standard remark prepended to the statement.

(defn jdbc-query
  [connection-or-spec [sql & params]]
  (jdbc/query (jdbc-spec connection-or-spec) (into [(add-remark sql)] params)))

SQL string to create a schema suitable

(defn create-schema-sql
  [{driver :engine :as database}]
  (let [q (quote-fn driver)]
    (format "create schema %s"
            (q :table (ddl.i/schema-name database (public-settings/site-uuid))))))

SQL string to drop a schema suitable

(defn drop-schema-sql
  [{driver :engine :as database}]
  (let [q (quote-fn driver)]
    (format "drop schema if exists %s"
            (q :table (ddl.i/schema-name database (public-settings/site-uuid))))))

Formats a create table statement within our own cache schema

(defn create-table-sql
  [{driver :engine :as database} definition query]
  (let [q (quote-fn driver)]
    (format "create table %s.%s as %s"
            (q :table (ddl.i/schema-name database (public-settings/site-uuid)))
            (q :table (:table-name definition))
            query)))

Formats a drop table statement within our own cache schema

(defn drop-table-sql
  [{driver :engine :as database} table-name]
  (let [q (quote-fn driver)]
    (format "drop table if exists %s.%s"
            (q :table (ddl.i/schema-name database (public-settings/site-uuid)))
            (q :table table-name))))
 
(ns metabase.driver.sql.parameters.substitute
  (:require
   [clojure.string :as str]
   [metabase.driver :as driver]
   [metabase.driver.common.parameters :as params]
   [metabase.driver.sql.parameters.substitution
    :as sql.params.substitution]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]))
(defn- substitute-field-filter [[sql args missing] in-optional? k {:keys [_field value], :as v}]
  (if (and (= params/no-value value) in-optional?)
    ;; no-value field filters inside optional clauses are ignored, and eventually emitted entirely
    [sql args (conj missing k)]
    ;; otherwise no values get replaced with `1 = 1` and other values get replaced normally
    (let [{:keys [replacement-snippet prepared-statement-args]}
          (sql.params.substitution/->replacement-snippet-info driver/*driver* v)]
      [(str sql replacement-snippet) (concat args prepared-statement-args) missing])))
(defn- substitute-card-query [[sql args missing] v]
  (let [{:keys [replacement-snippet prepared-statement-args]}
        (sql.params.substitution/->replacement-snippet-info driver/*driver* v)]
    [(str sql replacement-snippet) (concat args prepared-statement-args) missing]))
(defn- substitute-native-query-snippet [[sql args missing] v]
   (let [{:keys [replacement-snippet]} (sql.params.substitution/->replacement-snippet-info driver/*driver* v)]
     [(str sql replacement-snippet) args missing]))
(defn- substitute-param [param->value [sql args missing] in-optional? {:keys [k]}]
  (if-not (contains? param->value k)
    [sql args (conj missing k)]
    (let [v (get param->value k)]
      (cond
        (params/FieldFilter? v)
        (substitute-field-filter [sql args missing] in-optional? k v)
        (params/ReferencedCardQuery? v)
        (substitute-card-query [sql args missing] v)
        (params/ReferencedQuerySnippet? v)
        (substitute-native-query-snippet [sql args missing] v)
        (= params/no-value v)
        [sql args (conj missing k)]
        :else
        (let [{:keys [replacement-snippet prepared-statement-args]}
              (sql.params.substitution/->replacement-snippet-info driver/*driver* v)]
          [(str sql replacement-snippet) (concat args prepared-statement-args) missing])))))
(declare substitute*)
(defn- substitute-optional [param->value [sql args missing] {subclauses :args}]
  (let [[opt-sql opt-args opt-missing] (substitute* param->value subclauses true)]
    (if (seq opt-missing)
      [sql args missing]
      [(str sql opt-sql) (concat args opt-args) missing])))

Returns a sequence of [replaced-sql-string jdbc-args missing-parameters].

(defn- substitute*
  [param->value parsed in-optional?]
  (reduce
   (fn [[sql args missing] x]
     (cond
       (string? x)
       [(str sql x) args missing]
       (params/Param? x)
       (substitute-param param->value [sql args missing] in-optional? x)
       (params/Optional? x)
       (substitute-optional param->value [sql args missing] x)))
   nil
   parsed))

Substitute Optional and Param objects in a parsed-query, a sequence of parsed string fragments and tokens, with the values from the map param->value (using logic from substitution to decide what replacement SQL should be generated).

(substitute ["select * from foobars where birdtype = " (param "birdtype")] {"bird_type" "Steller's Jay"}) ;; -> ["select * from foobars where bird_type = ?" ["Steller's Jay"]]

(defn substitute
  [parsed-query param->value]
  (log/tracef "Substituting params\n%s\nin query:\n%s" (u/pprint-to-str param->value) (u/pprint-to-str parsed-query))
  (let [[sql args missing] (try
                             (substitute* param->value parsed-query false)
                             (catch Throwable e
                               (throw (ex-info (tru "Unable to substitute parameters: {0}" (ex-message e))
                                        {:type         (or (:type (ex-data e)) qp.error-type/qp)
                                         :params       param->value
                                         :parsed-query parsed-query}
                                        e))))]
    (log/tracef "=>%s\n%s" sql (pr-str args))
    (when (seq missing)
      (throw (ex-info (tru "Cannot run the query: missing required parameters: {0}" (set missing))
               {:type    qp.error-type/missing-required-parameter
                :missing missing})))
    [(str/trim sql) args]))
 

These functions take the info for a param fetched by the functions above and add additional info about how that param should be represented as SQL. (Specifically, they return information in this format:

{;; appropriate SQL that should be used to replace the param snippet, e.g. {{x}} :replacement-snippet "= ?" ;; ; any prepared statement args (values for ? placeholders) needed for the replacement snippet :prepared-statement-args [#t "2017-01-01"]}

(ns metabase.driver.sql.parameters.substitution
  (:require
   [clojure.string :as str]
   [metabase.driver :as driver]
   [metabase.driver.common.parameters :as params]
   [metabase.driver.common.parameters.dates :as params.dates]
   [metabase.driver.common.parameters.operators :as params.ops]
   [metabase.driver.sql.query-processor :as sql.qp]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.middleware.wrap-value-literals
    :as qp.wrap-value-literals]
   [metabase.query-processor.timezone :as qp.timezone]
   [metabase.query-processor.util.add-alias-info :as add]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu])
  (:import
   (clojure.lang IPersistentVector Keyword)
   (java.time.temporal Temporal)
   (java.util UUID)
   (metabase.driver.common.parameters Date DateRange FieldFilter ReferencedCardQuery ReferencedQuerySnippet)))

------------------------------------ ->prepared-substitution & default impls -------------------------------------

Returns a PreparedStatementSubstitution (see schema below) for x and the given driver. This allows driver specific parameters and SQL replacement text (usually just ?). The param value is already prepared and ready for inlcusion in the query, such as what's needed for SQLite and timestamps.

(defmulti ->prepared-substitution
  {:added "0.34.0" :arglists '([driver x])}
  (fn [driver x] [(driver/dispatch-on-initialized-driver driver) (class x)])
  :hierarchy #'driver/hierarchy)

Represents the SQL string replace value (usually ?) and the typed parameter value

(def PreparedStatementSubstitution
  [:map
   [:sql-string   :string]
   [:param-values [:maybe [:sequential :any]]]])
(mu/defn make-stmt-subs :- PreparedStatementSubstitution
  "Create a `PreparedStatementSubstitution` map for `sql-string` and the `param-seq`"
  [sql-string param-seq]
  {:sql-string   sql-string
   :param-values param-seq})

Convert X to a replacement snippet info map by passing it to HoneySQL's format function.

(defn- honeysql->prepared-stmt-subs
  [driver x]
  (let [[snippet & args] (sql.qp/format-honeysql driver x)]
    (make-stmt-subs snippet args)))
(mu/defmethod ->prepared-substitution [:sql nil] :- PreparedStatementSubstitution
  [driver _]
  (honeysql->prepared-stmt-subs driver nil))
(mu/defmethod ->prepared-substitution [:sql Object] :- PreparedStatementSubstitution
  [driver obj]
  (honeysql->prepared-stmt-subs driver (str obj)))
(mu/defmethod ->prepared-substitution [:sql Number] :- PreparedStatementSubstitution
  [driver num]
  (honeysql->prepared-stmt-subs driver (sql.qp/inline-num num)))
(mu/defmethod ->prepared-substitution [:sql Boolean] :- PreparedStatementSubstitution
  [driver b]
  (honeysql->prepared-stmt-subs driver b))
(mu/defmethod ->prepared-substitution [:sql Keyword] :- PreparedStatementSubstitution
  [driver kwd]
  (honeysql->prepared-stmt-subs driver kwd))

TIMEZONE FIXME - remove this since we aren't using Date anymore

(mu/defmethod ->prepared-substitution [:sql Date] :- PreparedStatementSubstitution
  [_driver date]
  (make-stmt-subs "?" [date]))
(mu/defmethod ->prepared-substitution [:sql Temporal] :- PreparedStatementSubstitution
  [_driver t]
  (make-stmt-subs "?" [t]))

Returns a suitable temporal unit conversion keyword for field, param-type and the given driver. The resulting keyword will be used to call the corresponding metabase.driver.sql.query-processor/date implementation to convert the field. Returns nil if the conversion is not necessary for this field and param-type combination.

(defmulti align-temporal-unit-with-param-type
  {:added "0.48.0" :arglists '([driver field param-type])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
(defmethod align-temporal-unit-with-param-type :default
  [_driver _field param-type]
  (when (params.dates/date-type? param-type)
    :day))

------------------------------------------- ->replacement-snippet-info -------------------------------------------

(def ^:private ParamSnippetInfo
  [:map
   [:replacement-snippet     {:optional true} :string] ; allowed to be blank if this is an optional param
   [:prepared-statement-args {:optional true} [:maybe [:sequential :any]]]])

Return information about how value should be converted to SQL, as a map with keys :replacement-snippet and :prepared-statement-args.

(->replacement-snippet-info :h2 "ABC") -> {:replacement-snippet "?", :prepared-statement-args "ABC"}

(defmulti ->replacement-snippet-info
  {:added "0.33.4" :arglists '([driver value])}
  (fn [driver v] [(driver/the-initialized-driver driver) (class v)])
  :hierarchy #'driver/hierarchy)
(defn- create-replacement-snippet
  [driver nil-or-obj]
  (let [{:keys [sql-string param-values]} (->prepared-substitution driver nil-or-obj)]
    {:replacement-snippet     sql-string
     :prepared-statement-args param-values}))
(defmethod ->replacement-snippet-info [:sql nil]
  [driver this]
  (create-replacement-snippet driver this))
(defmethod ->replacement-snippet-info [:sql Object]
  [driver this]
  (create-replacement-snippet driver (str this)))
(defmethod ->replacement-snippet-info [:sql Number]
  [driver this]
  (create-replacement-snippet driver this))
(defmethod ->replacement-snippet-info [:sql Boolean]
  [driver this]
  (create-replacement-snippet driver this))
(defmethod ->replacement-snippet-info [:sql Keyword]
  [driver this]
  (if (= this params/no-value)
    {:replacement-snippet ""}
    (create-replacement-snippet driver this)))
(defmethod ->replacement-snippet-info [:sql UUID]
  [_driver this]
  {:replacement-snippet (format "CAST('%s' AS uuid)" (str this))})
(defmethod ->replacement-snippet-info [:sql IPersistentVector]
  [driver values]
  (let [values (map (partial ->replacement-snippet-info driver) values)]
    {:replacement-snippet     (str/join ", " (map :replacement-snippet values))
     :prepared-statement-args (apply concat (map :prepared-statement-args values))}))
(defn- maybe-parse-temporal-literal [x]
  (condp instance? x
    String   (u.date/parse x (qp.timezone/report-timezone-id-if-supported))
    Temporal x
    (throw (ex-info (tru "Don''t know how to parse {0} {1} as a temporal literal" (class x) (pr-str x))
             {:type      qp.error-type/invalid-parameter
              :parameter x}))))
(defmethod ->replacement-snippet-info [:sql Date]
  [driver {:keys [s]}]
  (create-replacement-snippet driver (maybe-parse-temporal-literal s)))
(defn- prepared-ts-subs [driver operator date-str]
  (let [{:keys [sql-string param-values]} (->prepared-substitution driver (maybe-parse-temporal-literal date-str))]
    {:replacement-snippet     (str operator " " sql-string)
     :prepared-statement-args param-values}))
(defmethod ->replacement-snippet-info [:sql DateRange]
  [driver {:keys [start end]}]
  (cond
    (= start end)
    (prepared-ts-subs driver \= start)

    (nil? start)
    (prepared-ts-subs driver \< end)

    (nil? end)
    (prepared-ts-subs driver \> start)

    :else
    ;; TIMEZONE FIXME - this is WRONG WRONG WRONG because date ranges should be inclusive for start and *exclusive*
    ;; for end
    (let [[start end] (map (fn [s]
                             (->prepared-substitution driver (maybe-parse-temporal-literal s)))
                           [start end])]
      {:replacement-snippet     (format "BETWEEN %s AND %s" (:sql-string start) (:sql-string end))
       :prepared-statement-args (concat (:param-values start) (:param-values end))})))

------------------------------------- Field Filter replacement snippet info --------------------------------------

(mu/defn ^:private combine-replacement-snippet-maps :- ParamSnippetInfo
  "Combine multiple `replacement-snippet-maps` into a single map using a SQL `AND` clause."
  [replacement-snippet-maps :- [:maybe [:sequential ParamSnippetInfo]]]
  {:replacement-snippet     (str \( (str/join " AND " (map :replacement-snippet replacement-snippet-maps)) \))
   :prepared-statement-args (mapcat :prepared-statement-args replacement-snippet-maps)})

for relative dates convert the param to a DateRange record type and call ->replacement-snippet-info on it

(mu/defn ^:private date-range-field-filter->replacement-snippet-info :- ParamSnippetInfo
  [driver value]
  (->> (params.dates/date-string->range value)
       params/map->DateRange
       (->replacement-snippet-info driver)))
(mu/defn ^:private field-filter->equals-clause-sql :- ParamSnippetInfo
  [driver value]
  (-> (->replacement-snippet-info driver value)
      (update :replacement-snippet (partial str "= "))))
(mu/defn ^:private field-filter-multiple-values->in-clause-sql :- ParamSnippetInfo
  [driver values]
  (-> (->replacement-snippet-info driver (vec values))
      (update :replacement-snippet (partial format "IN (%s)"))))
(mu/defn ^:private honeysql->replacement-snippet-info :- ParamSnippetInfo
  "Convert `hsql-form` to a replacement snippet info map by passing it to HoneySQL's `format` function."
  [driver hsql-form]
  (let [[snippet & args] (sql.qp/format-honeysql driver hsql-form)]
    {:replacement-snippet     snippet
     :prepared-statement-args args}))
(mu/defn ^:private field->clause :- mbql.s/field
  [driver     :- :keyword
   field      :- lib.metadata/ColumnMetadata
   param-type :- ::mbql.s/ParameterType]
  ;; The [[metabase.query-processor.middleware.parameters/substitute-parameters]] QP middleware actually happens before
  ;; the [[metabase.query-processor.middleware.resolve-fields/resolve-fields]] middleware that would normally fetch all
  ;; the Fields we need in a single pass, so this is actually necessary here. I don't think switching the order of the
  ;; middleware would work either because we don't know what Field this parameter actually refers to until we resolve
  ;; the parameter. There's probably _some_ way to structure things that would make this "duplicate" call unneeded, but
  ;; I haven't figured out what that is yet
  [:field
   (u/the-id field)
   {:base-type                (:base-type field)
    :temporal-unit            (align-temporal-unit-with-param-type driver field param-type)
    ::add/source-table        (:table-id field)
    ;; in case anyone needs to know we're compiling a Field filter.
    ::compiling-field-filter? true}])
(mu/defn ^:private field->identifier :- ::lib.schema.common/non-blank-string
  "Return an approprate snippet to represent this `field` in SQL given its param type.
   For non-date Fields, this is just a quoted identifier; for dates, the SQL includes appropriately bucketing based on
   the `param-type`."
  [driver field param-type]
  (->> (field->clause driver field param-type)
       (sql.qp/->honeysql driver)
       (honeysql->replacement-snippet-info driver)
       :replacement-snippet))
(mu/defn ^:private field-filter->replacement-snippet-info :- ParamSnippetInfo
  "Return `[replacement-snippet & prepared-statement-args]` appropriate for a field filter parameter."
  [driver {{param-type :type, value :value, :as params} :value, field :field, :as _field-filter}]
  (assert (:id field) (format "Why doesn't Field have an ID?\n%s" (u/pprint-to-str field)))
  (letfn [(prepend-field [x]
            (update x :replacement-snippet
                    (partial str (field->identifier driver field param-type) " ")))
          (->honeysql [form]
            (sql.qp/->honeysql driver form))]
    (cond
      (params.ops/operator? param-type)
      (->> (assoc params :target [:template-tag (field->clause driver field param-type)])
           params.ops/to-clause
           mbql.u/desugar-filter-clause
           qp.wrap-value-literals/wrap-value-literals-in-mbql
           ->honeysql
           (honeysql->replacement-snippet-info driver))
      (and (params.dates/date-type? param-type)
           (string? value)
           (re-matches params.dates/date-exclude-regex value))
      (let [field-clause (field->clause driver field param-type)]
        (->> (params.dates/date-string->filter value field-clause)
             mbql.u/desugar-filter-clause
             qp.wrap-value-literals/wrap-value-literals-in-mbql
             ->honeysql
             (honeysql->replacement-snippet-info driver)))
      ;; convert other date to DateRange record types
      (params.dates/not-single-date-type? param-type) (prepend-field
                                                       (date-range-field-filter->replacement-snippet-info driver value))
      ;; convert all other dates to `= <date>`
      (params.dates/date-type? param-type)            (prepend-field
                                                       (field-filter->equals-clause-sql driver (params/map->Date {:s value})))
      ;; for sequences of multiple values we want to generate an `IN (...)` clause
      (sequential? value)                             (prepend-field
                                                       (field-filter-multiple-values->in-clause-sql driver value))
      ;; convert everything else to `= <value>`
      :else                                           (prepend-field
                                                       (field-filter->equals-clause-sql driver value)))))
(mu/defmethod ->replacement-snippet-info [:sql FieldFilter]
  [driver                            :- :keyword
   {:keys [value], :as field-filter} :- [:map
                                         [:field lib.metadata/ColumnMetadata]
                                         [:value :any]]]
  (cond
    ;; otherwise if the value isn't present just put in something that will always be true, such as `1` (e.g. `WHERE 1
    ;; = 1`). This is only used for field filters outside of optional clauses
    (= value params/no-value) {:replacement-snippet "1 = 1"}
    ;; if we have a vector of multiple values recursively convert them to SQL and combine into an `AND` clause
    ;; (This is multiple values in the sense that the frontend provided multiple maps with value values for the same
    ;; FieldFilter, not in the sense that we have a single map with multiple values for `:value`.)
    (sequential? value)
    (combine-replacement-snippet-maps (for [v value]
                                        (->replacement-snippet-info driver (assoc field-filter :value v))))
    ;; otherwise convert single value to SQL.
    :else
    (field-filter->replacement-snippet-info driver field-filter)))

------------------------------------ Referenced Card replacement snippet info ------------------------------------

(defmethod ->replacement-snippet-info [:sql ReferencedCardQuery]
  [_ {:keys [query params]}]
  {:prepared-statement-args (not-empty params)
   :replacement-snippet     (sql.qp/make-nestable-sql query)})

---------------------------------- Native Query Snippet replacement snippet info ---------------------------------

(defmethod ->replacement-snippet-info [:sql ReferencedQuerySnippet]
  [_ {:keys [content]}]
  {:prepared-statement-args nil
   :replacement-snippet     content})
 

The Query Processor is responsible for translating the Metabase Query Language into HoneySQL SQL forms.

(ns metabase.driver.sql.query-processor
  (:require
   [clojure.core.match :refer [match]]
   [clojure.string :as str]
   [honey.sql :as sql]
   [honey.sql.helpers :as sql.helpers]
   [metabase.driver :as driver]
   [metabase.driver.common :as driver.common]
   [metabase.driver.sql.query-processor.deprecated :as sql.qp.deprecated]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.middleware.annotate :as annotate]
   [metabase.query-processor.middleware.wrap-value-literals
    :as qp.wrap-value-literals]
   [metabase.query-processor.store :as qp.store]
   [metabase.query-processor.util.add-alias-info :as add]
   [metabase.query-processor.util.nest-query :as nest-query]
   [metabase.util :as u]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.i18n :refer [deferred-tru tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]))
(set! *warn-on-reflection* true)

Alias to use for source queries, e.g.:

SELECT source.* FROM ( SELECT * FROM some_table ) source

(def source-query-alias
  "source")

The INNER query currently being processed, for situations where we need to refer back to it.

(def ^:dynamic *inner-query*
  nil)

Do best effort edit to the sql, to make it nestable in subselect.

That requires:

  • Removal of traling comments (after the semicolon).
  • Removing the semicolon(s).
  • Squashing whitespace at the end of the string and replacinig it with newline. This is required in case some comments were preceding semicolon.
  • Wrapping the result in parens.

This implementation does not handle few cases cases properly. 100% correct comment and semicolon removal would probably require parsing sql string and not just a regular expression replacement. Link to the discussion: https://github.com/metabase/metabase/pull/30677

For the limitations see the [[metabase.driver.sql.query-processor-test/make-nestable-sql-test]]

(defn make-nestable-sql
  [sql]
  (str "("
       (-> sql
           (str/replace #";([\s;]*(--.*\n?)*)*$" "")
           str/trimr
           (as-> trimmed
                 ;; Query could potentially end with a comment.
                 (if (re-find #"--.*$" trimmed)
                   (str trimmed "\n")
                   trimmed)))
       ")"))
(defn- format-sql-source-query [_fn [sql params]]
  (into [(make-nestable-sql sql)] params))
(sql/register-fn! ::sql-source-query #'format-sql-source-query)

Wrap clause in ::sql-source-query. Does additional validation.

(defn sql-source-query
  [sql params]
  (when-not (string? sql)
    (throw (ex-info (tru "Expected native source query to be a string, got: {0}"
                         (.getCanonicalName (class sql)))
                    {:type  qp.error-type/invalid-query
                     :query sql})))
  (when-not ((some-fn nil? sequential?) params)
    (throw (ex-info (tru "Expected native source query parameters to be sequential, got: {0}"
                         (.getCanonicalName (class params)))
                    {:type  qp.error-type/invalid-query
                     :query params})))
  [::sql-source-query sql params])

+----------------------------------------------------------------------------------------------------------------+ | Interface (Multimethods) | +----------------------------------------------------------------------------------------------------------------+

DEPRECATED: Prior to between 0.46.0 and 0.49.0, drivers could use either Honey SQL 1 or Honey SQL 2. In 0.49.0+, all drivers must use Honey SQL 2.

(defmulti honey-sql-version
  {:arglists '(^Long [driver]), :added "0.46.0", :deprecated "0.49.0"}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

Wrap number n in :inline when targeting Honey SQL 2.

(defn inline-num
  {:added "0.46.0"}
  [n]
  {:pre [(number? n)]}
  [:inline n])

Is honeysql-expr a Honey SQL 2 :inline format?

(defn inline?
  {:added "0.46.0"}
  [honeysql-expr]
  (and (vector? honeysql-expr)
       (= (first honeysql-expr) :inline)))

this is the primary way to override behavior for a specific clause or object class.

Cast to integer

(defmulti ->integer
  {:changelog-test/ignore true :added "0.45.0" :arglists '([driver honeysql-expr])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
(defmethod ->integer :sql
  [_ value]
  (h2x/->integer value))

Cast to float.

(defmulti ->float
  {:changelog-test/ignore true :added "0.45.0" :arglists '([driver honeysql-expr])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
(defmethod ->float :sql
  [driver value]
  ;; optimization: we don't need to cast a number literal that is already a `Float` or a `Double` to `FLOAT`. Other
  ;; number literals can be converted to doubles in Clojure-land. Note that there is a little bit of a mismatch between
  ;; FLOAT and DOUBLE here, but that's mostly because I'm not 100% sure which drivers have both types. In the future
  ;; maybe we can fix this.
  (cond
    (float? value)
    (h2x/with-database-type-info (inline-num value) "float")

    (number? value)
    (recur driver (double value))

    (inline? value)
    (recur driver (second value))

    :else
    (h2x/cast :float value)))

Return an appropriate HoneySQL form for an object. Dispatches off both driver and either clause name or object class making this easy to override in any places needed for a given driver.

(defmulti ->honeysql
  {:added "0.37.0" :arglists '([driver mbql-expr-or-object])}
  (fn [driver x]
    [(driver/dispatch-on-initialized-driver driver) (mbql.u/dispatch-by-clause-name-or-class x)])
  :hierarchy #'driver/hierarchy)

Wraps a honeysql-expr in an psudeo-MBQL clause that prevents double-compilation if [[->honeysql]] is called on it again.

(defn compiled
  {:added "0.46.0"}
  [honeysql-expr]
  [::compiled honeysql-expr])
(defmethod ->honeysql [:sql ::compiled]
  [_driver [_compiled honeysql-expr :as compiled-form]]
  ;; preserve metadata attached to the compiled form
  (with-meta honeysql-expr (meta compiled-form)))
(defn- format-compiled
  [_compiled [honeysql-expr]]
  (sql/format-expr honeysql-expr {:nested true}))
(sql/register-fn! ::compiled #'format-compiled)

HoneySQL form that should be used to get the current datetime (or equivalent). Defaults to :%now. Should ideally include the database type info on the form (ex: via [[h2x/with-type-info]]).

(defmulti current-datetime-honeysql-form
  {:added "0.34.2" :arglists '([driver])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
(defmethod current-datetime-honeysql-form :sql
  [_driver]
  :%now)

Return a HoneySQL form for truncating a date or timestamp field or value to a given resolution, or extracting a date component.

honeysql-expr is already compiled to Honey SQL, so DO NOT call [[->honeysql]] on it.

TODO - rename this to temporal-bucket or something that better describes what it actually does

(defmulti date
  {:added "0.32.0" :arglists '([driver unit honeysql-expr])}
  (fn [driver unit _] [(driver/dispatch-on-initialized-driver driver) unit])
  :hierarchy #'driver/hierarchy)

default implementation for :default bucketing returns expression as-is

(defmethod date [:sql :default] [_ _ expr] expr)

We have to roll our own to account for arbitrary start of week

(defmethod date [:sql :second-of-minute] [_driver _ expr] (h2x/second expr))
(defmethod date [:sql :minute-of-hour]   [_driver _ expr] (h2x/minute expr))
(defmethod date [:sql :hour-of-day]      [_driver _ expr] (h2x/hour expr))
(defmethod date [:sql :week-of-year]
  [driver _ expr]
  ;; Some DBs truncate when doing integer division, therefore force float arithmetics
  (->honeysql driver [:ceil (compiled (h2x// (date driver :day-of-year (date driver :week expr)) 7.0))]))
(defmethod date [:sql :month-of-year]    [_driver _ expr] (h2x/month expr))
(defmethod date [:sql :quarter-of-year]  [_driver _ expr] (h2x/quarter expr))
(defmethod date [:sql :year-of-era]      [_driver _ expr] (h2x/year expr))
(defmethod date [:sql :week-of-year-iso] [_driver _ expr] (h2x/week expr))

Returns a HoneySQL form for calculating the datetime-diff for a given unit. This method is used by implementations of ->honeysql for the :datetime-diff clause. It is recommended to implement this if you want to use the default SQL implementation of ->honeysql for the :datetime-diff, which includes validation of argument types across all units.

(defmulti datetime-diff
  {:arglists '([driver unit field-or-value field-or-value]), :added "0.46.0"}
  (fn [driver unit _ _] [(driver/dispatch-on-initialized-driver driver) unit])
  :hierarchy #'driver/hierarchy)

Takes a datetime expession, return a HoneySQL form that calculate how many days from the Jan 1st till the start of first full week.

A full week is a week that contains 7 days in the same year.

Example: Assume start-of-week setting is :monday

(days-till-start-of-first-full-week driver '2000-04-05') -> 2

Because '2000-01-01' is Saturday, and 1st full week starts on Monday(2000-01-03) => 2 days

(defn- days-till-start-of-first-full-week
  [driver honeysql-expr]
  (let [start-of-year                (date driver :year honeysql-expr)
        day-of-week-of-start-of-year (date driver :day-of-week start-of-year)]
    (h2x/- 8 day-of-week-of-start-of-year)))

Calculate the week of year for :us or :instance mode. Returns a Honey SQL expression.

The idea for both modes are quite similar: - 1st Jan is always in the 1st week - the 2nd weeks start on the first start-of-week setting.

The algorithm: week-of-year = 1 partial-week + n full-weeks Where: - partial-week: is the week that starts from 1st Jan, until the next start-of-week - full-weeks: are weeks that has all week-days are in the same year.

Now, all we need to do is to find full-weeks, and it could be computed by this formula: full-weeks = ceil((doy - days-till-start-of-first-full-week) / 7) Where: - doy: is the day of year of the input date - days-till-start-of-first-full-week: is how many days from 1st Jan to the first start-of-week.

(defn- week-of-year
  [driver honeysql-expr mode]
  (let [days-till-start-of-first-full-week (binding [driver.common/*start-of-week*
                                                     (case mode
                                                       :us :sunday
                                                       :instance nil)]
                                             (days-till-start-of-first-full-week driver honeysql-expr))
        total-full-week-days               (h2x/- (date driver :day-of-year honeysql-expr)
                                                 days-till-start-of-first-full-week)
        total-full-weeks                   (->honeysql driver [:ceil (compiled (h2x// total-full-week-days 7.0))])]
    (->integer driver (h2x/+ 1 total-full-weeks))))

ISO8501 consider the first week of the year is the week that contains the 1st Thursday and week starts on Monday. - If 1st Jan is Friday, then 1st Jan is the last week of previous year. - If 1st Jan is Wednesday, then 1st Jan is in the 1st week.

(defmethod date
  [:sql :week-of-year-iso]
  [_driver _ honeysql-expr]
  (h2x/week honeysql-expr))

US consider the first week begins on 1st Jan, and 2nd week starts on the 1st Sunday

(defmethod date [:sql :week-of-year-us]
  [driver _ honeysql-expr]
  (week-of-year driver honeysql-expr :us))

First week begins on 1st Jan, the 2nd week will begins on the 1st [[metabase.public-settings/start-of-week]]

(defmethod date [:sql :week-of-year-instance]
  [driver _ honeysql-expr]
  (week-of-year driver honeysql-expr :instance))

Return a HoneySQL form that performs represents addition of some temporal interval to the original hsql-form. unit is one of the units listed in [[metabase.util.date-2/add-units]].

(add-interval-honeysql-form :my-driver hsql-form 1 :day) -> [:date_add hsql-form 1 (h2x/literal 'day')]

amount is usually an integer, but can be floating-point for units like seconds.

(defmulti add-interval-honeysql-form
  {:added "0.34.2" :arglists '([driver hsql-form amount unit])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

Truncate to the day the week starts on.

truncate-fn is a function with the signature

(truncate-fn expr) => truncated-expr

(mu/defn adjust-start-of-week
  [driver      :- :keyword
   truncate-fn :- [:=> [:cat :any] :any]
   expr]
  (let [offset (driver.common/start-of-week-offset driver)]
    (if (not= offset 0)
      (add-interval-honeysql-form driver
                                  (truncate-fn (add-interval-honeysql-form driver expr offset :day))
                                  (- offset) :day)
      (truncate-fn expr))))

Adjust day of week to respect the [[metabase.public-settings/start-of-week]] Setting.

The value a :day-of-week extract should return depends on the value of start-of-week, by default Sunday.

  • 1 = first day of the week (e.g. Sunday)
  • 7 = last day of the week (e.g. Saturday)

This assumes day-of-week as returned by the driver is already between 1 and 7 (adjust it if it's not). It adjusts as needed to match start-of-week by the [[driver.common/start-of-week-offset]], which comes from [[driver/db-start-of-week]].

(mu/defn adjust-day-of-week
  ([driver day-of-week-honeysql-expr]
   (adjust-day-of-week driver day-of-week-honeysql-expr (driver.common/start-of-week-offset driver)))
  ([driver day-of-week-honeysql-expr offset]
   (adjust-day-of-week driver day-of-week-honeysql-expr offset h2x/mod))
  ([driver
    day-of-week-honeysql-expr
    offset :- :int
    mod-fn :- [:=> [:cat any? any?] any?]]
   (cond
     (inline? offset) (recur driver day-of-week-honeysql-expr (second offset) mod-fn)
     (zero? offset)   day-of-week-honeysql-expr
     (neg? offset)    (recur driver day-of-week-honeysql-expr (+ offset 7) mod-fn)
     :else            [:case
                       [:=
                        (mod-fn (h2x/+ day-of-week-honeysql-expr offset) (inline-num 7))
                        (inline-num 0)]
                       (inline-num 7)
                       :else
                       (mod-fn
                        (h2x/+ day-of-week-honeysql-expr offset)
                        (inline-num 7))])))

Return the dialect that should be used by Honey SQL 2 when building a SQL statement. Defaults to :ansi, but other valid options are :mysql, :sqlserver, :oracle, and :h2 (added in [[metabase.util.honey-sql-2]]; like :ansi, but uppercases the result). Check [[honey.sql/dialects]] for all available dialects, or register a custom one with [[honey.sql/register-dialect!]].

(honey.sql/format ... :quoting (quote-style driver), :allow-dashed-names? true)

(The name of this method reflects Honey SQL 1 terminology, where "dialect" was called "quote style". To avoid needless churn, I haven't changed it yet. -- Cam)

(defmulti quote-style
  {:added "0.32.0" :arglists '([driver])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
(defmethod quote-style :sql [_] :ansi)

Return a HoneySQL form appropriate for converting a Unix timestamp integer field or value to an proper SQL Timestamp. seconds-or-milliseconds refers to the resolution of the int in question and with be either :seconds or :milliseconds.

There is a default implementation for :milliseconds the recursively calls with :seconds and (expr / 1000).

(defmulti unix-timestamp->honeysql
  {:arglists '([driver seconds-or-milliseconds honeysql-expr]), :added "0.35.0"}
  (fn [driver seconds-or-milliseconds _] [(driver/dispatch-on-initialized-driver driver) seconds-or-milliseconds])
  :hierarchy #'driver/hierarchy)

Cast a string representing

(defmulti cast-temporal-string
  {:arglists '([driver coercion-strategy honeysql-expr]), :added "0.38.0"}
  (fn [driver coercion-strategy _] [(driver/dispatch-on-initialized-driver driver) coercion-strategy])
  :hierarchy #'driver/hierarchy)
(defmethod cast-temporal-string :default
  [driver coercion-strategy _expr]
  (throw (ex-info (tru "Driver {0} does not support {1}" driver coercion-strategy)
                  {:type qp.error-type/unsupported-feature
                   :coercion-strategy coercion-strategy})))
(defmethod unix-timestamp->honeysql [:sql :milliseconds]
  [driver _ expr]
  (unix-timestamp->honeysql driver :seconds (h2x// expr 1000)))
(defmethod unix-timestamp->honeysql [:sql :microseconds]
  [driver _ expr]
  (unix-timestamp->honeysql driver :seconds (h2x// expr 1000000)))
(defmethod unix-timestamp->honeysql [:sql :nanoseconds]
  [driver _ expr]
  (unix-timestamp->honeysql driver :seconds (h2x// expr 1000000000)))

Cast a byte field

(defmulti cast-temporal-byte
  {:arglists '([driver coercion-strategy expr]), :added "0.38.0"}
  (fn [driver coercion-strategy _] [(driver/dispatch-on-initialized-driver driver) coercion-strategy])
  :hierarchy #'driver/hierarchy)
(defmethod cast-temporal-byte :default
  [driver coercion-strategy _expr]
  (throw (ex-info (tru "Driver {0} does not support {1}" driver coercion-strategy)
                  {:type qp.error-type/unsupported-feature})))

Implementations of this methods define how the SQL Query Processor handles various top-level MBQL clauses. Each method is called when a matching clause is present in query, and should return an appropriately modified version of honeysql-form. Most drivers can use the default implementations for all of these methods, but some may need to override one or more (e.g. SQL Server needs to override this method for the :limit clause, since T-SQL uses TOP instead of LIMIT).

(defmulti apply-top-level-clause
  {:added "0.32.0", :arglists '([driver top-level-clause honeysql-form query]), :style/indent 2}
  (fn [driver top-level-clause _ _]
    [(driver/dispatch-on-initialized-driver driver) top-level-clause])
  :hierarchy #'driver/hierarchy)
(defmethod apply-top-level-clause :default
  [_ _ honeysql-form _]
  honeysql-form)

Reaches into a JSON field (that is, a field with a defined :nfc-path).

Lots of SQL DB's have denormalized JSON fields and they all have some sort of special syntax for dealing with indexing into it. Implement the special syntax in this multimethod.

(defmulti json-query
  {:changelog-test/ignore true, :arglists '([driver identifier json-field]), :added "0.43.1"}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

+----------------------------------------------------------------------------------------------------------------+ | Low-Level ->honeysql impls | +----------------------------------------------------------------------------------------------------------------+

[[->honeysql]] shouldn't be getting called on something that is already Honey SQL. Prior to 46/Honey SQL 2, this would not usually cause problems because we could easily distinguish between MBQL clauses and Honey SQL record types; with Honey SQL 2, clauses are basically indistinguishable from MBQL, and some things exist in both, like :/ and :ceil; it's more important that we be careful about avoiding double-compilation to prevent bugs or redundant expressions.

The exception to this rule is [[h2x/identifier]] -- for historical reasons, drivers were encouraged to do this in the past and some rely on this behavior (see ;;; [[metabase.driver.bigquery-cloud-sdk.query-processor]] and [[metabase.driver.snowflake]] for example). Maybe we come up with some better way to handle this -- e.g. maybe [[h2x/identifier]] should be replaced with a sql.qp multimethod so driver-specific behavior can happen as we generate Honey SQL, not afterwards.

If you see this warning, it usually means you are passing a Honey SQL form to a method that expects an MBQL form, usually [[->honeysql]]; this probably means you're recursively calling [[->honeysql]] when you should not be.

You can use [[compiled]] to prevent this error, to work around situations where you need to compile something to Honey SQL and then pass it to a method that expects MBQL. This should be considered an icky HACK and you should only do this if you cannot actually fix your code.

(defn- throw-double-compilation-error
  [driver x]
  ;; not i18n'ed because this is meant to be developer-facing.
  (throw
   (ex-info (format "%s called on something already compiled to Honey SQL. See %s for more info."
                    `->honeysql
                    `throw-double-compilation-error)
            {:driver driver
             :expr   x
             :type   qp.error-type/driver})))
(defmethod ->honeysql :default
  [driver x]
  (when (and (vector? x)
             (keyword? (first x)))
    (throw-double-compilation-error driver x))
  ;; user-facing only so it doesn't need to be i18n'ed
  (throw (ex-info (format "Don't know how to compile %s to Honey SQL: implement %s for %s"
                          (pr-str x)
                          `->honeysql
                          (pr-str [driver (mbql.u/dispatch-by-clause-name-or-class x)]))
                  {:driver driver
                   :expr   x
                   :type   qp.error-type/driver})))
(defmethod ->honeysql [:sql nil]
  [_driver _this]
  nil)
(defmethod ->honeysql [:sql Object]
  [_driver this]
  this)
(defmethod ->honeysql [:sql Number]
  [_driver n]
  (inline-num n))
(defmethod ->honeysql [:sql :value]
  [driver [_ value]]
  (->honeysql driver value))
(defmethod ->honeysql [:sql :expression]
  [driver [_ expression-name {::add/keys [source-table source-alias]} :as _clause]]
  (let [expression-definition (mbql.u/expression-with-name *inner-query* expression-name)]
    (->honeysql driver (if (= source-table ::add/source)
                         (apply h2x/identifier :field source-query-alias source-alias)
                         expression-definition))))
(defmethod ->honeysql [:sql :now]
  [driver _clause]
  (current-datetime-honeysql-form driver))

Translates coercion types like :Coercion/UNIXSeconds->DateTime to the corresponding unit of time to use in [[unix-timestamp->honeysql]]. Throws an AssertionError if the argument does not descend from :UNIXTime->Temporal and an exception if the type does not have an associated unit.

(defn semantic-type->unix-timestamp-unit
  [coercion-type]
  (when-not (isa? coercion-type :Coercion/UNIXTime->Temporal)
    (throw (ex-info "Semantic type must be a UNIXTimestamp"
                    {:type          qp.error-type/invalid-query
                     :coercion-type coercion-type})))
  (or (get {:Coercion/UNIXNanoSeconds->DateTime :nanoseconds
            :Coercion/UNIXMicroSeconds->DateTime :microseconds
            :Coercion/UNIXMilliSeconds->DateTime :milliseconds
            :Coercion/UNIXSeconds->DateTime      :seconds}
           coercion-type)
      (throw (Exception. (tru "No magnitude known for {0}" coercion-type)))))

Wrap a field-identifier in appropriate HoneySQL expressions if it refers to a UNIX timestamp Field.

(defn cast-field-if-needed
  [driver {:keys [base-type coercion-strategy], :as field} honeysql-form]
  (if (some #(str/includes? (name %) "_") (keys field))
    (do
      (sql.qp.deprecated/log-deprecation-warning
       driver
       "metabase.driver.sql.query-processor/cast-field-id-needed with a legacy (snake_cased) :model/Field"
       "0.48.0")
      (recur driver (update-keys field u/->kebab-case-en) honeysql-form))
    (u/prog1 (match [base-type coercion-strategy]
               [(:isa? :type/Number) (:isa? :Coercion/UNIXTime->Temporal)]
               (unix-timestamp->honeysql driver
                                         (semantic-type->unix-timestamp-unit coercion-strategy)
                                         honeysql-form)
               [:type/Text (:isa? :Coercion/String->Temporal)]
               (cast-temporal-string driver coercion-strategy honeysql-form)
               [(:isa? :type/*) (:isa? :Coercion/Bytes->Temporal)]
               (cast-temporal-byte driver coercion-strategy honeysql-form)
               :else honeysql-form)
      (when-not (= <> honeysql-form)
        (log/tracef "Applied casting\n=>\n%s" (u/pprint-to-str <>))))))

it's a little weird that we're calling [[->honeysql]] on an identifier, which is a Honey SQL form and not an MBQL form. See [[throw-double-compilation-error]] for more info.

(defmethod ->honeysql [:sql ::h2x/identifier]
  [_driver identifier]
  identifier)

Apply temporal bucketing for the :temporal-unit in the options of a :field clause; return a new HoneySQL form that buckets honeysql-form appropriately.

(defn apply-temporal-bucketing
  [driver {:keys [temporal-unit]} honeysql-form]
  (date driver temporal-unit honeysql-form))

Apply :binning options from a :field clause; return a new HoneySQL form that bins honeysql-form appropriately.

(defn apply-binning
  [{{:keys [bin-width min-value _max-value]} :binning} honeysql-form]
  ;;
  ;; Equation is | (value - min) |
  ;;             | ------------- | * bin-width + min-value
  ;;             |_  bin-width  _|
  ;;
  (cond-> honeysql-form
    (not (zero? min-value)) (h2x/- min-value)
    true                    (h2x// bin-width)
    true                    h2x/floor
    true                    (h2x/* bin-width)
    (not (zero? min-value)) (h2x/+ min-value)))
(mu/defn ^:private field-source-table-aliases :- [:maybe [:sequential ::lib.schema.common/non-blank-string]]
  "Get sequence of alias that should be used to qualify a `:field` clause when compiling (e.g. left-hand side of an
  `AS`).
    (field-source-table-aliases [:field 1 nil]) ; -> [\"public\" \"venues\"]"
  [[_ id-or-name {::add/keys [source-table]}]]
  (let [source-table (or source-table
                         (when (integer? id-or-name)
                           (:table-id (lib.metadata/field (qp.store/metadata-provider) id-or-name))))]
    (cond
      (= source-table ::add/source) [source-query-alias]
      (= source-table ::add/none)   nil
      (integer? source-table)       (let [{schema :schema, table-name :name} (lib.metadata/table
                                                                              (qp.store/metadata-provider)
                                                                              source-table)]
                                      (not-empty (filterv some? [schema table-name])))
      source-table                  [source-table])))

Get alias that should be use to refer to a :field clause when compiling (e.g. left-hand side of an AS).

(field-source-alias [:field 1 nil]) ; -> "price"

(defn- field-source-alias
  [[_field id-or-name {::add/keys [source-alias]}]]
  (or source-alias
      (when (string? id-or-name)
        id-or-name)
      (when (integer? id-or-name)
        (:name (lib.metadata/field (qp.store/metadata-provider) id-or-name)))))
(defmethod ->honeysql [:sql :field]
  [driver [_ id-or-name {:keys             [database-type]
                         ::nest-query/keys [outer-select]
                         :as               options}
           :as field-clause]]
  (try
    (let [source-table-aliases (field-source-table-aliases field-clause)
          source-alias         (field-source-alias field-clause)
          field                (when (integer? id-or-name)
                                 (lib.metadata/field (qp.store/metadata-provider) id-or-name))
          allow-casting?       (and field
                                    (not outer-select))
          database-type        (or database-type
                                   (:database-type field))
          ;; preserve metadata attached to the original field clause, for example BigQuery temporal type information.
          identifier           (-> (apply h2x/identifier :field
                                          (concat source-table-aliases [source-alias]))
                                   (with-meta (meta field-clause)))
          identifier           (->honeysql driver identifier)
          maybe-add-db-type    (fn [expr]
                                 (if (h2x/type-info->db-type (h2x/type-info expr))
                                   expr
                                   (h2x/with-database-type-info expr database-type)))]
      (u/prog1
        (cond->> identifier
          allow-casting?           (cast-field-if-needed driver field)
          ;; only add type info if it wasn't added by [[cast-field-if-needed]]
          database-type            maybe-add-db-type
          (:temporal-unit options) (apply-temporal-bucketing driver options)
          (:binning options)       (apply-binning options))
        (log/trace (binding [*print-meta* true]
                     (format "Compiled field clause\n%s\n=>\n%s"
                             (u/pprint-to-str field-clause) (u/pprint-to-str <>))))))
    (catch Throwable e
      (throw (ex-info (tru "Error compiling :field clause: {0}" (ex-message e))
                      {:clause field-clause}
                      e)))))
(defmethod ->honeysql [:sql :count]
  [driver [_ field]]
  (if field
    [:count (->honeysql driver field)]
    :%count.*))
(defmethod ->honeysql [:sql :avg]    [driver [_ field]] [:avg        (->honeysql driver field)])
(defmethod ->honeysql [:sql :median] [driver [_ field]] [:median     (->honeysql driver field)])
(defmethod ->honeysql [:sql :stddev] [driver [_ field]] [:stddev_pop (->honeysql driver field)])
(defmethod ->honeysql [:sql :var]    [driver [_ field]] [:var_pop    (->honeysql driver field)])
(defmethod ->honeysql [:sql :sum]    [driver [_ field]] [:sum        (->honeysql driver field)])
(defmethod ->honeysql [:sql :min]    [driver [_ field]] [:min        (->honeysql driver field)])
(defmethod ->honeysql [:sql :max]    [driver [_ field]] [:max        (->honeysql driver field)])
(defmethod ->honeysql [:sql :percentile]
  [driver [_ field p]]
  (let [field (->honeysql driver field)
        p     (->honeysql driver p)]
    [::h2x/percentile-cont field p]))
(defmethod ->honeysql [:sql :distinct]
  [driver [_ field]]
  (let [field (->honeysql driver field)]
    [::h2x/distinct-count field]))
(defmethod ->honeysql [:sql :floor] [driver [_ mbql-expr]] [:floor (->honeysql driver mbql-expr)])
(defmethod ->honeysql [:sql :ceil]  [driver [_ mbql-expr]] [:ceil  (->honeysql driver mbql-expr)])
(defmethod ->honeysql [:sql :round] [driver [_ mbql-expr]] [:round (->honeysql driver mbql-expr)])
(defmethod ->honeysql [:sql :abs]   [driver [_ mbql-expr]] [:abs (->honeysql driver mbql-expr)])
(defmethod ->honeysql [:sql :log]   [driver [_ mbql-expr]] [:log (inline-num 10) (->honeysql driver mbql-expr)])
(defmethod ->honeysql [:sql :exp]   [driver [_ mbql-expr]] [:exp (->honeysql driver mbql-expr)])
(defmethod ->honeysql [:sql :sqrt]  [driver [_ mbql-expr]] [:sqrt (->honeysql driver mbql-expr)])
(defmethod ->honeysql [:sql :power]
  [driver [_power mbql-expr power]]
  [:power
   (->honeysql driver mbql-expr)
   (->honeysql driver power)])
(defn- interval? [expr]
  (mbql.u/is-clause? :interval expr))
(defmethod ->honeysql [:sql :+]
  [driver [_ & args]]
  (if (some interval? args)
    (if-let [[field intervals] (u/pick-first (complement interval?) args)]
      (reduce (fn [hsql-form [_ amount unit]]
                (add-interval-honeysql-form driver hsql-form amount unit))
              (->honeysql driver field)
              intervals)
      (throw (ex-info "Summing intervals is not supported" {:args args})))
    (into [:+]
          (map (partial ->honeysql driver))
          args)))
(defmethod ->honeysql [:sql :-]
  [driver [_ & [first-arg & other-args :as args]]]
  (cond (interval? first-arg)
        (throw (ex-info (tru "Interval as first argrument to subtraction is not allowed.")
                        {:type qp.error-type/invalid-query
                         :args args}))
        (and (some interval? other-args)
             (not (every? interval? other-args)))
        (throw (ex-info (tru "All but first argument to subtraction must be an interval.")
                        {:type qp.error-type/invalid-query
                         :args args})))
  (if (interval? (first other-args))
    (reduce (fn [hsql-form [_ amount unit]]
              ;; We are adding negative amount. Inspired by `->honeysql [:sql :datetime-subtract]`.
              (add-interval-honeysql-form driver hsql-form (- amount) unit))
            (->honeysql driver first-arg)
            other-args)
    (into [:-]
          (map (partial ->honeysql driver))
          args)))
(defmethod ->honeysql [:sql :*]
  [driver [_ & args]]
  (into [:*]
        (map (partial ->honeysql driver))
         args))

for division we want to go ahead and convert any integer args to floats, because something like field / 2 will do integer division and give us something like 1.0 where we would rather see something like 1.5

also, we want to gracefully handle situations where the column is ZERO and just swap it out with NULL instead, so we don't get divide by zero errors. SQL DBs always return NULL when dividing by NULL (AFAIK)

Make sure we're not trying to divide by zero.

(defn- safe-denominator
  [denominator]
  (cond
    ;; try not to generate hairy nonsense like `CASE WHERE 7.0 = 0 THEN NULL ELSE 7.0` if we're dealing with number
    ;; literals and can determine this stuff ahead of time.
    (and (number? denominator)
         (zero? denominator))
    nil
    (number? denominator)
    (inline-num denominator)
    (inline? denominator)
    (recur (second denominator))
    :else
    [:case
     [:= denominator (inline-num 0)] nil
     :else                           denominator]))
(defmethod ->honeysql [:sql :/]
  [driver [_ & mbql-exprs]]
  (let [[numerator & denominators] (for [mbql-expr mbql-exprs]
                                     (->honeysql driver (if (integer? mbql-expr)
                                                          (double mbql-expr)
                                                          mbql-expr)))]
    (into [:/ (->float driver numerator)]
          (map safe-denominator)
           denominators)))
(defmethod ->honeysql [:sql :sum-where]
  [driver [_ arg pred]]
  [:sum [:case
         (->honeysql driver pred) (->honeysql driver arg)
         :else                    [:inline 0.0]]])
(defmethod ->honeysql [:sql :count-where]
  [driver [_ pred]]
  (->honeysql driver [:sum-where 1 pred]))
(defmethod ->honeysql [:sql :share]
  [driver [_ pred]]
  [:/ (->honeysql driver [:count-where pred]) :%count.*])
(defmethod ->honeysql [:sql :trim]
  [driver [_ arg]]
  [:trim (->honeysql driver arg)])
(defmethod ->honeysql [:sql :ltrim]
  [driver [_ arg]]
  [:ltrim (->honeysql driver arg)])
(defmethod ->honeysql [:sql :rtrim]
  [driver [_ arg]]
  [:rtrim (->honeysql driver arg)])
(defmethod ->honeysql [:sql :upper]
  [driver [_ arg]]
  [:upper (->honeysql driver arg)])
(defmethod ->honeysql [:sql :lower]
  [driver [_ arg]]
  [:lower (->honeysql driver arg)])
(defmethod ->honeysql [:sql :coalesce]
  [driver [_ & args]]
  (into [:coalesce] (map (partial ->honeysql driver)) args))
(defmethod ->honeysql [:sql :replace]
  [driver [_ arg pattern replacement]]
  [:replace (->honeysql driver arg) (->honeysql driver pattern) (->honeysql driver replacement)])
(defmethod ->honeysql [:sql :concat]
  [driver [_ & args]]
  (into [:concat] (map (partial ->honeysql driver)) args))
(defmethod ->honeysql [:sql :substring]
  [driver [_ arg start length]]
  (if length
    [:substring (->honeysql driver arg) (->honeysql driver start) (->honeysql driver length)]
    [:substring (->honeysql driver arg) (->honeysql driver start)]))
(defmethod ->honeysql [:sql :length]
  [driver [_ arg]]
  [:length (->honeysql driver arg)])
(defmethod ->honeysql [:sql :case]
  [driver [_ cases options]]
  (into [:case]
        (comp cat
              (map (partial ->honeysql driver)))
        (concat cases
                (when (some? (:default options))
                  [[:else (:default options)]]))))

actual handling of the name is done in the top-level clause handler for aggregations

(defmethod ->honeysql [:sql :aggregation-options]
  [driver [_ ag]]
  (->honeysql driver ag))

aggregation REFERENCE e.g. the ["aggregation" 0] fields we allow in order-by

(defmethod ->honeysql [:sql :aggregation]
  [driver [_ index]]
  (mbql.u/match-one (nth (:aggregation *inner-query*) index)
    [:aggregation-options ag (options :guard :name)]
    (->honeysql driver (h2x/identifier :field-alias (:name options)))

    [:aggregation-options ag _]
    #_:clj-kondo/ignore
    (recur ag)

    ;; For some arcane reason we name the results of a distinct aggregation "count", everything else is named the
    ;; same as the aggregation
    :distinct
    (->honeysql driver (h2x/identifier :field-alias :count))

    #{:+ :- :* :/}
    (->honeysql driver &match)

    ;; for everything else just use the name of the aggregation as an identifer, e.g. `:sum`
    ;;
    ;; TODO -- I don't think we will ever actually get to this anymore because everything should have been given a name
    ;; by [[metabase.query-processor.middleware.pre-alias-aggregations]]
    [ag-type & _]
    (->honeysql driver (h2x/identifier :field-alias ag-type))))
(defmethod ->honeysql [:sql :absolute-datetime]
  [driver [_ timestamp unit]]
  (date driver unit (->honeysql driver timestamp)))
(defmethod ->honeysql [:sql :time]
  [driver [_ value unit]]
  (date driver unit (->honeysql driver value)))
(defmethod ->honeysql [:sql :relative-datetime]
  [driver [_ amount unit]]
  (date driver unit (if (zero? amount)
                      (current-datetime-honeysql-form driver)
                      (add-interval-honeysql-form driver (current-datetime-honeysql-form driver) amount unit))))
(defmethod ->honeysql [:sql :temporal-extract]
  [driver [_ mbql-expr unit]]
  (date driver unit (->honeysql driver mbql-expr)))
(defmethod ->honeysql [:sql :datetime-add]
  [driver [_ arg amount unit]]
  (add-interval-honeysql-form driver (->honeysql driver arg) amount unit))
(defmethod ->honeysql [:sql :datetime-subtract]
  [driver [_ arg amount unit]]
  (add-interval-honeysql-form driver (->honeysql driver arg) (- amount) unit))

This util function is used by SQL implementations of ->honeysql for the :datetime-diff clause. It raises an exception if the database-type of the arguments x and y do not match the given predicate. Note this doesn't raise an error if the database-type is nil, which can be the case for some drivers.

(defn datetime-diff-check-args
  [x y pred]
  (doseq [arg [x y]
          :let [db-type (h2x/database-type arg)]
          :when (and db-type (not (pred db-type)))]
    (throw (ex-info (tru "datetimeDiff only allows datetime, timestamp, or date types. Found {0}"
                         (pr-str db-type))
                    {:found db-type
                     :type  qp.error-type/invalid-query}))))
(defmethod ->honeysql [:sql :datetime-diff]
  [driver [_ x y unit]]
  (let [x (->honeysql driver x)
        y (->honeysql driver y)]
    (datetime-diff-check-args x y (partial re-find #"(?i)^(timestamp|date)"))
    (datetime-diff driver unit x y)))

+----------------------------------------------------------------------------------------------------------------+ | Field Aliases (AS Forms) | +----------------------------------------------------------------------------------------------------------------+

TODO -- this name is a bit of a misnomer since it also handles :aggregation and :expression clauses.

(mu/defn field-clause->alias :- some?
  "Generate HoneySQL for an approriate alias (e.g., for use with SQL `AS`) for a `:field`, `:expression`, or
  `:aggregation` clause of any type, or `nil` if the Field should not be aliased. By default uses the
  `::add/desired-alias` key in the clause options.
  Optional third parameter `unique-name-fn` is no longer used as of 0.42.0."
  ([driver                                                :- :keyword
    [clause-type id-or-name {::add/keys [desired-alias]}] :- vector?]
   (let [desired-alias (or desired-alias
                           ;; fallback behavior for anyone using SQL QP functions directly without including the stuff
                           ;; from [[metabase.query-processor.util.add-alias-info]]. We should probably disallow this
                           ;; going forward because it is liable to break
                           (when (string? id-or-name)
                             id-or-name)
                           (when (and (= clause-type :field)
                                      (integer? id-or-name))
                             (:name (lib.metadata/field (qp.store/metadata-provider) id-or-name))))]
     (->honeysql driver (h2x/identifier :field-alias desired-alias))))
  ([driver field-clause _unique-name-fn]
   (sql.qp.deprecated/log-deprecation-warning
    driver
    "metabase.driver.sql.query-processor/field-clause->alias with 3 args"
    "0.48.0")
   (field-clause->alias driver field-clause)))

Generate HoneySQL for an AS form (e.g. <form> AS <field>) using the name information of a clause. The HoneySQL representation of on AS clause is a tuple like [<form> <alias>].

In some cases where the alias would be redundant, such as plain field literals, this returns the form as-is for Honey SQL 1. It's wrapped in a vector for Honey SQL 2 to eliminate ambiguity if the clause compiles to a Honey SQL vector. This is not allowed in Honey SQL 1 -- [expr alias] always has to have an alias.

Honey SQL 2 seems to actually need an additional vector around the alias form, otherwise it doesn't work correctly. See https://clojurians.slack.com/archives/C1Q164V29/p1675301408026759

;; Honey SQL 1 (as [:field "x" {:base-type :type/Text}]) ;; -> (Identifier ...) ;; -> SELECT "x"

;; Honey SQL 2 (as [:field "x" {:base-type :type/Text}]) ;; -> [[::h2x/identifier ...]] ;; -> SELECT "x"

;; Honey SQL 1 (as [:field "x" {:base-type :type/Text, :temporal-unit :month}]) ;; -> [(Identifier ...) (Identifier ...)] ;; -> SELECT date_extract("x", 'month') AS "x"

;; Honey SQL 2 (as [:field "x" {:base-type :type/Text, :temporal-unit :month}]) ;; -> [[::h2x/identifier ...] [[::h2x/identifier ...]]] ;; -> SELECT date_extract("x", 'month') AS "x"

(defn as
  [driver clause & _unique-name-fn]
  (let [honeysql-form (->honeysql driver clause)
        field-alias   (field-clause->alias driver clause)]
    (if field-alias
      [honeysql-form [field-alias]]
      [honeysql-form])))

Certain SQL drivers require that we refer to Fields using the alias we give in the SELECT clause in ORDER BY and GROUP BY rather than repeating definitions. BigQuery does this generally, other DB's require this in JSON columns.

See #17536 and #18742

Rewrite :field clauses to force them to use the column alias regardless of where they appear.

(defn rewrite-fields-to-force-using-column-aliases
  ([form]
   (rewrite-fields-to-force-using-column-aliases form {:is-breakout false}))
  ([form {is-breakout :is-breakout}]
   (mbql.u/replace form
     [:field id-or-name opts]
     [:field id-or-name (cond-> opts
                          true
                          (assoc ::add/source-alias        (::add/desired-alias opts)
                                 ::add/source-table        ::add/none
                                 ;; sort of a HACK but this key will tell the SQL QP not to apply casting here either.
                                 ::nest-query/outer-select true
                                 ;; used to indicate that this is a forced alias
                                 ::forced-alias            true)
                          ;; don't want to do temporal bucketing or binning inside the order by only.
                          ;; That happens inside the `SELECT`
                          ;; (#22831) however, we do want it in breakout
                          (not is-breakout)
                          (dissoc :temporal-unit :binning))])))

+----------------------------------------------------------------------------------------------------------------+ | Clause Handlers | +----------------------------------------------------------------------------------------------------------------+

-------------------------------------------------- aggregation ---------------------------------------------------

(defmethod apply-top-level-clause [:sql :aggregation]
  [driver _top-level-clause honeysql-form {aggregations :aggregation, :as inner-query}]
  (let [honeysql-ags (vec (for [ag   aggregations
                                :let [ag-expr  (->honeysql driver ag)
                                      ag-name  (annotate/aggregation-name inner-query ag)
                                      ag-alias (->honeysql driver (h2x/identifier
                                                                   :field-alias
                                                                   (driver/escape-alias driver ag-name)))]]
                            [ag-expr [ag-alias]]))]
    (reduce (if (:select-top honeysql-form)
              sql.helpers/select-top
              sql.helpers/select)
            honeysql-form
            honeysql-ags)))

----------------------------------------------- breakout & fields ------------------------------------------------

(defmethod apply-top-level-clause [:sql :breakout]
  [driver _ honeysql-form {breakout-fields :breakout, fields-fields :fields :as _query}]
  (let [select (if (:select-top honeysql-form)
                 sql.helpers/select-top
                 sql.helpers/select)]
    (as-> honeysql-form new-hsql
      (apply select new-hsql (->> breakout-fields
                                  (remove (set fields-fields))
                                  (mapv (fn [field-clause]
                                          (as driver field-clause)))))
      (apply sql.helpers/group-by new-hsql (mapv (partial ->honeysql driver) breakout-fields)))))
(defmethod apply-top-level-clause [:sql :fields]
  [driver _ honeysql-form {fields :fields}]
  (apply (if (:select-top honeysql-form)
           sql.helpers/select-top
           sql.helpers/select)
         honeysql-form
         (for [field-clause fields]
           (as driver field-clause))))

----------------------------------------------------- filter -----------------------------------------------------

Generate honeysql like clause used in :starts-with, :contains or `:ends-with. If matching case insensitively, pattern is lowercased earlier in [[generate-pattern]].

(defn- like-clause
  [field pattern {:keys [case-sensitive] :or {case-sensitive true} :as _options}]
  ;; TODO - don't we need to escape underscores and percent signs in the pattern, since they have special meanings in
  ;; LIKE clauses? That's what we're doing with Druid... (Cam)
  ;;
  ;; TODO - Postgres supports `ILIKE`. Does that make a big enough difference performance-wise that we should do a
  ;; custom implementation? (Cam)
  [:like
   (if case-sensitive
     field
     [:lower field])
   pattern])
(def ^:private StringValueOrFieldOrExpression
  [:or
   [:and mbql.s/value
    [:fn {:error/message "string value"} #(string? (second %))]]
   mbql.s/FieldOrExpressionDef])

Generate pattern to match against in like clause. Lowercasing for case insensitive matching also happens here.

(mu/defn ^:private generate-pattern
  [driver
   pre
   [type _ :as arg] :- StringValueOrFieldOrExpression
   post
   {:keys [case-sensitive] :or {case-sensitive true} :as _options}]
  (if (= :value type)
    (->honeysql driver (update arg 1 #(cond-> (str pre % post)
                                        (not case-sensitive) u/lower-case-en)))
    (let [expr (->honeysql driver (into [:concat] (remove nil?) [pre arg post]))]
      (if case-sensitive
        expr
        [:lower expr]))))
(defmethod ->honeysql [:sql :starts-with]
  [driver [_ field arg options]]
  (like-clause (->honeysql driver field) (generate-pattern driver nil arg "%" options) options))
(defmethod ->honeysql [:sql :contains]
  [driver [_ field arg options]]
  (like-clause (->honeysql driver field) (generate-pattern driver "%" arg "%" options) options))
(defmethod ->honeysql [:sql :ends-with]
  [driver [_ field arg options]]
  (like-clause (->honeysql driver field) (generate-pattern driver "%" arg nil options) options))
(defmethod ->honeysql [:sql :between]
  [driver [_ field min-val max-val]]
  [:between (->honeysql driver field) (->honeysql driver min-val) (->honeysql driver max-val)])
(defmethod ->honeysql [:sql :>]
  [driver [_ field value]]
  [:> (->honeysql driver field) (->honeysql driver value)])
(defmethod ->honeysql [:sql :<]
  [driver [_ field value]]
  [:< (->honeysql driver field) (->honeysql driver value)])
(defmethod ->honeysql [:sql :>=]
  [driver [_ field value]]
  [:>= (->honeysql driver field) (->honeysql driver value)])
(defmethod ->honeysql [:sql :<=]
  [driver [_ field value]]
  [:<= (->honeysql driver field) (->honeysql driver value)])
(defmethod ->honeysql [:sql :=]
  [driver [_ field value]]
  (assert field)
  [:= (->honeysql driver field) (->honeysql driver value)])
(defn- correct-null-behaviour
  [driver [op & args :as clause]]
  (if-let [field-arg (mbql.u/match-one args
                       :field          &match)]
    ;; We must not transform the head again else we'll have an infinite loop
    ;; (and we can't do it at the call-site as then it will be harder to fish out field references)
    [:or
     (into [op] (map (partial ->honeysql driver)) args)
     [:= (->honeysql driver field-arg) nil]]
    clause))
(defmethod ->honeysql [:sql :!=]
  [driver [_ field value]]
  (if (nil? (qp.wrap-value-literals/unwrap-value-literal value))
    [:not= (->honeysql driver field) (->honeysql driver value)]
    (correct-null-behaviour driver [:not= field value])))
(defmethod ->honeysql [:sql :and]
  [driver [_tag & subclauses]]
  (into [:and]
        (map (partial ->honeysql driver))
        subclauses))
(defmethod ->honeysql [:sql :or]
  [driver [_tag & subclauses]]
  (into [:or]
        (map (partial ->honeysql driver))
        subclauses))
(def ^:private clause-needs-null-behaviour-correction?
  (comp #{:contains :starts-with :ends-with} first))
(defmethod ->honeysql [:sql :not]
  [driver [_tag subclause]]
  (if (clause-needs-null-behaviour-correction? subclause)
    (correct-null-behaviour driver [:not subclause])
    [:not (->honeysql driver subclause)]))
(defmethod apply-top-level-clause [:sql :filter]
  [driver _ honeysql-form {clause :filter}]
  (sql.helpers/where honeysql-form (->honeysql driver clause)))

-------------------------------------------------- join tables ---------------------------------------------------

(declare mbql->honeysql)

Compile a single MBQL join to HoneySQL.

(defmulti join->honeysql
  {:added "0.32.9" :arglists '([driver join])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

Generate HoneySQL for a table or query to be joined.

(defmulti join-source
  {:added "0.32.9" :arglists '([driver join])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
(defmethod join-source :sql
  [driver {:keys [source-table source-query]}]
  (cond
    (and source-query (:native source-query))
    (sql-source-query (:native source-query) (:params source-query))

    source-query
    (mbql->honeysql driver {:query source-query})

    :else
    (->honeysql driver (lib.metadata/table (qp.store/metadata-provider) source-table))))

Schema for HoneySQL for a single JOIN. Used to validate that our join-handling code generates correct clauses.

(def ^:private HoneySQLJoin
  [:tuple
   ;;join source and alias
   [:tuple
    ;; join source
    :some
    ;; join alias
    :some]
   ;; join condition
   [:sequential :any]])
(mu/defmethod join->honeysql :sql :- HoneySQLJoin
  [driver {:keys [condition], join-alias :alias, :as join} :- mbql.s/Join]
  [[(join-source driver join)
    (let [table-alias (->honeysql driver (h2x/identifier :table-alias join-alias))]
      [table-alias])]
   (->honeysql driver condition)])

Use Honey SQL 2's :join-by so the joins are in the same order they are specified in MBQL (#15342). See [[metabase.query-processor-test.explicit-joins-test/join-order-test]].

(defn- apply-joins-honey-sql-2
  [driver honeysql-form joins]
  (letfn [(append-joins [join-by]
            (into (vec join-by)
                  (mapcat (fn [{:keys [strategy], :as join}]
                            [strategy (join->honeysql driver join)]))
                  joins))]
    (update honeysql-form :join-by append-joins)))
(defmethod apply-top-level-clause [:sql :joins]
  [driver _ honeysql-form {:keys [joins]}]
  #_{:clj-kondo/ignore [:deprecated-var]}
  (let [f apply-joins-honey-sql-2]
    (f driver honeysql-form joins)))

---------------------------------------------------- order-by ----------------------------------------------------

(defmethod ->honeysql [:sql :asc]
  [driver [direction field]]
  [(->honeysql driver field) direction])
(defmethod ->honeysql [:sql :desc]
  [driver [direction field]]
  [(->honeysql driver field) direction])
(defmethod apply-top-level-clause [:sql :order-by]
  [driver _ honeysql-form {subclauses :order-by}]
  (reduce sql.helpers/order-by honeysql-form (mapv (partial ->honeysql driver) subclauses)))

-------------------------------------------------- limit & page --------------------------------------------------

(defmethod apply-top-level-clause [:sql :limit]
  [_driver _top-level-clause honeysql-form {value :limit}]
  (sql.helpers/limit honeysql-form (inline-num value)))
(defmethod apply-top-level-clause [:sql :page]
  [_driver _top-level-clause honeysql-form {{:keys [items page]} :page}]
  (-> honeysql-form
      (sql.helpers/limit (inline-num items))
      (sql.helpers/offset (inline-num (* items (dec page))))))

-------------------------------------------------- source-table --------------------------------------------------

(defn- has-to-honeysql-impl-for-legacy-table? [driver]
  (not (identical? (get-method ->honeysql [driver :model/Table])
                   (get-method ->honeysql [:sql :model/Table]))))
(defmethod ->honeysql [:sql :model/Table]
  [driver table]
  (sql.qp.deprecated/log-deprecation-warning
   driver
   "metabase.driver.sql.query-processor/->honeysql for metabase.models.table/Table or :model/Table"
   "0.48.0")
  (let [{table-name :name, schema :schema} table]
    (->honeysql driver (h2x/identifier :table schema table-name))))
(defmethod ->honeysql [:sql :metadata/table]
  [driver table]
  (if (has-to-honeysql-impl-for-legacy-table? driver)
    (do
      (sql.qp.deprecated/log-deprecation-warning
       driver
       "metabase.driver.sql.query-processor/->honeysql for metabase.models.table/Table or :model/Table"
       "0.48.0")
      (->honeysql driver #_{:clj-kondo/ignore [:deprecated-var]} (qp.store/->legacy-metadata table)))
    (let [{table-name :name, schema :schema} table]
      (->honeysql driver (h2x/identifier :table schema table-name)))))
(defmethod apply-top-level-clause [:sql :source-table]
  [driver _top-level-clause honeysql-form {source-table-id :source-table}]
  (let [table (lib.metadata/table (qp.store/metadata-provider) source-table-id)
        expr  (->honeysql driver table)]
    (sql.helpers/from honeysql-form [expr])))

+----------------------------------------------------------------------------------------------------------------+ | Building the HoneySQL Form | +----------------------------------------------------------------------------------------------------------------+

Order to apply top-level clauses in. This is important because we build things like the SELECT clause progressively and MBQL requires us to return results with :breakout columns before :aggregation, etc.

Map of clause -> index, e.g.

{:source-table 0, :breakout 1, ...}

(def ^:private top-level-clause-application-order
  (into {} (map-indexed
            #(vector %2 %1)
            [:source-table :breakout :aggregation :fields :filter :joins :order-by :page :limit])))

Return the keys present in an MBQL inner-query in the order they should be processed.

(defn- query->keys-in-application-order
  [inner-query]
  ;; sort first by any known top-level clauses according to the `top-level-application-clause-order` defined above,
  ;; then sort any unknown clauses by name.
  (sort-by (fn [clause] [(get top-level-clause-application-order clause Integer/MAX_VALUE) clause])
           (keys inner-query)))
(defn- format-honeysql-2 [dialect honeysql-form]
  ;; throw people a bone and make sure they're not trying to use Honey SQL 1 stuff inside Honey SQL 2.
  (mbql.u/match honeysql-form
    (form :guard record?)
    (throw (ex-info (format "Not supported by Honey SQL 2: ^%s %s"
                            (.getCanonicalName (class form))
                            (pr-str form))
                    {:honeysql-form honeysql-form, :form form})))
  (if (map? honeysql-form)
    #_{:clj-kondo/ignore [:discouraged-var]}
    (sql/format honeysql-form {:dialect dialect, :quoted true, :quoted-snake false})
    ;; for weird cases when we want to compile just one particular snippet. Why are we doing this? Who knows. This seems
    ;; to not really be supported by Honey SQL 2, so hack around it for now. See upstream issue
    ;; https://github.com/seancorfield/honeysql/issues/456
    (binding [sql/*dialect*      (sql/get-dialect dialect)
              sql/*quoted*       true
              sql/*quoted-snake* false]
      (sql/format-expr honeysql-form {:nested true}))))

Compile a honeysql-form to a vector of [sql & params]. honeysql-form can either be a map (for a top-level query), or some sort of expression.

(defn format-honeysql
  ([driver honeysql-form]
   (format-honeysql nil (quote-style driver) honeysql-form))
  ;; TODO -- get rid of this unused param without breaking things.
  ([_version dialect honeysql-form]
   (try
     (format-honeysql-2 dialect honeysql-form)
     (catch Throwable e
       (try
         (log/error e
                    (u/format-color 'red
                                    (str (deferred-tru "Invalid HoneySQL form: {0}" (ex-message e))
                                         "\n"
                                         (u/pprint-to-str honeysql-form))))
         (finally
           (throw (ex-info (tru "Error compiling HoneySQL form: {0}" (ex-message e))
                           {:dialect dialect
                            :form    honeysql-form
                            :type    qp.error-type/driver}
                           e))))))))
(defn- default-select [driver {[from] :from, :as _honeysql-form}]
  (let [table-identifier (if (sequential? from)
                           ;; Grab the alias part.
                           ;;
                           ;; Honey SQL 2 = [expr [alias]]
                           (first (second from))
                           from)
        [raw-identifier] (format-honeysql driver table-identifier)
        expr             (if (seq raw-identifier)
                           [:raw (format "%s.*" raw-identifier)]
                           :*)]
    [[expr]]))

Add SELECT * to honeysql-form if no :select clause is present.

(defn- add-default-select
  [driver {:keys [select select-top], :as honeysql-form}]
  ;; TODO - this is hacky -- we should ideally never need to add `SELECT *`, because we should know what fields to
  ;; expect from the source query, and middleware should be handling that for us
  (cond
    (and (empty? select)
         (empty? select-top))
    (assoc honeysql-form :select (default-select driver honeysql-form))
    ;; select-top currently only has the first arg, the limit
    (= (count select-top) 1)
    (update honeysql-form :select-top (fn [existing]
                                        (into existing (default-select driver honeysql-form))))
    :else
    honeysql-form))

apply-top-level-clause for all of the top-level clauses in inner-query, progressively building a HoneySQL form. Clauses are applied according to the order in top-level-clause-application-order.

(defn- apply-top-level-clauses
  ([driver honeysql-form inner-query]
   (apply-top-level-clauses driver honeysql-form inner-query identity))
  ([driver honeysql-form inner-query xform]
   (transduce
    xform
    (fn
      ([honeysql-form]
       (add-default-select driver honeysql-form))
      ([honeysql-form k]
       (apply-top-level-clause driver k honeysql-form inner-query)))
    honeysql-form
    (query->keys-in-application-order inner-query))))
(declare apply-clauses)

Handle a :source-query clause by adding a recursive SELECT or native query. At the time of this writing, all source queries are aliased as source.

(defn- apply-source-query
  [driver honeysql-form {{:keys [native params],
                          persisted :persisted-info/native
                          :as source-query} :source-query}]
  (assoc honeysql-form
         :from [[(cond
                   persisted
                   (sql-source-query persisted nil)
                   native
                   (sql-source-query native params)
                   :else
                   (apply-clauses driver {} source-query))
                 (let [table-alias (->honeysql driver (h2x/identifier :table-alias source-query-alias))]
                   [table-alias])]]))

Like [[apply-top-level-clauses]], but handles source-query as well, which needs to be handled in a special way because it is aliased.

(defn- apply-clauses
  [driver honeysql-form {:keys [source-query], :as inner-query}]
  (binding [*inner-query* inner-query]
    (if source-query
      (apply-top-level-clauses
       driver
       (apply-source-query driver honeysql-form inner-query)
       inner-query
       ;; don't try to do anything with the source query recursively.
       (remove (partial = :source-query)))
      (apply-top-level-clauses driver honeysql-form inner-query))))

Do miscellaneous transformations to the MBQL before compiling the query. These changes are idempotent, so it is safe to use this function in your own implementations of [[driver/mbql->native]], if you want to apply changes to the same version of the query that we will ultimately be compiling.

(defmulti preprocess
  {:changelog-test/ignore true, :arglists '([driver inner-query]), :added "0.42.0"}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
(defmethod preprocess :sql
  [_driver inner-query]
  (nest-query/nest-expressions (add/add-alias-info inner-query)))

Build the HoneySQL form we will compile to SQL and execute.

(defn mbql->honeysql
  [driver {inner-query :query}]
  (binding [driver/*driver* driver]
    (let [inner-query (preprocess driver inner-query)]
      (log/tracef "Compiling MBQL query\n%s" (u/pprint-to-str 'magenta inner-query))
      (u/prog1 (apply-clauses driver {} inner-query)
        (log/debugf "\nHoneySQL Form: %s\n%s" (u/emoji "🍯") (u/pprint-to-str 'cyan <>))))))

MBQL -> Native

Transpile MBQL query into a native SQL statement. This is the :sql driver implementation of [[driver/mbql->native]] (actual multimethod definition is in [[metabase.driver.sql]].

(defn mbql->native
  [driver outer-query]
  (let [honeysql-form (mbql->honeysql driver outer-query)
        [sql & args]  (format-honeysql driver honeysql-form)]
    {:query sql, :params args}))
 

Deprecated stuff that used to live in [[metabase.driver.sql.query-processor]]. Moved here so it can live out its last days in a place we don't have to look at it, and to discourage people from using it. Also convenient for seeing everything that's deprecated at a glance.

Deprecated method impls should call [[log-deprecation-warning]] to gently nudge driver authors to stop using this method.

(ns metabase.driver.sql.query-processor.deprecated
  (:require
   [metabase.query-processor.store :as qp.store]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]))

This is unused at this moment in time but we can leave it around in case we want to use it again in the future (likely). See the code at v0.45.0 for example where we were using this a lot

Log a warning about usage of a deprecated method.

(log-deprecation-warning driver 'my.namespace/method "v0.42.0")

TODO -- this is actually pretty handy and I think we ought to use it for all the deprecated driver methods.

(defn log-deprecation-warning
  [driver method-name deprecated-version]
  (letfn [(thunk []
            (log/warn
             (u/colorize 'red
                         (trs "Warning: Driver {0} is using {1}. This method was deprecated in {2} and will be removed in a future release."
                              driver method-name deprecated-version))))]
    ;; only log each individual message once for the current QP store; by 'caching' the value with the key it is
    ;; effectively memoized for the rest of the QP run for the current query. The goal here is to avoid blasting the
    ;; logs with warnings about deprecated method calls, but still remind people regularly enough that it gets fixed
    ;; sometime in the near future.
    (if (qp.store/initialized?)
      (qp.store/cached [driver method-name deprecated-version]
        (thunk))
      (thunk))))
 

In Oracle and some other databases, empty strings are considered to be NULL, so WHERE field = '' is effectively the same as writing WHERE field = NULL, which of course is never true. This impl replaces empty-string values with nil so we generate correct SQL e.g. WHERE field IS NOT NULL. (See #13158)

Drivers can derive from this abstract driver to use an alternate implementation(s) of SQL QP method(s) that treat empty strings as nil.

(ns metabase.driver.sql.query-processor.empty-string-is-null
  (:require
   [metabase.driver :as driver]
   [metabase.driver.sql.query-processor :as sql.qp]))
(driver/register! ::empty-string-is-null, :abstract? true)
(defmethod sql.qp/->honeysql [::empty-string-is-null :value]
  [driver [_ value info]]
  (let [value (when-not (= value "")
                value)]
    ((get-method sql.qp/->honeysql [:sql :value]) driver [:value value info])))
(prefer-method sql.qp/->honeysql [::empty-string-is-null :value] [:sql :value])
 
(ns metabase.driver.sql.query-processor.util
  (:require
   [metabase.util.honey-sql-2 :as h2x]))

Take a nested field column field corresponding to something like an inner key within a JSON column, and then get the parent column's identifier from its own identifier and the nfc path stored in the field.

Suppose you have the child with corresponding identifier

(metabase.util.honey-sql-2/identifier :field "blah -> boop")

Ultimately, this is just a way to get the parent identifier

(metabase.util.honey-sql-2/identifier :field "blah")

(defn nfc-field->parent-identifier
  [field-identifier {:keys [nfc-path], :as _field}]
  {:pre [(h2x/identifier? field-identifier)]}
  (let [parent-components (-> (last field-identifier)
                              (vec)
                              (pop)
                              (conj (first nfc-path)))]
    (apply h2x/identifier (cons :field parent-components))))
 

Utility functions for writing SQL drivers.

(ns metabase.driver.sql.util
  (:require
   [clojure.string :as str]
   [metabase.driver.sql.query-processor :as sql.qp]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.util :as u]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu])
  (:import
   (com.github.vertical_blank.sqlformatter SqlFormatter SqlFormatter$Formatter)
   (com.github.vertical_blank.sqlformatter.core DialectConfig)
   (com.github.vertical_blank.sqlformatter.languages Dialect)))
(set! *warn-on-reflection* true)

Quote unqualified string or keyword identifier(s) by passing them to h2x/identifier, then calling HoneySQL format on the resulting Identifier. Uses the sql.qp/quote-style of the current driver. You can implement ->honeysql for Identifier if you need custom behavior here.

(quote-name :mysql :field "wow") ; -> "wow" (quote-name :h2 :field "wow") ; -> "\"WOW\""

You should only use this function for places where you are not using HoneySQL, such as queries written directly in SQL. For HoneySQL forms, Identifier is converted to SQL automatically when it is compiled.

(mu/defn quote-name
  "Quote unqualified string or keyword identifier(s) by passing them to `h2x/identifier`, then calling HoneySQL `format`
  on the resulting `Identifier`. Uses the `sql.qp/quote-style` of the current driver. You can implement `->honeysql`
  for `Identifier` if you need custom behavior here.
    (quote-name :mysql :field \"wow\") ; -> \"`wow`\"
    (quote-name :h2    :field \"wow\") ; -> \"\\\"WOW\\\"\"
  You should only use this function for places where you are not using HoneySQL, such as queries written directly in
  SQL. For HoneySQL forms, `Identifier` is converted to SQL automatically when it is compiled."
  [driver          :- :keyword
   identifier-type :- h2x/IdentifierType
   & components]
  (first
   (sql.qp/format-honeysql driver (apply h2x/identifier identifier-type components))))

+----------------------------------------------------------------------------------------------------------------+ | Deduplicate Field Aliases | +----------------------------------------------------------------------------------------------------------------+

(mu/defn ^:private increment-identifier-string :- :string
  [last-component :- :string]
  (if-let [[_ existing-suffix] (re-find #"^.*_(\d+$)" last-component)]
    ;; if last-component already has an alias like col_2 then increment it to col_3
    (let [new-suffix (str (inc (Integer/parseInt existing-suffix)))]
      (str/replace last-component (re-pattern (str existing-suffix \$)) new-suffix))
    ;; otherwise just stick a _2 on the end so it's col_2
    (str last-component "_2")))

Add an appropriate suffix to a keyword identifier to make it distinct from previous usages of the same identifier, e.g.

(increment-identifier :mycol) ; -> :mycol_2 (increment-identifier :mycol2) ; -> :mycol3

(mu/defn ^:private increment-identifier
  [[_tag identifier-type components] :- h2x/Identifier]
  (let [components' (concat
                     (butlast components)
                     [(increment-identifier-string (u/qualified-name (last components)))])]
    (apply h2x/identifier identifier-type components')))

Make sure all the columns in select-clause are alias forms, e.g. [:table.col :col] instead of :table.col. (This facilitates our deduplication logic.)

(defn select-clause-alias-everything
  [select-clause]
  (for [col select-clause]
    (cond
      ;; if something's already an alias form like [:table.col :col] it's g2g
      (and (sequential? col)
           (not (h2x/identifier? col)))
      col
      ;; otherwise we *should* be dealing with an Identifier. If so, take the last component of the Identifier and use
      ;; that as the alias.
      ;;
      ;; TODO - could this be done using `->honeysql` or `field->alias` instead?
      (h2x/identifier? col)
      (let [[_tag _identifier-type components] col]
        [col (h2x/identifier :field-alias (last components))])
      :else
      (do
        (log/errorf "Don't know how to alias %s, expected an h2x/identifier" (pr-str col))
        [col col]))))

Make sure every column in select-clause has a unique alias. This is useful for databases like Oracle that can't figure out how to use a query that produces duplicate columns in a subselect.

(defn select-clause-deduplicate-aliases
  [select-clause]
  (if (= select-clause [:*])
    ;; if we're doing `SELECT *` there's no way we can deduplicate anything so we're SOL, return as-is
    select-clause
    ;; otherwise we can actually deduplicate things
    (loop [already-seen #{}, acc [], [[col alias] & more] (select-clause-alias-everything select-clause)]
      (cond
        ;; if not more cols are left to deduplicate, we're done
        (not col)
        acc
        ;; otherwise if we've already used this alias, replace it with one like `identifier_2` and try agan
        (contains? already-seen alias)
        (recur already-seen acc (cons [col (increment-identifier alias)]
                                      more))
        ;; otherwise if we haven't seen it record it as seen and move on to the next column
        :else
        (recur (conj already-seen alias) (conj acc [col alias]) more)))))

Escape single quotes in a SQL string. escape-style is either :ansi (escape a single quote with two single quotes) or :backslashes (escape a single quote with a backslash).

(escape-sql "Tito's Tacos" :ansi) ; -> "Tito''s Tacos" (escape-sql "Tito's Tacos" :backslashes) ; -> "Tito\'s Tacos"

!!!! VERY IMPORTANT !!!!

DON'T RELY ON THIS FOR SANITIZING USER INPUT BEFORE RUNNING QUERIES!

For user input, ALWAYS pass parameters separately (e.g. using ? in the SQL) where supported, or if unsupported, encode the strings as hex and splice in something along the lines of utf8_string(hex_decode(<hex-string>)) instead. This is intended only for escaping trusted strings, or for generating the SQL equivalent version of an MBQL query for debugging purposes or powering the 'convert to SQL' feature.

(defn escape-sql
  "Escape single quotes in a SQL string. `escape-style` is either `:ansi` (escape a single quote with two single quotes)
  or `:backslashes` (escape a single quote with a backslash).
    (escape-sql \"Tito's Tacos\" :ansi)        ; -> \"Tito''s Tacos\"
    (escape-sql \"Tito's Tacos\" :backslashes) ; -> \"Tito\\'s Tacos\"
  !!!! VERY IMPORTANT !!!!
  DON'T RELY ON THIS FOR SANITIZING USER INPUT BEFORE RUNNING QUERIES!
  For user input, *ALWAYS* pass parameters separately (e.g. using `?` in the SQL) where supported, or if unsupported,
  encode the strings as hex and splice in something along the lines of `utf8_string(hex_decode(<hex-string>))`
  instead. This is intended only for escaping trusted strings, or for generating the SQL equivalent version of an MBQL
  query for debugging purposes or powering the 'convert to SQL' feature."
  {:arglists '([s :ansi] [s :backslashes])}
  ^String [^String s escape-style]
  (when s
    (case escape-style
      :ansi        (str/replace s "'" "''")
      :backslashes (-> s
                       (str/replace "\\" "\\\\")
                       (str/replace "'" "\\'")))))

Validate the arguments of convert-timezone. - if input column has timezone only target-timezone is required, throw exception if source-timezone is provided. - if input column doesn't have a timezone both target-timezone and source-timezone are required.

(defn validate-convert-timezone-args
  [has-timezone? target-timezone source-timezone]
  (when (and has-timezone? source-timezone)
      (throw (ex-info (tru "input column already has a set timezone. Please remove the source parameter in convertTimezone.")
                      {:type            qp.error-type/invalid-query
                       :target-timezone target-timezone
                       :source-timezone source-timezone})))
  (when (and (not has-timezone?) (not source-timezone))
    (throw (ex-info (tru "input column doesn't have a set timezone. Please set the source parameter in convertTimezone to convert it.")
                    {:type            qp.error-type/invalid-query
                     :target-timezone target-timezone
                     :source-timezone source-timezone}))))

[[format-sql]] will expand parameterized values (e.g. {{#123}} -> { { # 123 } }). This function fixes that by removing whitespace from matching double-curly brace substrings.

(defn fix-sql-params
  [sql]
  (when (string? sql)
    (let [rgx #"\{\s*\{\s*[^\}]+\s*\}\s*\}"]
      (str/replace sql rgx (fn [match] (str/replace match #"\s*" ""))))))

Mapping of dialect kw to dialect, used by sql formatter in [[format-sql]], to dialect.

(def dialects
  {:db2         Dialect/Db2
   :mariadb     Dialect/MariaDb
   :mysql       Dialect/MySql
   :n1ql        Dialect/N1ql
   :plsql       Dialect/PlSql
   :postgres    Dialect/PostgreSql
   :redshift    Dialect/Redshift
   :sparksql    Dialect/SparkSql
   :standardsql Dialect/StandardSql
   :tsql        Dialect/TSql})
(def ^:private ^java.util.List additional-operators
  ["#>>" "!="])
(defn- add-operators
  ^SqlFormatter$Formatter [^SqlFormatter$Formatter formatter]
  (.extend formatter (reify java.util.function.UnaryOperator
                       (apply [_this config]
                         (.plusOperators ^DialectConfig config additional-operators)))))

Pretty format sql string using appropriate dialect. dialect is derived from driver-or-dialect-kw. If there is no corresponding value in [[dialects]]. fallback to Dialect/StandardSql. For more details see the [[metabase.driver/prettify-native-form]].

(defn format-sql
  [driver-or-dialect-kw sql]
  (when (string? sql)
    (let [dialect (get dialects driver-or-dialect-kw Dialect/StandardSql)
          formatter (add-operators (SqlFormatter/of ^Dialect dialect))]
      (.format formatter ^String sql))))

[[format-sql]] and [[fix-sql-params]] afterwards. For details see those functions.

(defn format-sql-and-fix-params
  [driver-or-dialect-kw sql]
  (-> (format-sql driver-or-dialect-kw sql) fix-sql-params))
 

Utility functions for converting a prepared statement with ? param placeholders into a plain SQL query by splicing params in place.

TODO -- since this is no longer strictly a 'util' namespace (most :sql-jdbc drivers need to implement one or methods from here) let's rename this metabase.driver.sql.unprepare when we get a chance.

(ns metabase.driver.sql.util.unprepare
  (:require
   [clojure.string :as str]
   [java-time.api :as t]
   [metabase.driver :as driver]
   [metabase.driver.sql.util :as sql.u]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log])
  (:import
   (java.time Instant LocalDate LocalDateTime LocalTime OffsetDateTime OffsetTime ZonedDateTime)))
(set! *warn-on-reflection* true)

Convert a single argument to appropriate raw SQL for splicing directly into a SQL query. Dispatches on both driver and the class of value.

(defmulti unprepare-value
  {:added "0.32.0" :arglists '(^String [driver value])}
  (fn [driver value]
    [(driver/the-initialized-driver driver) (class value)])
  :hierarchy #'driver/hierarchy)
(defmethod unprepare-value :default
  [_ value]
  ;; it's better return a slightly broken SQL query with a probably incorrect string representation of the value than
  ;; to have the entire QP run fail because of an unknown type.
  (log/warn (trs "Don''t know how to unprepare values of class {0}" (.getName (class value))))
  (str value))
(defmethod unprepare-value [:sql nil]
  [_ _]
  "NULL")
(defmethod unprepare-value [:sql String]
  [_ s]
  ;; escape single-quotes like Cam's String -> Cam''s String
  (str \' (sql.u/escape-sql s :ansi) \'))
(defmethod unprepare-value [:sql Boolean]
  [_ value]
  (if value "TRUE" "FALSE"))
(defmethod unprepare-value [:sql Number]
  [_ value]
  (str value))
(defmethod unprepare-value [:sql LocalDate]
  [_ t]
  (format "date '%s'" (t/format "yyyy-MM-dd" t)))
(defmethod unprepare-value [:sql LocalTime]
  [_ t]
  (format "time '%s'" (t/format "HH:mm:ss.SSS" t)))
(defmethod unprepare-value [:sql OffsetTime]
  [_ t]
  (format "time with time zone '%s'" (t/format "HH:mm:ss.SSSZZZZZ" t)))
(defmethod unprepare-value [:sql LocalDateTime]
  [_ t]
  (format "timestamp '%s'" (t/format "yyyy-MM-dd HH:mm:ss.SSS" t)))
(defmethod unprepare-value [:sql OffsetDateTime]
  [_ t]
  (format "timestamp with time zone '%s'" (t/format "yyyy-MM-dd HH:mm:ss.SSSZZZZZ" t)))
(defmethod unprepare-value [:sql ZonedDateTime]
  [_ t]
  (format "timestamp with time zone '%s'" (t/format "yyyy-MM-dd HH:mm:ss.SSSZZZZZ" t)))

TODO - pretty sure we can remove this

(defmethod unprepare-value [:sql Instant]
  [driver t]
  (unprepare-value driver (t/offset-date-time t (t/zone-offset 0))))

Convert a normal SQL [statement & prepared-statement-args] vector into a flat, non-prepared statement. Implementations should return a plain SQL string.

Drivers likely do not need to implement this method themselves -- instead, you should only need to provide implementations of unprepare-value for the cases where it is needed.

TODO - I think a name like deparameterize would be more appropriate here

(defmulti ^String unprepare
  {:added "0.32.0", :arglists '([driver [sql & args]]), :style/indent 1}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
(defmethod unprepare :sql [driver [sql & args]]
  (transduce
   identity
   (completing
    (fn [sql arg]
      ;; Only match single question marks; do not match ones like `??` which JDBC converts to `?` to use as Postgres
      ;; JSON operators amongst other things.
      ;;
      ;; TODO - this is not smart enough to handle question marks in non argument contexts, for example if someone
      ;; were to have a question mark inside an identifier such as a table name. I think we'd have to parse the SQL in
      ;; order to handle those situations.
      (let [v (str (unprepare-value driver arg))]
        (log/tracef "Splice %s as %s" (pr-str arg) (pr-str v))
        (str/replace-first sql #"(?<!\?)\?(?!\?)" (str/re-quote-replacement v))))
    (fn [spliced-sql]
      (log/tracef "Spliced %s\n-> %s" (u/colorize 'green (pr-str sql)) (u/colorize 'blue (pr-str spliced-sql)))
      spliced-sql))
   sql
   args))
 

General functions and utilities for sync operations across multiple drivers.

(ns metabase.driver.sync
  (:require
   [clojure.string :as str]
   [metabase.driver.util :as driver.u])
  (:import
   (java.util.regex Pattern)))
(set! *warn-on-reflection* true)

Converts a schema pattern, as entered in the UI, into regex pattern suitable to be passed into [[re-pattern]]. The conversion that happens is from commas into pipes (disjunction), and wildcard characters (*) into greedy wildcard matchers (.*). These only occur if those characters are not preceded by a backslash, which serves as an escape character for purposes of this conversion. Any whitespace before and after commas is trimmed.

Examples: a,b => a|b test* => test.* foo,bar => foo.|.bar foo , bar , baz => foo|ba.r|baz crazy*schema => crazy*schema

(defn- schema-pattern->re-pattern
  "Converts a schema pattern, as entered in the UI, into regex pattern suitable to be passed into [[re-pattern]].  The
  conversion that happens is from commas into pipes (disjunction), and wildcard characters (`*`) into greedy wildcard
  matchers (`.*`).  These only occur if those characters are not preceded by a backslash, which serves as an escape
  character for purposes of this conversion.  Any whitespace before and after commas is trimmed.
  Examples:
    a,b => a|b
    test* => test.*
    foo*,*bar => foo.*|.*bar
    foo  ,  ba*r  , baz => foo|ba.*r|baz
    crazy\\*schema => crazy\\*schema"
  ^Pattern [^String schema-pattern]
  (re-pattern (->> (str/split schema-pattern #",")
                   (map (comp #(str/replace % #"(^|[^\\\\])\*" "$1.*") str/trim))
                   (str/join "|"))))
(defn- schema-patterns->filter-fn*
  [inclusion-patterns exclusion-patterns]
  (let [inclusion-blank? (str/blank? inclusion-patterns)
        exclusion-blank? (str/blank? exclusion-patterns)]
    (cond
      (and inclusion-blank? exclusion-blank?)
      (constantly true)
      (and (not inclusion-blank?) (not exclusion-blank?))
      (throw (ex-info "Inclusion and exclusion patterns cannot both be specified"
                      {::inclusion-patterns inclusion-patterns
                       ::exclusion-patterns exclusion-patterns}))
      :else
      (let [inclusion? exclusion-blank?
            pattern    (schema-pattern->re-pattern (if inclusion? inclusion-patterns exclusion-patterns))]
        (fn [s]
          (let [m        (.matcher pattern s)
                matches? (.matches m)]
            (if inclusion? matches? (not matches?))))))))
(def ^:private schema-patterns->filter-fn (memoize schema-patterns->filter-fn*))

Given an optional prop-nm (which is expected to be a connection property of type :schema-filters), and a database instance, return a vector containing [inclusion-patterns exclusion-patterns].

(defn db-details->schema-filter-patterns
  {:added "0.42.0"}
  ([database]
   (let [{prop-name :name} (driver.u/find-schema-filters-prop (driver.u/database->driver database))]
     (db-details->schema-filter-patterns prop-name database)))
  ([prop-nm {db-details :details :as _database}]
   (let [schema-filter-type     (get db-details (keyword (str prop-nm "-type")))
         schema-filter-patterns (get db-details (keyword (str prop-nm "-patterns")))]
     (case schema-filter-type
       "exclusion" [nil schema-filter-patterns]
       "inclusion" [schema-filter-patterns nil]
       [nil nil]))))

Returns true if the given schema-name should be included/synced, considering the given inclusion-patterns and exclusion-patterns (either provided explicitly or taken from the driver's connection properties). Patterns are comma-separated, and can contain wildcard characters (*).

(defn include-schema?
  {:added "0.42.0"}
  ([database schema-name]
   (let [[inclusion-patterns exclusion-patterns] (db-details->schema-filter-patterns database)]
     (include-schema? inclusion-patterns exclusion-patterns schema-name)))
  ([inclusion-patterns exclusion-patterns schema-name]
   (let [filter-fn (schema-patterns->filter-fn inclusion-patterns exclusion-patterns)]
     (filter-fn schema-name))))
 

Utility functions for common operations on drivers.

(ns metabase.driver.util
  (:require
   [clojure.core.memoize :as memoize]
   [clojure.set :as set]
   [clojure.string :as str]
   [metabase.config :as config]
   [metabase.db.connection :as mdb.connection]
   [metabase.driver :as driver]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.models.setting :refer [defsetting]]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.store :as qp.store]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru trs]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms])
  (:import
   (java.io ByteArrayInputStream)
   (java.security KeyFactory KeyStore PrivateKey)
   (java.security.cert Certificate CertificateFactory X509Certificate)
   (java.security.spec PKCS8EncodedKeySpec)
   (javax.net SocketFactory)
   (javax.net.ssl KeyManagerFactory SSLContext TrustManagerFactory X509TrustManager)))
(set! *warn-on-reflection* true)

Generic error messages that drivers should return in their implementation of [[metabase.driver/humanize-connection-error-message]].

(def ^:private connection-error-messages
  {:cannot-connect-check-host-and-port
   {:message (deferred-tru
               (str "Hmm, we couldn''t connect to the database."
                    " "
                    "Make sure your Host and Port settings are correct"))
    :errors  {:host (deferred-tru "check your host settings")
              :port (deferred-tru "check your port settings")}}
   :ssh-tunnel-auth-fail
   {:message (deferred-tru
               (str "We couldn''t connect to the SSH tunnel host."
                    " "
                    "Check the Username and Password."))
    :errors  {:tunnel-user (deferred-tru "check your username")
              :tunnel-pass (deferred-tru "check your password")}}
   :ssh-tunnel-connection-fail
   {:message (deferred-tru
               (str "We couldn''t connect to the SSH tunnel host."
                    " "
                    "Check the Host and Port."))
    :errors  {:tunnel-host (deferred-tru "check your host settings")
              :tunnel-port (deferred-tru "check your port settings")}}
   :database-name-incorrect
   {:message (deferred-tru "Looks like the Database name is incorrect.")
    :errors  {:dbname (deferred-tru "check your database name settings")}}
   :invalid-hostname
   {:message (deferred-tru
               (str "It looks like your Host is invalid."
                    " "
                    "Please double-check it and try again."))
    :errors  {:host (deferred-tru "check your host settings")}}
   :password-incorrect
   {:message (deferred-tru "Looks like your Password is incorrect.")
    :errors  {:password (deferred-tru "check your password")}}
   :password-required
   {:message (deferred-tru "Looks like you forgot to enter your Password.")
    :errors  {:password (deferred-tru "check your password")}}
   :username-incorrect
   {:message (deferred-tru "Looks like your Username is incorrect.")
    :errors  {:user (deferred-tru "check your username")}}
   :username-or-password-incorrect
   {:message (deferred-tru "Looks like the Username or Password is incorrect.")
    :errors  {:user     (deferred-tru "check your username")
              :password (deferred-tru "check your password")}}
   :certificate-not-trusted
   {:message (deferred-tru "Server certificate not trusted - did you specify the correct SSL certificate chain?")}
   :unsupported-ssl-key-type
   {:message (deferred-tru "Unsupported client SSL key type - are you using an RSA key?")}
   :invalid-key-format
   {:message (deferred-tru "Invalid client SSL key - did you select the correct file?")}
   :requires-ssl
   {:message (deferred-tru "Server appears to require SSL - please enable SSL below")
    :errors  {:ssl (deferred-tru "please enable SSL")}}
   :implicitly-relative-db-file-path
   {:message (deferred-tru "Implicitly relative file paths are not allowed.")
    :errors  {:db (deferred-tru "check your connection string")}}
   :db-file-not-found
   {:message (deferred-tru "Database cannot be found.")
    :errors  {:db (deferred-tru "check your connection string")}}})
(defn- tr-connection-error-messages [error-type-kw]
  (when-let [message (connection-error-messages error-type-kw)]
    (cond-> message
      (contains? message :message) (update :message str)
      (contains? message :errors)  (update :errors update-vals str))))
(comment mdb.connection/keep-me) ; used for [[memoize/ttl]]

Consider [[metabase.driver/can-connect?]] / [[can-connect-with-details?]] to have failed if they were not able to successfully connect after this many milliseconds. By default, this is 10 seconds.

This is normally set via the env var MB_DB_CONNECTION_TIMEOUT_MS

(defsetting db-connection-timeout-ms
  :visibility :internal
  :type       :integer
  ;; for TESTS use a timeout time of 3 seconds. This is because we have some tests that check whether
  ;; [[driver/can-connect?]] is failing when it should, and we don't want them waiting 10 seconds to fail.
  ;;
  ;; Don't set the timeout too low -- I've have Circle fail when the timeout was 1000ms on *one* occasion.
  :default    (if config/is-test?
                3000
                10000))
(defn- connection-error? [^Throwable throwable]
  (and (some? throwable)
       (or (instance? java.net.ConnectException throwable)
           (recur (.getCause throwable)))))

Check whether we can connect to a database with driver and details-map and perform a basic query such as `SELECT 1. Specify optional paramthrow-exceptions` if you want to handle any exceptions thrown yourself (e.g., so you can pass the exception message along to the user); otherwise defaults to returning false if a connection cannot be established.

(can-connect-with-details? :postgres {:host "localhost", :port 5432, ...})

(defn can-connect-with-details?
  ^Boolean [driver details-map & [throw-exceptions]]
  {:pre [(keyword? driver) (map? details-map)]}
  (if throw-exceptions
    (try
      (u/with-timeout (db-connection-timeout-ms)
        (or (driver/can-connect? driver details-map)
            (throw (Exception. "Failed to connect to Database"))))
      ;; actually if we are going to `throw-exceptions` we'll rethrow the original but attempt to humanize the message
      ;; first
      (catch Throwable e
        (log/errorf e "Failed to connect to Database")
        (throw (if-let [humanized-message (some->> (.getMessage e)
                                                   (driver/humanize-connection-error-message driver))]
                 (let [error-data (cond
                                    (keyword? humanized-message)
                                    (tr-connection-error-messages humanized-message)
                                    (connection-error? e)
                                    (tr-connection-error-messages :cannot-connect-check-host-and-port)
                                    :else
                                    {:message humanized-message})]
                   (ex-info (str (:message error-data)) error-data e))
                 e))))
    (try
      (can-connect-with-details? driver details-map :throw-exceptions)
      (catch Throwable e
        (log/error e (trs "Failed to connect to database"))
        false))))

+----------------------------------------------------------------------------------------------------------------+ | Driver Resolution | +----------------------------------------------------------------------------------------------------------------+

(def ^:private ^{:arglists '([db-id])} database->driver*
  (memoize/ttl
   (-> (mu/fn :- :keyword
         [db-id :- ::lib.schema.id/database]
         (qp.store/with-metadata-provider db-id
           (:engine (lib.metadata.protocols/database (qp.store/metadata-provider)))))
       (vary-meta assoc ::memoize/args-fn (fn [[db-id]]
                                            [(mdb.connection/unique-identifier) db-id])))
   :ttl/threshold 1000))
(mu/defn database->driver :- :keyword
  "Look up the driver that should be used for a Database. Lightly cached.
  (This is cached for a second, so as to avoid repeated application DB calls if this function is called several times
  over the duration of a single API request or sync operation.)"
  [database-or-id :- [:or
                      {:error/message "Database or ID"}
                      [:map
                       [:engine [:or :keyword :string]]]
                      [:map
                       [:id ::lib.schema.id/database]]
                      ::lib.schema.id/database]]
  (if-let [driver (:engine database-or-id)]
    ;; ensure we get the driver as a keyword (sometimes it's a String)
    (keyword driver)
    (if (qp.store/initialized?)
      (:engine (lib.metadata/database (qp.store/metadata-provider)))
      (database->driver* (u/the-id database-or-id)))))

+----------------------------------------------------------------------------------------------------------------+ | Available Drivers Info | +----------------------------------------------------------------------------------------------------------------+

Return a set of all features supported by driver with respect to database.

(defn features
  [driver database]
  (set (for [feature driver/driver-features
             :when (driver/database-supports? driver feature database)]
         feature)))

Return a set of all currently available drivers.

(defn available-drivers
  []
  (set (for [driver (descendants driver/hierarchy :metabase.driver/driver)
             :when  (driver/available? driver)]
         driver)))
(mu/defn semantic-version-gte :- :boolean
  "Returns true if xv is greater than or equal to yv according to semantic versioning.
   xv and yv are sequences of integers of the form `[major minor ...]`, where only
   major is obligatory.
   Examples:
   (semantic-version-gte [4 1] [4 1]) => true
   (semantic-version-gte [4 0 1] [4 1]) => false
   (semantic-version-gte [4 1] [4]) => true
   (semantic-version-gte [3 1] [4]) => false"
  [xv :- [:maybe [:sequential ms/IntGreaterThanOrEqualToZero]]
   yv :- [:maybe [:sequential ms/IntGreaterThanOrEqualToZero]]]
  (loop [xv (seq xv), yv (seq yv)]
    (or (nil? yv)
        (let [[x & xs] xv
              [y & ys] yv
              x (if (nil? x) 0 x)
              y (if (nil? y) 0 y)]
          (or (> x y)
              (and (>= x y) (recur xs ys)))))))
(defn- file-upload-props [{prop-name :name, visible-if :visible-if, disp-nm :display-name, :as conn-prop}]
  (if (premium-features/is-hosted?)
    [(-> (assoc conn-prop
           :name (str prop-name "-value")
           :type "textFile"
           :treat-before-posting "base64")
         (dissoc :secret-kind))]
    [(cond-> {:name (str prop-name "-options")
              :display-name disp-nm
              :type "select"
              :options [{:name (trs "Local file path")
                         :value "local"}
                        {:name (trs "Uploaded file path")
                         :value "uploaded"}]
              :default "local"}
             visible-if (assoc :visible-if visible-if))
     (-> {:name (str prop-name "-value")
          :type "textFile"
          :treat-before-posting "base64"
          :visible-if {(keyword (str prop-name "-options")) "uploaded"}}
       (dissoc :secret-kind))
     {:name (str prop-name "-path")
      :type "string"
      :display-name (trs "File path")
      :placeholder (:placeholder conn-prop)
      :visible-if {(keyword (str prop-name "-options")) "local"}}]))

Turns x into a String. If x a keyword, then name is used. Otherwise, str is called on it.

(defn- ->str
  [k]
  (if (keyword? k)
    (name k)
    (str k)))
(defn- expand-secret-conn-prop [{prop-name :name, :as conn-prop}]
  (case (->str (:secret-kind conn-prop))
    "password"    [(-> conn-prop
                       (assoc :type "password")
                       (assoc :name (str prop-name "-value"))
                       (dissoc :secret-kind))]
    "keystore"    (file-upload-props conn-prop)
    ;; this may not necessarily be a keystore (could be a standalone PKCS-8 or PKCS-12 file)
    "binary-blob" (file-upload-props conn-prop)
    ;; PEM is a plaintext format
    ;; TODO: do we need to also allow a textarea type paste for this?  would require another special case
    "pem-cert"    (file-upload-props conn-prop)
    [conn-prop]))

Invokes the getter function on a info type connection property and adds it to the connection property map as its placeholder value. Returns nil if no placeholder value or getter is provided, or if the getter returns a non-string value or throws an exception.

(defn- resolve-info-conn-prop
  [{ getter :getter, placeholder :placeholder, :as conn-prop}]
  (let [content (or placeholder
                    (try (getter)
                         (catch Throwable e
                           (log/error e (trs "Error invoking getter for connection property {0}"
                                             (:name conn-prop))))))]
    (when (string? content)
      (-> conn-prop
          (assoc :placeholder content)
          (dissoc :getter)))))
(defn- expand-schema-filters-prop [prop]
  (let [prop-name (:name prop)
        disp-name (or (:display-name prop) )
        type-prop-nm (str prop-name "-type")]
    [{:name type-prop-nm
      :display-name disp-name
      :type "select"
      :options [{:name (trs "All")
                 :value "all"}
                {:name (trs "Only these...")
                 :value "inclusion"}
                {:name (trs "All except...")
                 :value "exclusion"}]
      :default "all"}
     {:name (str prop-name "-patterns")
      :type "text"
      :placeholder "E.x. public,auth*"
      :description (trs "Comma separated names of {0} that should appear in Metabase" (u/lower-case-en disp-name))
      :visible-if  {(keyword type-prop-nm) "inclusion"}
      :helper-text (trs "You can use patterns like \"auth*\" to match multiple {0}" (u/lower-case-en disp-name))
      :required true}
     {:name (str prop-name "-patterns")
      :type "text"
      :placeholder "E.x. public,auth*"
      :description (trs "Comma separated names of {0} that should NOT appear in Metabase" (u/lower-case-en disp-name))
      :visible-if  {(keyword type-prop-nm) "exclusion"}
      :helper-text (trs "You can use patterns like \"auth*\" to match multiple {0}" (u/lower-case-en disp-name))
      :required true}]))

Finds the first property of type :schema-filters for the given driver connection properties. Returns nil if the driver has no property of that type.

(defn find-schema-filters-prop
  [driver]
  (first (filter (fn [conn-prop]
                   (= :schema-filters (keyword (:type conn-prop))))
           (driver/connection-properties driver))))

Transforms conn-props for the given driver from their server side definition into a client side definition.

This transforms :type :secret properties from the server side definition into other types for client display/editing. For example, a :secret-kind :keystore turns into a bunch of different properties, to encapsulate all the different options that might be available on the client side for populating the value.

This also resolves the :getter function on :type :info properties, if one was provided.

(defn connection-props-server->client
  {:added "0.42.0"}
  [driver conn-props]
  (let [res (reduce (fn [acc conn-prop]
                      ;; TODO: change this to expanded- and use that as the basis for all calcs below (not conn-prop)
                      (let [expanded-props (case (keyword (:type conn-prop))
                                             :secret
                                             (expand-secret-conn-prop conn-prop)
                                             :info
                                             (if-let [conn-prop' (resolve-info-conn-prop conn-prop)]
                                               [conn-prop']
                                               [])
                                             :schema-filters
                                             (expand-schema-filters-prop conn-prop)
                                             [conn-prop])]
                        (-> (update acc ::final-props concat expanded-props)
                            (update ::props-by-name merge (into {} (map (fn [p]
                                                                          [(:name p) p])) expanded-props)))))
                    {::final-props [] ::props-by-name {}}
                    conn-props)
        {::keys [final-props props-by-name]} res]
    ;; now, traverse the visible-if-edges and update all visible-if entries with their full set of "transitive"
    ;; dependencies (if property x depends on y having a value, but y itself depends on z having a value, then x
    ;; should be hidden if y is)
    (mapv (fn [prop]
            (let [v-ifs* (loop [props* [prop]
                                acc    {}]
                           (if (seq props*)
                             (let [all-visible-ifs  (apply merge (map :visible-if props*))
                                   transitive-props (map (comp (partial get props-by-name) ->str)
                                                         (keys all-visible-ifs))
                                   next-acc         (merge all-visible-ifs acc)
                                   cyclic-props     (set/intersection (into #{} (keys all-visible-ifs))
                                                                      (into #{} (keys acc)))]
                               (if (empty? cyclic-props)
                                 (recur transitive-props next-acc)
                                 (-> (trs "Cycle detected resolving dependent visible-if properties for driver {0}: {1}"
                                          driver cyclic-props)
                                     (ex-info {:type               qp.error-type/driver
                                               :driver             driver
                                               :cyclic-visible-ifs cyclic-props})
                                     throw)))
                             acc))]
              (cond-> prop
                (seq v-ifs*)
                (assoc :visible-if v-ifs*))))
         final-props)))

A regex to match data-URL-encoded files uploaded via the frontend

(def data-url-pattern
  #"^data:[^;]+;base64,")

Returns bytes from encoded frontend file upload string.

(defn decode-uploaded
  ^bytes [^String uploaded-data]
  (u/decode-base64-to-bytes (str/replace uploaded-data data-url-pattern "")))

Currently, this transforms client side values for the various back into :type :secret for storage on the server. Sort of the opposite of connection-props-server->client, except that it operates on DB details key/values populated by the client, not on connection detail maps created on the server.

(defn db-details-client->server
  {:added "0.42.0"}
  [driver db-details]
  (when db-details
    (assert (some? driver))
    (let [secret-names->props    (reduce (fn [acc prop]
                                           (if (= "secret" (:type prop))
                                             (assoc acc (:name prop) prop)
                                             acc))
                                         {}
                                         (driver/connection-properties driver))
          secrets-server->client (reduce (fn [acc prop]
                                           (assoc acc (keyword (:name prop)) prop))
                                   {}
                                   (connection-props-server->client driver (vals secret-names->props)))]
      (reduce-kv (fn [acc prop-name _prop]
                   (let [subprop    (fn [suffix]
                                      (keyword (str prop-name suffix)))
                         path-kw    (subprop "-path")
                         val-kw     (subprop "-value")
                         source-kw  (subprop "-source")
                         options-kw (subprop "-options")
                         path       (path-kw acc)
                         get-treat  (fn []
                                      (let [options (options-kw acc)]
                                        (when (= "uploaded" options)
                                          ;; the :treat-before-posting, if defined, would be applied to the client
                                          ;; version of the -value property (the :type "textFile" one)
                                          (let [textfile-prop (val-kw secrets-server->client)]
                                            (:treat-before-posting textfile-prop)))))
                         value      (when-let [^String v (val-kw acc)]
                                      (case (get-treat)
                                        "base64" (decode-uploaded v)
                                        v))]
                     (cond-> (assoc acc val-kw value)
                       ;; keywords here are associated to nil, rather than being dissoced, because they will be merged
                       ;; with the existing db-details blob to produce the final details
                       ;; therefore, if we want a changed setting to take effect (i.e. switching from a file path to an
                       ;; upload), then we need to ensure the nil value is merged, rather than the stale value from the
                       ;; app DB being picked
                       path  (-> ; from outer cond->
                               (assoc val-kw nil) ; local path specified; remove the -value entry, if it exists
                               (assoc source-kw :file-path)) ; and set the :source to :file-path
                       value (-> ; from outer cond->
                               (assoc path-kw nil) ; value specified; remove the -path entry, if it exists
                               (assoc source-kw nil)) ; and remove the :source mapping
                       true  (dissoc (subprop "-options")))))
                 db-details
                 secret-names->props))))

The set of all official drivers

(def official-drivers
  #{"athena"
    "bigquery-cloud-sdk"
    "druid"
    "googleanalytics"
    "h2"
    "mongo"
    "mysql"
    "oracle"
    "postgres"
    "presto-jdbc"
    "redshift"
    "snowflake"
    "sparksql"
    "sqlite"
    "sqlserver"
    "vertica"})

The set of other drivers in the partnership program

(def partner-drivers
  #{"clickhouse" "exasol" "firebolt" "materialize" "ocient" "starburst"})

Return the source type of the driver: official, partner, or community

(defn driver-source
  [driver-name]
  (cond
    (contains? official-drivers driver-name) "official"
    (contains? partner-drivers driver-name) "partner"
    :else "community"))

Return info about all currently available drivers, including their connection properties fields and supported features. The output of driver/connection-properties is passed through connection-props-server->client before being returned, to handle any transformation between the server side and client side representation.

(defn available-drivers-info
  []
  (into {} (for [driver (available-drivers)
                 :let   [props (try
                                 (->> (driver/connection-properties driver)
                                      (connection-props-server->client driver))
                                 (catch Throwable e
                                   (log/error e (trs "Unable to determine connection properties for driver {0}" driver))))]
                 :when  props]
             ;; TODO - maybe we should rename `details-fields` -> `connection-properties` on the FE as well?
             [driver {:source {:type (driver-source (name driver))
                               :contact (driver/contact-info driver)}
                      :details-fields props
                      :driver-name    (driver/display-name driver)
                      :superseded-by  (driver/superseded-by driver)}])))

Available database engines

(defsetting engines
  :visibility :public
  :setter     :none
  :getter     available-drivers-info
  :doc        false)

+----------------------------------------------------------------------------------------------------------------+ | TLS Helpers | +----------------------------------------------------------------------------------------------------------------+

(defn- dn-for-cert
  [^X509Certificate cert]
  (.. cert getSubjectX500Principal getName))
(defn- key-type [key-string]
  (when-let [m (re-find #"^-----BEGIN (?:(\p{Alnum}+) )?PRIVATE KEY-----\n" key-string)]
    (m 1)))

Parses an RSA private key from the PEM string key-string.

(defn- parse-rsa-key
  ^PrivateKey [key-string]
  (let [algorithm (or (key-type key-string) "RSA")
        key-base64 (-> key-string
                       (str/replace #"^-----BEGIN (?:(\p{Alnum}+) )?PRIVATE KEY-----\n" "")
                       (str/replace #"\n-----END (?:(\p{Alnum}+) )?PRIVATE KEY-----\s*$" "")
                       (str/replace #"\s" ""))
        decoded (u/decode-base64-to-bytes key-base64)
        key-factory (KeyFactory/getInstance algorithm)] ; TODO support other algorithms
    (.generatePrivate key-factory (PKCS8EncodedKeySpec. decoded))))

Parses a collection of X509 certificates from the string cert-string.

(defn- parse-certificates
  [^String cert-string]
  (let [cert-factory (CertificateFactory/getInstance "X.509")
        cert-stream (ByteArrayInputStream. (.getBytes cert-string "UTF-8"))]
    (.generateCertificates cert-factory cert-stream)))

Generates a KeyStore for the identity with key parsed from key-string protected by password and the certificate parsed from cert-string .

(defn generate-identity-store
  ^KeyStore [key-string password cert-string]
  (let [private-key (parse-rsa-key key-string)
        certificates (parse-certificates cert-string)]
    (doto (KeyStore/getInstance (KeyStore/getDefaultType))
      (.load nil nil)
      (.setKeyEntry (dn-for-cert (first certificates))
                    private-key
                    (char-array password)
                    (into-array Certificate certificates)))))

Generates a KeyStore with built-in and custom certificates. The custom certificates are parsed from cert-store.

(defn generate-trust-store
  ^KeyStore [cert-string]
  (let [certs (parse-certificates cert-string)
        keystore (doto (KeyStore/getInstance (KeyStore/getDefaultType))
                   (.load nil nil))
        ;; this TrustManagerFactory is used for cloning the default certs into the new TrustManagerFactory
        base-trust-manager-factory (doto (TrustManagerFactory/getInstance (TrustManagerFactory/getDefaultAlgorithm))
                                     (.init ^KeyStore (cast KeyStore nil)))]
    (doseq [cert certs]
      (.setCertificateEntry keystore (dn-for-cert cert) cert))
    (doseq [^X509TrustManager trust-mgr (.getTrustManagers base-trust-manager-factory)]
      (when (instance? X509TrustManager trust-mgr)
        (doseq [issuer (.getAcceptedIssuers trust-mgr)]
          (.setCertificateEntry keystore (dn-for-cert issuer) issuer))))
    keystore))
(defn- key-managers [private-key password own-cert]
  (let [key-store (generate-identity-store private-key password own-cert)
        key-manager-factory (KeyManagerFactory/getInstance (KeyManagerFactory/getDefaultAlgorithm))]
    (.init key-manager-factory key-store (char-array password))
    (.getKeyManagers key-manager-factory)))
(defn- trust-managers [trust-cert]
  (let [trust-store (generate-trust-store trust-cert)
        trust-manager-factory (TrustManagerFactory/getInstance (TrustManagerFactory/getDefaultAlgorithm))]
    (.init trust-manager-factory trust-store)
    (.getTrustManagers trust-manager-factory)))

Generates an SocketFactory with the custom certificates added

(defn ssl-socket-factory
  ^SocketFactory [& {:keys [private-key own-cert trust-cert]}]
  (let [ssl-context (SSLContext/getInstance "TLS")]
    (.init ssl-context
           (when (and private-key own-cert) (key-managers private-key (str (random-uuid)) own-cert))
           (when trust-cert (trust-managers trust-cert))
           nil)
    (.getSocketFactory ssl-context)))

Set of fields that should always be obfuscated in API responses, as they contain sensitive data.

(def default-sensitive-fields
  #{:password :pass :tunnel-pass :tunnel-private-key :tunnel-private-key-passphrase :access-token :refresh-token
    :service-account-json})

Returns all sensitive fields that should be redacted in API responses for a given database. Calls get-sensitive-fields using the given database's driver, if that driver is valid and registered. Refer to get-sensitive-fields docstring for full details.

(defn sensitive-fields
  [driver]
  (if-some [conn-prop-fn (get-method driver/connection-properties driver)]
    (let [all-fields      (conn-prop-fn driver)
          password-fields (filter #(contains? #{:password :secret} (get % :type)) all-fields)]
      (into default-sensitive-fields (map (comp keyword :name) password-fields)))
    default-sensitive-fields))
 
(ns metabase.email
  (:require
   [malli.core :as mc]
   [metabase.analytics.prometheus :as prometheus]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.util.i18n :refer [deferred-tru trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [postal.core :as postal]
   [postal.support :refer [make-props]])
  (:import
   (javax.mail Session)))
(set! *warn-on-reflection* true)

https://github.com/metabase/metabase/issues/11879#issuecomment-713816386

(when-not *compile-files*
  (System/setProperty "mail.mime.splitlongparameters" "false"))

CONFIG

(defsetting email-from-address
  (deferred-tru "The email address you want to use for the sender of emails.")
  :default    "notifications@metabase.com"
  :visibility :settings-manager
  :audit      :getter)
(defsetting email-from-name
  (deferred-tru "The name you want to use for the sender of emails.")
  :visibility :settings-manager
  :audit      :getter)
(defsetting bcc-enabled?
  (deferred-tru "Whether or not bcc emails are enabled, default behavior is that it is")
  :visibility :settings-manager
  :type       :boolean
  :default    true)
(def ^:private ReplyToAddresses
  [:maybe [:sequential ms/Email]])
(def ^:private ^{:arglists '([reply-to-addresses])} validate-reply-to-addresses
  (mc/validator ReplyToAddresses))
(defsetting email-reply-to
  (deferred-tru "The email address you want the replies to go to, if different from the from address.")
  :type       :json
  :visibility :settings-manager
  :audit      :getter
  :setter     (fn [new-value]
               (if (validate-reply-to-addresses new-value)
                 (setting/set-value-of-type! :json :email-reply-to new-value)
                 (throw (ex-info "Invalid reply-to address" {:value new-value})))))
(defsetting email-smtp-host
  (deferred-tru "The address of the SMTP server that handles your emails.")
  :visibility :settings-manager
  :audit      :getter)
(defsetting email-smtp-username
  (deferred-tru "SMTP username.")
  :visibility :settings-manager
  :audit      :getter)
(defsetting email-smtp-password
  (deferred-tru "SMTP password.")
  :visibility :settings-manager
  :sensitive? true
  :audit      :getter)
(defsetting email-smtp-port
  (deferred-tru "The port your SMTP server uses for outgoing emails.")
  :type       :integer
  :visibility :settings-manager
  :audit      :getter)
(defsetting email-smtp-security
  (deferred-tru "SMTP secure connection protocol. (tls, ssl, starttls, or none)")
  :type       :keyword
  :default    :none
  :visibility :settings-manager
  :audit      :raw-value
  :setter     (fn [new-value]
                (when (some? new-value)
                  (assert (#{:tls :ssl :none :starttls} (keyword new-value))))
                (setting/set-value-of-type! :keyword :email-smtp-security new-value)))

PUBLIC INTERFACE

Internal function used to send messages. Should take 2 args - a map of SMTP credentials, and a map of email details. Provided so you can swap this out with an "inbox" for test purposes.

(def ^{:arglists '([smtp-credentials email-details])} send-email!
  postal/send-message)

Check if email is enabled and that the mandatory settings are configured.

(defsetting email-configured?
  :type       :boolean
  :visibility :public
  :setter     :none
  :getter     #(boolean (email-smtp-host))
  :doc        false)
(defn- add-ssl-settings [m ssl-setting]
  (merge
   m
   (case (keyword ssl-setting)
     :tls      {:tls true}
     :ssl      {:ssl true}
     :starttls {:starttls.enable   true
                :starttls.required true}
     {})))
(defn- smtp-settings []
  (-> {:host (email-smtp-host)
       :user (email-smtp-username)
       :pass (email-smtp-password)
       :port (email-smtp-port)}
      (add-ssl-settings (email-smtp-security))))
(def ^:private EmailMessage
  [:and
   [:map {:closed true}
    [:subject      :string]
    [:recipients   [:sequential ms/Email]]
    [:message-type [:enum :text :html :attachments]]
    [:message      [:or :string [:sequential :map]]]
    [:bcc?         {:optional true} [:maybe :boolean]]]
   [:fn {:error/message (str "Bad message-type/message combo: message-type `:attachments` should have a sequence of maps as its message; "
                             "other types should have a String message.")}
    (fn [{:keys [message-type message]}]
      (if (= message-type :attachments)
        (and (sequential? message) (every? map? message))
        (string? message)))]])

Send an email to one or more recipients. Upon success, this returns the message that was just sent. This function does not catch and swallow thrown exceptions, it will bubble up.

(mu/defn send-message-or-throw!
  {:style/indent 0}
  [{:keys [subject recipients message-type message] :as email} :- EmailMessage]
  (try
   (when-not (email-smtp-host)
     (throw (ex-info (tru "SMTP host is not set.") {:cause :smtp-host-not-set})))
   ;; Now send the email
   (let [to-type (if (:bcc? email) :bcc :to)]
     (send-email! (smtp-settings)
                  (merge
                   {:from    (if-let [from-name (email-from-name)]
                               (str from-name " <" (email-from-address) ">")
                               (email-from-address))
                    to-type  recipients
                    :subject subject
                    :body    (case message-type
                               :attachments message
                               :text        message
                               :html        [{:type    "text/html; charset=utf-8"
                                              :content message}])}
                   (when-let [reply-to (email-reply-to)]
                     {:reply-to reply-to}))))
   (catch Throwable e
     (prometheus/inc :metabase-email/message-errors)
     (throw e))
   (finally
    (prometheus/inc :metabase-email/messages))))

Schema for the response returned by various functions in [[metabase.email]]. Response will be a map with the key :metabase.email/error, which will either be nil (indicating no error) or an instance of [[java.lang.Throwable]] with the error.

(def ^:private SMTPStatus
  [:map {:closed true}
   [::error [:maybe [:fn #(instance? Throwable %)]]]])

Send an email to one or more :recipients. :recipients is a sequence of email addresses; :message-type must be either :text or :html or :attachments.

(email/send-message! :subject "[Metabase] Password Reset Request" :recipients ["cam@metabase.com"] :message-type :text :message "How are you today?")

Upon success, this returns the :message that was just sent. (TODO -- confirm this.) This function will catch and log any exception, returning a [[SMTPStatus]].

(defn send-message!
  [& {:as msg-args}]
  (try
    (send-message-or-throw! msg-args)
    (catch Throwable e
      (log/warn e (trs "Failed to send email"))
      {::error e})))
(def ^:private SMTPSettings
  [:map {:closed true}
   [:host                         ms/NonBlankString]
   [:port                         ms/PositiveInt]
   ;; TODO -- not sure which of these other ones are actually required or not, and which are optional.
   [:user        {:optional true} [:maybe :string]]
   [:security    {:optional true} [:maybe [:enum :tls :ssl :none :starttls]]]
   [:pass        {:optional true} [:maybe :string]]
   [:sender      {:optional true} [:maybe :string]]
   [:sender-name {:optional true} [:maybe :string]]
   [:reply-to    {:optional true} [:maybe [:sequential ms/Email]]]])
(mu/defn ^:private test-smtp-settings :- SMTPStatus
  "Tests an SMTP configuration by attempting to connect and authenticate if an authenticated method is passed
  in `:security`."
  [{:keys [host port user pass sender security], :as details} :- SMTPSettings]
  (try
    (let [ssl?    (= (keyword security) :ssl)
          proto   (if ssl? "smtps" "smtp")
          details (-> details
                      (assoc :proto proto
                             :connectiontimeout "1000"
                             :timeout "4000")
                      (add-ssl-settings security))
          session (doto (Session/getInstance (make-props sender details))
                    (.setDebug false))]
      (with-open [transport (.getTransport session proto)]
        (.connect transport host port user pass)))
    {::error nil}
    (catch Throwable e
      (log/error e (trs "Error testing SMTP connection"))
      {::error e})))
(def ^:private email-security-order [:tls :starttls :ssl])

Amount of time to wait between retrying SMTP connections with different security options. This delay exists to keep us from getting banned on Outlook.com.

(def ^:private ^Long retry-delay-ms
  500)
(mu/defn ^:private guess-smtp-security :- [:maybe [:enum :tls :starttls :ssl]]
  "Attempts to use each of the security methods in security order with the same set of credentials. This is used only
  when the initial connection attempt fails, so it won't overwrite a functioning configuration. If this uses something
  other than the provided method, a warning gets printed on the config page.
  If unable to connect with any security method, returns `nil`. Otherwise returns the security method that we were
  able to connect successfully with."
  [details :- SMTPSettings]
  ;; make sure this is not lazy, or chunking can cause some servers to block requests
  (some
   (fn [security-type]
     (if-not (::error (test-smtp-settings (assoc details :security security-type)))
       security-type
       (do
         (Thread/sleep retry-delay-ms) ; Try not to get banned from outlook.com
         nil)))
   email-security-order))
(mu/defn test-smtp-connection :- [:or SMTPStatus SMTPSettings]
  "Test the connection to an SMTP server to determine if we can send emails. Takes in a dictionary of properties such
  as:
    {:host     \"localhost\"
     :port     587
     :user     \"bigbird\"
     :pass     \"luckyme\"
     :sender   \"foo@mycompany.com\"
     :security :tls}
  Attempts to connect with different `:security` options. If able to connect successfully, returns working
  [[SMTPSettings]]. If unable to connect with any `:security` options, returns an [[SMTPStatus]] with the `::error`."
  [details :- SMTPSettings]
  (let [initial-attempt (test-smtp-settings details)]
    (if-not (::error initial-attempt)
      details
      (if-let [working-security-type (guess-smtp-security details)]
        (assoc details :security working-security-type)
        initial-attempt))))
 

Convenience functions for sending templated email messages. Each function here should represent a single email. NOTE: we want to keep this about email formatting, so don't put heavy logic here RE: building data for emails.

(ns metabase.email.messages
  (:require
   [buddy.core.codecs :as codecs]
   [cheshire.core :as json]
   [clojure.core.cache :as cache]
   [clojure.java.io :as io]
   [hiccup.core :refer [html]]
   [java-time.api :as t]
   [medley.core :as m]
   [metabase.config :as config]
   [metabase.db.query :as mdb.query]
   [metabase.driver :as driver]
   [metabase.driver.util :as driver.u]
   [metabase.email :as email]
   [metabase.models.collection :as collection]
   [metabase.models.permissions :as perms]
   [metabase.models.user :refer [User]]
   [metabase.public-settings :as public-settings]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.pulse.markdown :as markdown]
   [metabase.pulse.parameters :as pulse-params]
   [metabase.pulse.render :as render]
   [metabase.pulse.render.image-bundle :as image-bundle]
   [metabase.pulse.render.js-svg :as js-svg]
   [metabase.pulse.render.style :as style]
   [metabase.query-processor.store :as qp.store]
   [metabase.query-processor.streaming :as qp.streaming]
   [metabase.query-processor.streaming.interface :as qp.si]
   [metabase.query-processor.streaming.xlsx :as qp.xlsx]
   [metabase.query-processor.timezone :as qp.timezone]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date]
   [metabase.util.encryption :as encryption]
   [metabase.util.i18n :as i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.urls :as urls]
   [stencil.core :as stencil]
   [stencil.loader :as stencil-loader]
   [toucan2.core :as t2])
  (:import
   (java.io File IOException OutputStream)
   (java.time LocalTime)
   (java.time.format DateTimeFormatter)))
(set! *warn-on-reflection* true)

Return the user configured application name, or Metabase translated via tru if a name isn't configured.

(defn- app-name-trs
  []
  (or (public-settings/application-name)
      (trs "Metabase")))

Dev only -- disable template caching

(when config/is-dev?
  (alter-meta! #'stencil/render-file assoc :style/indent 1)
  (stencil-loader/set-cache (cache/ttl-cache-factory {} :ttl 0)))
(defn- logo-url []
  (let [url (public-settings/application-logo-url)]
    (cond
      (= url "app/assets/img/logo.svg") "http://static.metabase.com/email_logo.png"
      :else nil)))

NOTE: disabling whitelabeled URLs for now since some email clients don't render them correctly We need to extract them and embed as attachments like we do in metabase.pulse.render.image-bundle (data-uri-svg? url) (themed-image-url url color) :else url

Bundle an icon.

The available icons are defined in [[js-svg/icon-paths]].

(defn- icon-bundle
  [icon-name]
  (let [color     (style/primary-color)
        png-bytes (js-svg/icon icon-name color)]
    (-> (image-bundle/make-image-bundle :attachment png-bytes)
        (image-bundle/image-bundle->attachment))))
(defn- button-style [color]
  (str "display: inline-block; "
       "box-sizing: border-box; "
       "padding: 0.5rem 1.375rem; "
       "font-size: 1.063rem; "
       "font-weight: bold; "
       "text-decoration: none; "
       "cursor: pointer; "
       "color: #fff; "
       "border: 1px solid " color "; "
       "background-color: " color "; "
       "border-radius: 4px;"))

Various Context Helper Fns. Used to build Stencil template context

Context that is used across multiple email templates, and that is the same for all emails

(defn- common-context
  []
  {:applicationName           (public-settings/application-name)
   :applicationColor          (style/primary-color)
   :applicationLogoUrl        (logo-url)
   :buttonStyle               (button-style (style/primary-color))
   :colorTextLight            style/color-text-light
   :colorTextMedium           style/color-text-medium
   :colorTextDark             style/color-text-dark
   :siteUrl                   (public-settings/site-url)})

Public Interface

Send an email to invitied letting them know invitor has invited them to join Metabase.

(defn send-new-user-email!
  [invited invitor join-url sent-from-setup?]
  (let [company      (or (public-settings/site-name) "Unknown")
        message-body (stencil/render-file "metabase/email/new_user_invite"
                                          (merge (common-context)
                                                 {:emailType     "new_user_invite"
                                                  :invitedName   (or (:first_name invited) (:email invited))
                                                  :invitorName   (or (:first_name invitor) (:email invitor))
                                                  :invitorEmail  (:email invitor)
                                                  :company       company
                                                  :joinUrl       join-url
                                                  :today         (t/format "MMM'&nbsp;'dd,'&nbsp;'yyyy" (t/zoned-date-time))
                                                  :logoHeader    true
                                                  :sentFromSetup sent-from-setup?}))]
    (email/send-message!
     :subject      (str (trs "You''re invited to join {0}''s {1}" company (app-name-trs)))
     :recipients   [(:email invited)]
     :message-type :html
     :message      message-body)))

Return a sequence of email addresses for all Admin users.

The first recipient will be the site admin (or oldest admin if unset), which is the address that should be used in mailto links (e.g., for the new user to email with any questions).

(defn- all-admin-recipients
  []
  (concat (when-let [admin-email (public-settings/admin-email)]
            [admin-email])
          (t2/select-fn-set :email 'User, :is_superuser true, :is_active true, {:order-by [[:id :asc]]})))

Send an email to the invitor (the Admin who invited new-user) letting them know new-user has joined.

(defn send-user-joined-admin-notification-email!
  [new-user & {:keys [google-auth?]}]
  {:pre [(map? new-user)]}
  (let [recipients (all-admin-recipients)]
    (email/send-message!
     :subject      (str (if google-auth?
                          (trs "{0} created a {1} account" (:common_name new-user) (app-name-trs))
                          (trs "{0} accepted their {1} invite" (:common_name new-user) (app-name-trs))))
     :recipients   recipients
     :message-type :html
     :message      (stencil/render-file "metabase/email/user_joined_notification"
                                        (merge (common-context)
                                               {:logoHeader        true
                                                :joinedUserName    (or (:first_name new-user) (:email new-user))
                                                :joinedViaSSO      google-auth?
                                                :joinedUserEmail   (:email new-user)
                                                :joinedDate        (t/format "EEEE, MMMM d" (t/zoned-date-time)) ; e.g. "Wednesday, July 13". TODO - is this what we want?
                                                :adminEmail        (first recipients)
                                                :joinedUserEditUrl (str (public-settings/site-url) "/admin/people")})))))

Format and send an email informing the user how to reset their password.

(defn send-password-reset-email!
  [email sso-source password-reset-url is-active?]
  {:pre [(u/email? email)
         ((some-fn string? nil?) password-reset-url)]}
  (let [google-sso? (= "google" sso-source)
        message-body (stencil/render-file
                      "metabase/email/password_reset"
                      (merge (common-context)
                             {:emailType        "password_reset"
                              :google           google-sso?
                              :nonGoogleSSO     (and (not google-sso?) (some? sso-source))
                              :passwordResetUrl password-reset-url
                              :logoHeader       true
                              :isActive         is-active?
                              :adminEmail       (public-settings/admin-email)
                              :adminEmailSet    (boolean (public-settings/admin-email))}))]
    (email/send-message!
     :subject      (trs "[{0}] Password Reset Request" (app-name-trs))
     :recipients   [email]
     :message-type :html
     :message      message-body)))

Format and send an email informing the user that this is the first time we've seen a login from this device. Expects login history information as returned by metabase.models.login-history/human-friendly-infos.

(mu/defn send-login-from-new-device-email!
  [{user-id :user_id, :keys [timestamp], :as login-history} :- [:map [:user_id pos-int?]]]
  (let [user-info    (or (t2/select-one ['User [:first_name :first-name] :email :locale] :id user-id)
                         (throw (ex-info (tru "User {0} does not exist" user-id)
                                         {:user-id user-id, :status-code 404})))
        user-locale  (or (:locale user-info) (i18n/site-locale))
        timestamp    (u.date/format-human-readable timestamp user-locale)
        context      (merge (common-context)
                            {:first-name (:first-name user-info)
                             :device     (:device_description login-history)
                             :location   (:location login-history)
                             :timestamp  timestamp})
        message-body (stencil/render-file "metabase/email/login_from_new_device"
                                          context)]
    (email/send-message!
     :subject      (trs "We''ve Noticed a New {0} Login, {1}" (app-name-trs) (:first-name user-info))
     :recipients   [(:email user-info)]
     :message-type :html
     :message      message-body)))

Find emails for users that have an interest in monitoring the database. If oss that means admin users. If ee that also means users with monitoring and details permissions.

(defn- admin-or-ee-monitoring-details-emails
  [database-id]
  (let [monitoring (perms/application-perms-path :monitoring)
        db-details (perms/feature-perms-path :details :yes database-id)
        user-ids (when (premium-features/enable-advanced-permissions?)
                   (->> {:select   [:pgm.user_id]
                         :from     [[:permissions_group_membership :pgm]]
                         :join     [[:permissions_group :pg] [:= :pgm.group_id :pg.id]]
                         :where    [:and
                                    [:exists {:select [1]
                                              :from [[:permissions :p]]
                                              :where [:and
                                                      [:= :p.group_id :pg.id]
                                                      [:= :p.object monitoring]]}]
                                    [:exists {:select [1]
                                              :from [[:permissions :p]]
                                              :where [:and
                                                      [:= :p.group_id :pg.id]
                                                      [:= :p.object db-details]]}]]
                         :group-by [:pgm.user_id]}
                        mdb.query/query
                        (mapv :user_id)))]
    (into
      []
      (distinct)
      (concat
        (all-admin-recipients)
        (when (seq user-ids)
          (t2/select-fn-set :email User {:where [:and
                                                 [:= :is_active true]
                                                 [:in :id user-ids]]}))))))

Format and send an email informing the user about errors in the persistent model refresh task.

(defn send-persistent-model-error-email!
  [database-id persisted-infos trigger]
  {:pre [(seq persisted-infos)]}
  (let [database (:database (first persisted-infos))
        emails (admin-or-ee-monitoring-details-emails database-id)
        timezone (some-> database qp.timezone/results-timezone-id t/zone-id)
        context {:database-name (:name database)
                 :errors
                 (for [[idx persisted-info] (m/indexed persisted-infos)
                       :let [card (:card persisted-info)
                             collection (or (:collection card)
                                            (collection/root-collection-with-ui-details nil))]]
                   {:is-not-first (not= 0 idx)
                    :error (:error persisted-info)
                    :card-id (:id card)
                    :card-name (:name card)
                    :collection-name (:name collection)
                    ;; February 1, 2022, 3:10 PM
                    :last-run-at (t/format "MMMM d, yyyy, h:mm a z" (t/zoned-date-time (:refresh_begin persisted-info) timezone))
                    :last-run-trigger trigger
                    :card-url (urls/card-url (:id card))
                    :collection-url (urls/collection-url (:id collection))
                    :caching-log-details-url (urls/tools-caching-details-url (:id persisted-info))})}
        message-body (stencil/render-file "metabase/email/persisted-model-error"
                                          (merge (common-context) context))]
    (when (seq emails)
      (email/send-message!
        :subject      (trs "[{0}] Model cache refresh failed for {1}" (app-name-trs) (:name database))
        :recipients   (vec emails)
        :message-type :html
        :message      message-body))))

Format and send an email to the system admin following up on the installation.

(defn send-follow-up-email!
  [email]
  {:pre [(u/email? email)]}
  (let [context (merge (common-context)
                       {:emailType    "notification"
                        :logoHeader   true
                        :heading      (trs "We hope you''ve been enjoying Metabase.")
                        :callToAction (trs "Would you mind taking a quick 5 minute survey to tell us how it’s going?")
                        :link         "https://metabase.com/feedback/active"})
        email {:subject      (trs "[{0}] Tell us how things are going." (app-name-trs))
               :recipients   [email]
               :message-type :html
               :message      (stencil/render-file "metabase/email/follow_up_email" context)}]
    (email/send-message! email)))
(defn- make-message-attachment [[content-id url]]
  {:type         :inline
   :content-id   content-id
   :content-type "image/png"
   :content      url})
(defn- pulse-link-context
  [{:keys [cards dashboard_id]}]
  (when-let [dashboard-id (or dashboard_id
                              (some :dashboard_id cards))]
    {:pulseLink (urls/dashboard-url dashboard-id)}))

Generates hash to allow for non-users to unsubscribe from pulses/subscriptions.

(defn generate-pulse-unsubscribe-hash
  [pulse-id email]
  (codecs/bytes->hex
   (encryption/validate-and-hash-secret-key
    (json/generate-string {:salt public-settings/site-uuid-for-unsubscribing-url
                           :email email
                           :pulse-id pulse-id}))))
(defn- pulse-context [pulse dashboard non-user-email]
  (let [dashboard-id (:id dashboard)]
   (merge (common-context)
          {:emailType                 "pulse"
           :title                     (:name pulse)
           :titleUrl                  (pulse-params/dashboard-url dashboard-id (pulse-params/parameters pulse dashboard))
           :dashboardDescription      (:description dashboard)
           ;; There are legacy pulses that exist without being tied to a dashboard
           :dashboardHasTabs          (when dashboard-id
                                        (boolean (seq (t2/hydrate dashboard :tabs))))
           :creator                   (-> pulse :creator :common_name)
           :sectionStyle              (style/style (style/section-style))
           :notificationText          (if (nil? non-user-email)
                                        "Manage your subscriptions"
                                        "Unsubscribe")
           :notificationManagementUrl (if (nil? non-user-email)
                                        (urls/notification-management-url)
                                        (str (urls/unsubscribe-url)
                                             "?hash=" (generate-pulse-unsubscribe-hash (:id pulse) non-user-email)
                                             "&email=" non-user-email
                                             "&pulse-id=" (:id pulse)))}
          (pulse-link-context pulse))))

Separate from create-temp-file-or-throw primarily so that we can simulate exceptions in tests

(defn- create-temp-file
  [suffix]
  (doto (File/createTempFile "metabase_attachment" suffix)
    .deleteOnExit))

Tries to create a temp file, will give the users a better error message if we are unable to create the temp file

(defn- create-temp-file-or-throw
  [suffix]
  (try
    (create-temp-file suffix)
    (catch IOException e
      (let [ex-msg (tru "Unable to create temp file in `{0}` for email attachments "
                        (System/getProperty "java.io.tmpdir"))]
        (throw (IOException. ex-msg e))))))
(defn- create-result-attachment-map [export-type card-name ^File attachment-file]
  (let [{:keys [content-type]} (qp.si/stream-options export-type)]
    {:type         :attachment
     :content-type content-type
     :file-name    (format "%s.%s" card-name (name export-type))
     :content      (-> attachment-file .toURI .toURL)
     :description  (format "More results for '%s'" card-name)}))

For legacy compatibility. Takes QP results in the normal :api response format and streams them to a different format.

TODO -- this function is provided mainly because rewriting all the Pulse/Alert code to stream results directly was a lot of work. I intend to rework that code so we can stream directly to the correct export format(s) at some point in the future; for now, this function is a stopgap.

Results are streamed synchronously. Caller is responsible for closing os when this call is complete.

(defn- stream-api-results-to-export-format
  [export-format ^OutputStream os {{:keys [rows]} :data, database-id :database_id, :as results}]
  ;; make sure Database/driver info is available for the streaming results writers -- they might need this in order to
  ;; get timezone information when writing results
  (driver/with-driver (driver.u/database->driver database-id)
    (qp.store/with-metadata-provider database-id
      (binding [qp.xlsx/*parse-temporal-string-values* true]
        (let [w                           (qp.si/streaming-results-writer export-format os)
              cols                        (-> results :data :cols)
              viz-settings                (-> results :data :viz-settings)
              [ordered-cols output-order] (qp.streaming/order-cols cols viz-settings)
              viz-settings'               (assoc viz-settings :output-order output-order)]
          (qp.si/begin! w
                        (assoc-in results [:data :ordered-cols] ordered-cols)
                        viz-settings')
          (dorun
           (map-indexed
            (fn [i row]
              (qp.si/write-row! w row i ordered-cols viz-settings'))
            rows))
          (qp.si/finish! w results))))))
(defn- result-attachment
  [{{card-name :name :as card} :card {{:keys [rows]} :data :as result} :result}]
  (when (seq rows)
    [(when-let [temp-file (and (:include_csv card)
                               (create-temp-file-or-throw "csv"))]
       (with-open [os (io/output-stream temp-file)]
         (stream-api-results-to-export-format :csv os result))
       (create-result-attachment-map "csv" card-name temp-file))
     (when-let [temp-file (and (:include_xls card)
                               (create-temp-file-or-throw "xlsx"))]
       (with-open [os (io/output-stream temp-file)]
         (stream-api-results-to-export-format :xlsx os result))
       (create-result-attachment-map "xlsx" card-name temp-file))]))
(defn- part-attachments [parts]
  (filter some? (mapcat result-attachment parts)))
(defn- render-part
  [timezone part]
  (case (:type part)
    :card
    (render/render-pulse-section timezone part)
    :text
    {:content (markdown/process-markdown (:text part) :html)}
    :tab-title
    {:content (markdown/process-markdown (format "# %s\n---" (:text part)) :html)}))
(defn- render-filters
  [notification dashboard]
  (let [filters (pulse-params/parameters notification dashboard)
        cells   (map
                 (fn [filter]
                   [:td {:class "filter-cell"
                         :style (style/style {:width "50%"
                                              :padding "0px"
                                              :vertical-align "baseline"})}
                    [:table {:cellpadding "0"
                             :cellspacing "0"
                             :width "100%"
                             :height "100%"}
                     [:tr
                      [:td
                       {:style (style/style {:color style/color-text-medium
                                             :min-width "100px"
                                             :width "50%"
                                             :padding "4px 4px 4px 0"
                                             :vertical-align "baseline"})}
                       (:name filter)]
                      [:td
                       {:style (style/style {:color style/color-text-dark
                                             :min-width "100px"
                                             :width "50%"
                                             :padding "4px 16px 4px 8px"
                                             :vertical-align "baseline"})}
                       (pulse-params/value-string filter)]]]])
                 filters)
        rows    (partition 2 2 nil cells)]
    (html
     [:table {:style (style/style {:table-layout :fixed
                                   :border-collapse :collapse
                                   :cellpadding "0"
                                   :cellspacing "0"
                                   :width "100%"
                                   :font-size  "12px"
                                   :font-weight 700
                                   :margin-top "8px"})}
      (for [row rows]
        [:tr {} row])])))
(defn- render-message-body
  [notification message-type message-context timezone dashboard parts]
  (let [rendered-cards  (binding [render/*include-title* true]
                          (mapv #(render-part timezone %) parts))
        icon-name       (case message-type
                          :alert :bell
                          :pulse :dashboard)
        icon-attachment (first (map make-message-attachment (icon-bundle icon-name)))
        filters         (when dashboard
                          (render-filters notification dashboard))
        message-body    (assoc message-context :pulse (html (vec (cons :div (map :content rendered-cards))))
                               :filters filters
                               :iconCid (:content-id icon-attachment))
        attachments     (apply merge (map :attachments rendered-cards))]
    (vec (concat [{:type "text/html; charset=utf-8" :content (stencil/render-file "metabase/email/pulse" message-body)}]
                 (map make-message-attachment attachments)
                 [icon-attachment]
                 (part-attachments parts)))))
(defn- assoc-attachment-booleans [pulse results]
  (for [{{result-card-id :id} :card :as result} results
        :let [pulse-card (m/find-first #(= (:id %) result-card-id) (:cards pulse))]]
    (if result-card-id
      (update result :card merge (select-keys pulse-card [:include_csv :include_xls]))
      result)))

Take a pulse object and list of results, returns an array of attachment objects for an email

(defn render-pulse-email
  [timezone pulse dashboard parts non-user-email]
  (render-message-body pulse
                       :pulse
                       (pulse-context pulse dashboard non-user-email)
                       timezone
                       dashboard
                       (assoc-attachment-booleans pulse parts)))

Given an alert return a keyword representing what kind of goal needs to be met.

(defn pulse->alert-condition-kwd
  [{:keys [alert_above_goal alert_condition] :as _alert}]
  (if (= "goal" alert_condition)
    (if (true? alert_above_goal)
      :meets
      :below)
    :rows))

Alerts only have a single card, so the alerts API accepts a :card key, while pulses have :cards. Depending on whether the data comes from the alert API or pulse tasks, the card could be under :card or :cards

(defn- first-card
  [alert]
  (or (:card alert)
      (first (:cards alert))))

Template context that is applicable to all alert templates, including alert management templates (e.g. the subscribed/unsubscribed emails)

(defn- common-alert-context
  ([alert]
   (common-alert-context alert nil))
  ([alert alert-condition-map]
   (let [{card-id :id, card-name :name} (first-card alert)]
     (merge (common-context)
            {:emailType                 "alert"
             :questionName              card-name
             :questionURL               (urls/card-url card-id)
             :sectionStyle              (style/section-style)}
            (when alert-condition-map
              {:alertCondition (get alert-condition-map (pulse->alert-condition-kwd alert))})))))
(defn- schedule-hour-text
  [{hour :schedule_hour}]
  (.format (LocalTime/of hour 0)
           (DateTimeFormatter/ofPattern "h a")))
(defn- schedule-day-text
  [{day :schedule_day}]
  (get {"sun" "Sunday"
        "mon" "Monday"
        "tue" "Tuesday"
        "wed" "Wednesday"
        "thu" "Thursday"
        "fri" "Friday"
        "sat" "Saturday"}
       day))
(defn- schedule-timezone
  []
  (or (driver/report-timezone) "UTC"))

Returns a string that describes the run schedule of an alert (i.e. how often results are checked), for inclusion in the email template. Not translated, since emails in general are not currently translated.

(defn- alert-schedule-text
  [channel]
  (case (:schedule_type channel)
    :hourly
    "Run hourly"
    :daily
    (format "Run daily at %s %s"
            (schedule-hour-text channel)
            (schedule-timezone))
    :weekly
    (format "Run weekly on %s at %s %s"
            (schedule-day-text channel)
            (schedule-hour-text channel)
            (schedule-timezone))))

Context that is applicable only to the actual alert template (not alert management templates)

(defn- alert-context
  [alert channel non-user-email]
  (let [{card-id :id, card-name :name} (first-card alert)]
    {:title                     card-name
     :titleUrl                  (urls/card-url card-id)
     :alertSchedule             (alert-schedule-text channel)
     :notificationManagementUrl (if (nil? non-user-email)
                                  (urls/notification-management-url)
                                  (str (urls/unsubscribe-url)
                                       "?hash=" (generate-pulse-unsubscribe-hash (:id alert) non-user-email)
                                       "&email=" non-user-email
                                       "&pulse-id=" (:id alert)))
     :creator                   (-> alert :creator :common_name)}))
(defn- alert-results-condition-text [goal-value]
  {:meets (format "This question has reached its goal of %s." goal-value)
   :below (format "This question has gone below its goal of %s." goal-value)})

Take a pulse object and list of results, returns an array of attachment objects for an email

(defn render-alert-email
  [timezone {:keys [alert_first_only] :as alert} channel results goal-value non-user-email]
  (let [message-ctx  (merge
                      (common-alert-context alert (alert-results-condition-text goal-value))
                      (alert-context alert channel non-user-email))]
    (render-message-body alert
                         :alert
                         (assoc message-ctx :firstRunOnly? alert_first_only)
                         timezone
                         nil
                         (assoc-attachment-booleans alert results))))
(def ^:private alert-condition-text
  {:meets "when this question meets its goal"
   :below "when this question goes below its goal"
   :rows  "whenever this question has any results"})

Sends an email on a background thread, returning a future.

(defn- send-email!
  [user subject template-path template-context]
  (future
    (try
      (email/send-message-or-throw!
       {:recipients   [(:email user)]
        :message-type :html
        :subject      subject
        :message      (stencil/render-file template-path template-context)})
      (catch Exception e
        (log/errorf e "Failed to send message to '%s' with subject '%s'" (:email user) subject)))))
(defn- template-path [template-name]
  (str "metabase/email/" template-name ".mustache"))

Paths to the templates for all of the alerts emails

(def ^:private new-alert-template          (template-path "alert_new_confirmation"))
(def ^:private you-unsubscribed-template   (template-path "alert_unsubscribed"))
(def ^:private admin-unsubscribed-template (template-path "alert_admin_unsubscribed_you"))
(def ^:private added-template              (template-path "alert_you_were_added"))
(def ^:private stopped-template            (template-path "alert_stopped_working"))
(def ^:private archived-template           (template-path "alert_archived"))

Send out the initial 'new alert' email to the creator of the alert

(defn send-new-alert-email!
  [{:keys [creator] :as alert}]
  (send-email! creator "You set up an alert" new-alert-template
               (common-alert-context alert alert-condition-text)))

Send an email to who-unsubscribed letting them know they've unsubscribed themselves from alert

(defn send-you-unsubscribed-alert-email!
  [alert who-unsubscribed]
  (send-email! who-unsubscribed "You unsubscribed from an alert" you-unsubscribed-template
               (common-alert-context alert)))

Send an email to user-added letting them know admin has unsubscribed them from alert

(defn send-admin-unsubscribed-alert-email!
  [alert user-added {:keys [first_name last_name] :as _admin}]
  (let [admin-name (format "%s %s" first_name last_name)]
    (send-email! user-added "You’ve been unsubscribed from an alert" admin-unsubscribed-template
                 (assoc (common-alert-context alert) :adminName admin-name))))

Send an email to user-added letting them know admin-adder has added them to alert

(defn send-you-were-added-alert-email!
  [alert user-added {:keys [first_name last_name] :as _admin-adder}]
  (let [subject (format "%s %s added you to an alert" first_name last_name)]
    (send-email! user-added subject added-template (common-alert-context alert alert-condition-text))))
(def ^:private not-working-subject "One of your alerts has stopped working")

Email to notify users when a card associated to their alert has been archived

Email to notify users when a card associated to their alert changed in a way that invalidates their alert

(defn send-alert-stopped-because-archived-email!
  [alert user {:keys [first_name last_name] :as _archiver}]
  (let [{card-id :id card-name :name} (first-card alert)]
    (send-email! user not-working-subject archived-template {:archiveURL   (urls/archive-url)
                                                             :questionName (format "%s (#%d)" card-name card-id)
                                                             :archiverName (format "%s %s" first_name last_name)})))
(defn send-alert-stopped-because-changed-email!
  [alert user {:keys [first_name last_name] :as _archiver}]
  (let [edited-text (format "the question was edited by %s %s" first_name last_name)]
    (send-email! user not-working-subject stopped-template (assoc (common-alert-context alert) :deletionCause edited-text))))

Email all admins when a Slack API call fails due to a revoked token or other auth error

(defn send-slack-token-error-emails!
  []
  (email/send-message!
   :subject (trs "Your Slack connection stopped working")
   :recipients (all-admin-recipients)
   :message-type :html
   :message (stencil/render-file "metabase/email/slack_token_error.mustache"
                                 (merge (common-context)
                                        {:logoHeader  true
                                         :settingsUrl (str (public-settings/site-url) "/admin/settings/slack")}))))
 

Settings related to embedding Metabase in other applications.

(ns metabase.embed.settings
  (:require
   [metabase.analytics.snowplow :as snowplow]
   [metabase.api.common :as api]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.public-settings :as public-settings]
   [metabase.util.i18n :as i18n :refer [deferred-tru]]
   [toucan2.core :as t2]))
(defsetting embedding-app-origin
  (deferred-tru "Allow this origin to embed the full {0} application"
                (public-settings/application-name-for-setting-descriptions))
  :feature    :embedding
  :visibility :public
  :audit      :getter)
(defsetting enable-embedding
  (deferred-tru "Allow admins to securely embed questions and dashboards within other applications?")
  :type       :boolean
  :default    false
  :visibility :authenticated
  :audit      :getter
  :setter     (fn [new-value]
                (when (not= new-value (setting/get-value-of-type :boolean :enable-embedding))
                  (setting/set-value-of-type! :boolean :enable-embedding new-value)
                  (let [snowplow-payload {:embedding-app-origin-set   (boolean (embedding-app-origin))
                                          :number-embedded-questions  (t2/count :model/Card :enable_embedding true)
                                          :number-embedded-dashboards (t2/count :model/Dashboard :enable_embedding true)}]
                    (if new-value
                      (snowplow/track-event! ::snowplow/embedding-enabled api/*current-user-id* snowplow-payload)
                      (snowplow/track-event! ::snowplow/embedding-disabled api/*current-user-id* snowplow-payload))))))
 

Provides a very simple Emacs Lisp hook-style events system using Methodical. See https://github.com/metabase/metabase/issues/19812 for more information.

Publish an event, which consists of a [[Topic]] keyword and an event map using [[publish-event!]], 'subscribe' to events by writing method implementations of [[publish-event!]].

On launch, all namespaces starting with metabase.events.* will get loaded automatically by [[initialize-events!]].

(ns metabase.events
  (:require
   [clojure.spec.alpha :as s]
   [metabase.events.schema :as events.schema]
   [metabase.models.interface :as mi]
   [metabase.plugins.classloader :as classloader]
   [metabase.util :as u]
   [metabase.util.i18n :as i18n]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.methodical.null-cache :as u.methodical.null-cache]
   [metabase.util.methodical.unsorted-dispatcher
    :as u.methodical.unsorted-dispatcher]
   [methodical.core :as methodical]
   [steffan-westcott.clj-otel.api.trace.span :as span]))
(set! *warn-on-reflection* true)

Malli schema for an event topic keyword.

(def Topic
  [:and
   qualified-keyword?
   [:fn
    {:error/message "Events should derive from :metabase/event"}
    #(isa? % :metabase/event)]])
(defonce ^:private events-initialized?
  (atom nil))

Look for namespaces that start with metabase.events., and call their events-init function if it exists.

(defn- find-and-load-event-handlers!
  []
  (doseq [ns-symb u/metabase-namespace-symbols
          :when   (.startsWith (name ns-symb) "metabase.events.")]
    (log/info (i18n/trs "Loading events namespace:") (u/format-color 'blue ns-symb) (u/emoji "👂"))
    (classloader/require ns-symb)))

Initialize the asynchronous internal events system.

(defn- initialize-events!
  []
  (when-not @events-initialized?
    (locking events-initialized?
      (when-not @events-initialized?
        (find-and-load-event-handlers!)
        (reset! events-initialized? true)))))
(s/def ::publish-event-dispatch-value
  (s/and
   (some-fn qualified-keyword? #(= % :default))
   #(not= (namespace %) "event")))

'Publish' an event by calling [[publish-event!]] with a [[Topic]] and an event map, whose contents vary based on their topic. These calls return the original event object passed in, to support chaining.

(events/publish-event! :event/database-create {:object database :user-id api/current-user-id})

'Subscribe' to an event by add a Methodical method implementation. Since this uses the [[methodical/do-method-combination]], all multiple method implementations can be called for a single invocation. The order is indeterminate, but return value is ignored.

Don't write method implementations for the event names themselves, e.g. :event/database-create, because these will stomp on other methods with the same key:

;; bad! If someone else writes a method for :event/database-create, it will stomp on this (methodical/defmethod events/publish-event! :event/database-create [topic event] ...)

Instead, derive the event from another key, and write a method for that

;; Good (derive :event/database-create ::events) (methodical/defmethod events/publish-event! ::events [topic event] ...)

The schema for each event topic are defined in metabase.events.schema, makes sure to keep it up-to-date if you're working on a new event topic or updating an existing one.

(methodical/defmulti publish-event!
  {:arglists            '([topic event])
   :defmethod-arities   #{2}
   :dispatch-value-spec ::publish-event-dispatch-value}
  :combo
  (methodical/do-method-combination)
  ;; work around https://github.com/camsaul/methodical/issues/97
  :dispatcher
  (u.methodical.unsorted-dispatcher/unsorted-dispatcher
   (fn dispatch-fn [topic _event]
     (keyword topic)))
  ;; work around https://github.com/camsaul/methodical/issues/98
  :cache
  (u.methodical.null-cache/null-cache))
(methodical/defmethod publish-event! :default
  [_topic _event]
  nil)
(methodical/defmethod publish-event! :around :default
  [topic event]
  (span/with-span!
    {:name       "publish-event!"
     :attributes {:event/topic topic
                  :events/initialized (some? @events-initialized?)}}
    (assert (not *compile-files*) "Calls to publish-event! are not allowed in the top level.")
    (if-not @events-initialized?
      ;; if the event namespaces aren't initialized yet, make sure they're all loaded up before trying to do dispatch.
      (do
        (initialize-events!)
        (publish-event! topic event))
      (do
        (span/with-span!
          {:name       "publish-event!.logging"
           :attributes {}}
          (let [{:keys [object]} event]
            (log/debugf "Publishing %s event (name and id):\n\n%s"
                       (u/colorize :yellow (pr-str topic))
                       (u/pprint-to-str (let [model (mi/model object)]
                                          (cond-> (select-keys object [:name :id])
                                            model
                                            (assoc :model model))))))
          (assert (and (qualified-keyword? topic)
                       (isa? topic :metabase/event))
                  (format "Invalid event topic %s: events must derive from :metabase/event" (pr-str topic)))
          (assert (map? event)
                  (format "Invalid event %s: event must be a map." (pr-str event))))
        (try
          (when-let [schema (events.schema/topic->schema topic)]
            (mu/validate-throw schema event))
          (span/with-span!
            {:name       "publish-event!.next-method"
             :attributes {}}
            (next-method topic event))
          (catch Throwable e
            (throw (ex-info (i18n/tru "Error publishing {0} event: {1}" topic (ex-message e))
                            {:topic topic, :event event}
                            e))))
        event))))

Determine metadata, if there is any, for given object. Expand the object when we need more metadata.

(defn object->metadata
  [object]
  {:cached       (:cached object)
   :ignore_cache (:ignore_cache object)
   ;; the :context key comes from qp middleware:
   ;; [[metabase.query-processor.middleware.process-userland-query/add-and-save-execution-info-xform!]]
   ;; and is important for distinguishing view events triggered when pinned cards are 'viewed'
   ;; when a user opens a collection.
   :context      (:context object)})
 

This namespace is responsible for publishing events to the audit log.

(ns metabase.events.audit-log
  (:require
   [metabase.events :as events]
   [metabase.models.audit-log :as audit-log]
   [metabase.util :as u]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))
(derive ::event :metabase/event)
(derive ::card-event ::event)
(derive :event/card-create ::card-event)
(derive :event/card-update ::card-event)
(derive :event/card-delete ::card-event)
(methodical/defmethod events/publish-event! ::card-event
  [topic event]
  (audit-log/record-event! topic event))
(derive ::dashboard-event ::event)
(derive :event/dashboard-create ::dashboard-event)
(derive :event/dashboard-delete ::dashboard-event)
(methodical/defmethod events/publish-event! ::dashboard-event
  [topic event]
  (audit-log/record-event! topic event))
(derive ::dashboard-card-event ::event)
(derive :event/dashboard-add-cards ::dashboard-card-event)
(derive :event/dashboard-remove-cards ::dashboard-card-event)
(methodical/defmethod events/publish-event! ::dashboard-card-event
  [topic {:keys [object dashcards user-id] :as _event}]
  ;; we expect that the object has just a dashboard :id at the top level
  ;; plus a `:dashcards` attribute which is a vector of the cards added/removed
  (let [cards   (when (seq dashcards)
                  (t2/select-fn->fn :id #(select-keys % [:name :description])
                                    :model/Card
                                    :id [:in (map :card_id dashcards)]))
        details (-> (select-keys object [:description :name :id])
                    (assoc :dashcards (for [{:keys [id card_id]} dashcards]
                                        (-> (cards card_id)
                                            (assoc :id id)
                                            (assoc :card_id card_id)))))]
    (audit-log/record-event! topic
                             {:details  details
                              :user-id  user-id
                              :model    :model/Dashboard
                              :model-id (u/id object)})))
(derive ::table-event ::event)
(derive :event/table-manual-scan ::table-event)
(methodical/defmethod events/publish-event! ::table-event
  [topic event]
  (audit-log/record-event! topic event))
(derive ::metric-event ::event)
(derive :event/metric-create ::metric-event)
(derive :event/metric-update ::metric-event)
(derive :event/metric-delete ::metric-event)
(methodical/defmethod events/publish-event! ::metric-event
  [topic {:keys [object user-id revision-message] :as _event}]
  (audit-log/record-event! topic {:object  object
                                  :user-id user-id
                                  :details (when revision-message {:revision-message revision-message})}))
(derive ::pulse-event ::event)
(derive :event/pulse-create ::pulse-event)
(derive :event/pulse-delete ::pulse-event)
(derive :event/subscription-unsubscribe ::pulse-event)
(derive :event/subscription-unsubscribe-undo ::pulse-event)
(derive :event/alert-unsubscribe ::pulse-event)
(derive :event/subscription-create ::pulse-event)
(derive :event/subscription-update ::pulse-event)
(derive :event/subscription-send ::pulse-event)
(derive :event/alert-send ::pulse-event)
(defn- create-details-map [pulse name is-alert parent]
  (let [channels  (:channels pulse)
        parent-id (if is-alert :card_id :dashboard_id)]
    {:archived   (:archived pulse)
     :name       name
     parent-id   parent
     :parameters (:parameters pulse)
     :channel    (map :channel_type channels)
     :schedule   (map :schedule_type channels)
     :recipients (map :recipients channels)}))
(methodical/defmethod events/publish-event! ::pulse-event
  [topic {:keys [id object user-id] :as _event}]
  ;; Check if object contains the keys that we want populated, if not then may be a unsubscribe/send event
  (let [details-map (if (some? (:id object))
                      (create-details-map object (:name object) false (:dashboard_id object))
                      object)
        model-id    (or id (:id object))]
    (audit-log/record-event! topic
                             {:details  details-map
                              :user-id  user-id
                              :model    :model/Pulse
                              :model-id model-id})))
(derive ::alert-event ::event)
(derive :event/alert-create ::alert-event)
(derive :event/alert-delete ::alert-event)
(derive :event/alert-update ::alert-event)
(methodical/defmethod events/publish-event! ::alert-event
  [topic {:keys [object user-id] :as _event}]
  (let [card      (:card object)
        card-name (:name card)]
    ;; Alerts are centered around a card/question. Users always interact with the alert via the question
    (audit-log/record-event! topic
                             {:details  (create-details-map object card-name true (:id card))
                              :user-id  user-id
                              :model    :model/Card
                              :model-id (:id object)})))
(derive ::segment-event ::event)
(derive :event/segment-create ::segment-event)
(derive :event/segment-update ::segment-event)
(derive :event/segment-delete ::segment-event)
(methodical/defmethod events/publish-event! ::segment-event
  [topic {:keys [object user-id revision-message] :as _event}]
  (audit-log/record-event! topic {:object  object
                                  :user-id user-id
                                  :details (when revision-message {:revision-message revision-message})}))
(derive ::user-event ::event)
(derive :event/user-invited ::user-event)
(derive :event/user-deactivated ::user-event)
(derive :event/user-reactivated ::user-event)
(derive :event/password-reset-initiated ::user-event)
(derive :event/password-reset-successful ::user-event)
(methodical/defmethod events/publish-event! ::user-event
  [topic event]
  (audit-log/record-event! topic event))
(derive ::user-update-event ::event)
(derive :event/user-update ::user-update-event)
(methodical/defmethod events/publish-event! ::user-update-event
  [topic event]
  (audit-log/record-event! topic event))
(derive ::user-joined-event ::event)
(derive :event/user-joined ::user-joined-event)
(methodical/defmethod events/publish-event! ::user-joined-event
  [topic {:keys [user-id]}]
  (audit-log/record-event! topic
                           {:user-id  user-id
                            :model    :model/User
                            :model-id user-id}))
(derive ::install-event ::event)
(derive :event/install ::install-event)
(methodical/defmethod events/publish-event! ::install-event
  [topic _event]
  (when-not (t2/exists? :model/AuditLog :topic "install")
    (audit-log/record-event! topic {})))
(derive ::database-event ::event)
(derive :event/database-create ::database-event)
(derive :event/database-delete ::database-event)
(derive :event/database-manual-sync ::database-event)
(derive :event/database-manual-scan ::database-event)
(derive :event/database-discard-field-values ::database-event)
(methodical/defmethod events/publish-event! ::database-event
  [topic event]
  (audit-log/record-event! topic event))
(derive ::database-update-event ::event)
(derive :event/database-update ::database-update-event)
(methodical/defmethod events/publish-event! ::database-update-event
  [topic event]
  (audit-log/record-event! topic event))
(derive ::permission-failure-event ::event)
(derive :event/write-permission-failure ::permission-failure-event)
(derive :event/update-permission-failure ::permission-failure-event)
(derive :event/create-permission-failure ::permission-failure-event)
(methodical/defmethod events/publish-event! ::permission-failure-event
  [topic event]
  (audit-log/record-event! topic event))
(derive ::settings-changed-event ::event)
(derive :event/setting-update ::settings-changed-event)
(methodical/defmethod events/publish-event! ::settings-changed-event
  [topic event]
  (audit-log/record-event! topic event))
(derive ::api-key-event ::event)
(derive :event/api-key-create ::api-key-event)
(derive :event/api-key-update ::api-key-event)
(derive :event/api-key-regenerate ::api-key-event)
(derive :event/api-key-delete ::api-key-event)
(methodical/defmethod events/publish-event! ::api-key-event
  [topic event]
  (audit-log/record-event! topic event))
 

Driver notifications are used to let drivers know database details or other relevant information has changed (:database-update) or that a Database has been deleted (:database-delete). Drivers can choose to be notified of these events by implementing the metabase.driver/notify-database-updated multimethod. At the time of this writing, the SQL JDBC driver 'superclass' is the only thing that implements this method, and does so to close connection pools when database details change or when they are deleted.

(ns metabase.events.driver-notifications
  (:require
   [medley.core :as m]
   [metabase.driver :as driver]
   [metabase.events :as events]
   [metabase.util.log :as log]
   [methodical.core :as methodical]))
(derive ::event :metabase/event)
(derive :event/database-update ::event)
(derive :event/database-delete ::event)
(methodical/defmethod events/publish-event! ::event
  [topic {database :object, previous-database :previous-object :as _event}]
  ;; try/catch here to prevent individual topic processing exceptions from bubbling up.  better to handle them here.
  (try
    ;; notify the appropriate driver about the updated database to release any related resources, such as connections.
    ;; avoid notifying if the changes shouldn't impact the observable behaviour of any resource, otherwise drivers might
    ;; close connections or other resources unnecessarily (metabase#27877).
    (let [;; remove data that should not impact the observable state of any resource before comparing
          remove-irrelevant-data (fn [db]
                                   (reduce m/dissoc-in db [[:updated_at]
                                                           [:settings :database-enable-actions]]))]
      (when (not= (remove-irrelevant-data database)
                  (remove-irrelevant-data previous-database))
        (driver/notify-database-updated (:engine database) database)))
    (catch Throwable e
      (log/warnf e "Failed to process driver notifications event. %s" topic))))
 
(ns metabase.events.last-login
  (:require
   [metabase.events :as events]
   [metabase.models.user :refer [User]]
   [metabase.util.log :as log]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))
(derive ::event :metabase/event)
(derive :event/user-login ::event)
(methodical/defmethod events/publish-event! ::event
  [topic {:keys [user-id] :as _event}]
  ;; try/catch here to prevent individual topic processing exceptions from bubbling up.  better to handle them here.
  (when user-id
    (try
      ;; just make a simple attempt to set the `:last_login` for the given user to now
      (t2/update! User user-id {:last_login :%now})
      (catch Throwable e
        (log/warnf e "Failed to process sync-database event. %s" topic)))))
 
(ns metabase.events.persisted-info
  (:require
   [metabase.events :as events]
   [metabase.models :refer [Database PersistedInfo]]
   [metabase.models.persisted-info :as persisted-info]
   [metabase.public-settings :as public-settings]
   [metabase.util.log :as log]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))
(derive ::event :metabase/event)
(derive :event/card-create ::event)
(derive :event/card-update ::event)
(methodical/defmethod events/publish-event! ::event
  [topic {card :object :keys [user-id] :as _event}]
  ;; try/catch here to prevent individual topic processing exceptions from bubbling up.  better to handle them here.
  (try
   ;; We only want to add a persisted-info for newly created models where dataset is being set to true.
   ;; If there is already a PersistedInfo, even in "off" or "deletable" state, we skip it as this
   ;; is only supposed to be that initial edge when the dataset is being changed.
   (when (and (:dataset card)
              (public-settings/persisted-models-enabled)
              (get-in (t2/select-one Database :id (:database_id card)) [:settings :persist-models-enabled])
              (nil? (t2/select-one-fn :id PersistedInfo :card_id (:id card))))
     (persisted-info/turn-on-model! user-id card))
   (catch Throwable e
     (log/warnf e "Failed to process persisted-info event. %s" topic))))
 

This namespace is responsible for subscribing to events which should update the recent views for a user.

(ns metabase.events.recent-views
  (:require
   [metabase.api.common :as api]
   [metabase.events :as events]
   [metabase.models.audit-log :as audit-log]
   [metabase.models.recent-views :as recent-views]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [methodical.core :as m]
   [steffan-westcott.clj-otel.api.trace.span :as span]))
(derive ::event :metabase/event)
(derive :event/dashboard-read ::event)
(derive :event/table-read ::event)
(m/defmethod events/publish-event! ::event
  "Handle processing for a single event notification which should update the recent views for a user."
  [topic {:keys [object user-id] :as _event}]
  (span/with-span!
    {:name (str "recent-views-" (name topic))
     :topic topic
     :user-id user-id}
    (try
      (when object
        (let [model    (audit-log/model-name object)
              model-id (u/id object)
              user-id  (or user-id api/*current-user-id*)]
          (recent-views/update-users-recent-views! user-id model model-id)))
      (catch Throwable e
        (log/warnf e "Failed to process recent_views event: %s" topic)))))
(derive ::card-query-event :metabase/event)
(derive :event/card-query ::card-query-event)
(m/defmethod events/publish-event! ::card-query-event
  "Handle processing for a single card query event."
  [topic {:keys [card-id user-id context] :as _event}]
  (span/with-span!
    {:name (str "recent-views-" (name topic))
     :topic topic
     :card-id card-id
     :user-id user-id}
    (try
      (let [model    "card"
            user-id  (or user-id api/*current-user-id*)]
        ;; we don't want to count pinned card views
        (when-not (#{:collection :dashboard} context)
          (recent-views/update-users-recent-views! user-id model card-id)))
      (catch Throwable e
        (log/warnf e "Failed to process recent_views event: %s" topic)))))
 
(ns metabase.events.revision
  (:require
   [metabase.api.common :as api]
   [metabase.events :as events]
   [metabase.models.revision :as revision]
   [metabase.util.log :as log]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))
(derive ::event :metabase/event)
(defn- push-revision!
  [model
   {:keys [user-id] object :object :as event}
   {:keys [is-creation?]
    :or   {is-creation? false}
    :as   _options}]
  (when event
    (try
     (when-not (t2/instance-of? model object)
       (throw (ex-info "object must be a model instance" {:object object :model model})))
     (let [user-id (or user-id api/*current-user-id*)]
       (revision/push-revision! {:entity       model
                                 :id           (:id object)
                                 :object       object
                                 :user-id      user-id
                                 :is-creation? is-creation?
                                 :message      (:revision-message event)}))
     (catch Throwable e
       (log/warnf e "Failed to process revision event for model %s" model)))))
(derive ::card-event ::event)
(derive :event/card-create ::card-event)
(derive :event/card-update ::card-event)
(methodical/defmethod events/publish-event! ::card-event
  [topic event]
  (push-revision! :model/Card event {:is-creation? (= topic :event/card-create)}))
(derive ::dashboard-event ::event)
(derive :event/dashboard-create ::dashboard-event)
(derive :event/dashboard-update ::dashboard-event)
(methodical/defmethod events/publish-event! ::dashboard-event
  [topic event]
  (push-revision! :model/Dashboard event {:is-creation? (= topic :event/dashboard-create)}))
(derive ::metric-event ::event)
(derive :event/metric-create ::metric-event)
(derive :event/metric-update ::metric-event)
(derive :event/metric-delete ::metric-event)
(methodical/defmethod events/publish-event! ::metric-event
  [topic event]
  (push-revision! :model/Metric event {:is-creation? (= topic :event/metric-create)}))
(derive ::segment-event ::event)
(derive :event/segment-create ::segment-event)
(derive :event/segment-update ::segment-event)
(derive :event/segment-delete ::segment-event)
(methodical/defmethod events/publish-event! ::segment-event
  [topic event]
  (push-revision! :model/Segment event {:is-creation? (= topic :event/segment-create)}))
 
(ns metabase.events.schema
  (:require
   [malli.core :as mc]
   [malli.util :as mut]
   [toucan2.core :as t2]))

dashboard events

(let [default-schema (mc/schema
                      [:map {:closed true}
                       [:user-id pos-int?]
                       [:object [:fn #(t2/instance-of? :model/Dashboard %)]]])
      view-only      (mc/schema
                      [:map {:closed true}
                       [:user-id [:maybe pos-int?]]
                       [:object [:fn #(t2/instance-of? :model/Dashboard %)]]])
      with-dashcards (mut/assoc default-schema
                                :dashcards [:sequential [:map [:id pos-int?]]])]
  (def ^:private dashboard-events-schemas
    {:event/dashboard-read             view-only
     :event/dashboard-create           default-schema
     :event/dashboard-update           default-schema
     :event/dashboard-delete           default-schema
     :event/dashboard-remove-cards     with-dashcards
     :event/dashboard-add-cards        with-dashcards}))

card events

(let [default-schema (mc/schema
                      [:map {:closed true}
                       [:user-id  pos-int?]
                       [:object   [:fn #(t2/instance-of? :model/Card %)]]])]
  (def ^:private card-events-schemas
    {:event/card-create default-schema
     :event/card-read   default-schema
     :event/card-update default-schema
     :event/card-delete default-schema
     :event/card-query  [:map {:closed true}
                         [:card-id pos-int?]
                         [:user-id [:maybe pos-int?]]
                         [:context {:optional true} :any]]}))

user events

(let [default-schema (mc/schema
                      [:map {:closed true}
                       [:user-id pos-int?]])]
  (def ^:private user-events-schema
    {:event/user-login  default-schema
     :event/user-joined default-schema}))

metric events

(let [default-schema (mc/schema
                      [:map {:closed true}
                       [:user-id  pos-int?]
                       [:object   [:fn #(t2/instance-of? :model/Metric %)]]])
      with-message   (mc/schema [:merge default-schema
                                 [:map {:closed true}
                                  [:revision-message {:optional true} :string]]])]
  (def ^:private metric-related-schema
    {:event/metric-create default-schema
     :event/metric-update with-message
     :event/metric-delete with-message}))

segment events

(let [default-schema (mc/schema
                      [:map {:closed true}
                       [:user-id  pos-int?]
                       [:object   [:fn #(t2/instance-of? :model/Segment %)]]])
      with-message (mc/schema
                    [:merge default-schema
                     [:map {:closed true}
                      [:revision-message {:optional true} :string]]])]
  (def ^:private segment-related-schema
    {:event/segment-create default-schema
     :event/segment-update with-message
     :event/segment-delete with-message}))

database events

(let [default-schema (mc/schema
                      [:map {:closed true}
                       [:object [:fn #(t2/instance-of? :model/Database %)]]
                       [:previous-object {:optional true} [:fn #(t2/instance-of? :model/Database %)]]
                       [:user-id pos-int?]])]
  (def ^:private database-events
    {:event/database-create default-schema
     :event/database-update default-schema
     :event/database-delete default-schema}))

alert schemas

(def ^:private alert-schema
  {:event/alert-create (mc/schema
                        [:map {:closed true}
                         [:user-id pos-int?]
                         [:object [:and
                                   [:fn #(t2/instance-of? :model/Pulse %)]
                                   [:map
                                    [:card [:fn #(t2/instance-of? :model/Card %)]]]]]])})

pulse schemas

(def ^:private pulse-schemas
  {:event/pulse-create (mc/schema
                        [:map {:closed true}
                         [:user-id pos-int?]
                         [:object [:fn #(t2/instance-of? :model/Pulse %)]]])})

table events

(def ^:private table-events
  {:event/table-read (mc/schema
                      [:map {:closed true}
                       [:user-id  pos-int?]
                       [:object [:fn #(t2/instance-of? :model/Table %)]]])})
(let [default-schema (mc/schema
                      [:map {:closed true}
                       [:user-id [:maybe pos-int?]]
                       [:object [:maybe [:fn #(boolean (t2/model %))]]]
                       [:has-access {:optional true} [:maybe :boolean]]])]
  (def ^:private permission-failure-events
    {:event/read-permission-failure default-schema
     :event/write-permission-failure default-schema
     :event/update-permission-failure default-schema
     :event/create-permission-failure (mc/schema
                                       [:map {:closed true}
                                        [:user-id [:maybe pos-int?]]
                                        [:model [:or :keyword :string]]])}))

Returns the schema for an event topic.

(def topic->schema
  (merge dashboard-events-schemas
         card-events-schemas
         user-events-schema
         metric-related-schema
         segment-related-schema
         database-events
         alert-schema
         pulse-schemas
         table-events
         permission-failure-events))
 
(ns metabase.events.sync-database
  (:require
   [metabase.events :as events]
   [metabase.sync :as sync]
   [metabase.sync.sync-metadata :as sync-metadata]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [methodical.core :as methodical]))
(derive ::event :metabase/event)
(derive :event/database-create ::event)
(methodical/defmethod events/publish-event! ::event
  [topic {database :object :as _event}]
  ;; try/catch here to prevent individual topic processing exceptions from bubbling up.  better to handle them here.
  (try
   (when database
     ;; just kick off a sync on another thread
     (future
      (try
       ;; only do the 'full' sync if this is a "full sync" database. Otherwise just do metadata sync only
       (if (:is_full_sync database)
         (sync/sync-database! database)
         (sync-metadata/sync-db-metadata! database))
       (catch Throwable e
         (log/error e (trs "Error syncing Database {0}" (u/the-id database)))))))
   (catch Throwable e
     (log/warnf e "Failed to process sync-database event: %s" topic))))
 

This namespace is responsible for subscribing to events which should update the view log.

(ns metabase.events.view-log
  (:require
   [metabase.api.common :as api]
   [metabase.events :as events]
   [metabase.models.audit-log :as audit-log]
   [metabase.models.query.permissions :as query-perms]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [methodical.core :as m]
   [steffan-westcott.clj-otel.api.trace.span :as span]
   [toucan2.core :as t2]))

Simple base function for recording a view of a given model and model-id by a certain user.

(defn- record-views!
  [view-or-views]
  (span/with-span!
    {:name "record-view!"}
    (t2/insert! :model/ViewLog view-or-views)))

Generates a view, given an event map.

(defn- generate-view
  [{:keys [object user-id has-access]
    :or   {has-access true}}]
  {:model      (u/lower-case-en (audit-log/model-name object))
   :user_id    (or user-id api/*current-user-id*)
   :model_id   (u/id object)
   :has_access has-access})
(derive ::card-read-event :metabase/event)
(derive :event/card-read ::card-read-event)
(m/defmethod events/publish-event! ::card-read-event
  "Handle processing for a generic read event notification"
  [topic event]
  (span/with-span!
    {:name "view-log-card-read"
     :topic topic
     :user-id (:user-id event)}
    (try
      (-> event
          generate-view
          (assoc :context "question")
          record-views!)
      (catch Throwable e
        (log/warnf e "Failed to process view_log event. %s" topic)))))
(derive ::read-permission-failure :metabase/event)
(derive :event/read-permission-failure ::read-permission-failure)
(m/defmethod events/publish-event! ::read-permission-failure
  "Handle processing for a generic read event notification"
  [topic {:keys [object] :as event}]
  (try
    ;; Only log permission check failures for Cards and Dashboards. This set can be expanded if we add view logging of
    ;; other models.
    (when (#{:model/Card :model/Dashboard} (t2/model object))
     (-> event
         generate-view
         record-views!))
    (catch Throwable e
      (log/warnf e "Failed to process view_log event. %s" topic))))
(derive ::dashboard-read :metabase/event)
(derive :event/dashboard-read ::dashboard-read)

Returns true if the dashcard's card was readable by the current user, and false otherwise. Unreadable cards are replaced with maps containing just the card's ID, so we can check for this to determine whether the card was readable

(defn- readable-dashcard?
  [dashcard]
  (let [card (:card dashcard)]
    (not= (set (keys card)) #{:id})))
(m/defmethod events/publish-event! ::dashboard-read
  "Handle processing for the dashboard read event. Logs the dashboard view as well as card views for each card on the
  dashboard."
  [topic {:keys [object user-id] :as event}]
  (span/with-span!
    {:name "view-log-dashboard-read"
     :topic topic
     :user-id user-id}
    (try
      (let [dashcards (filter :card_id (:dashcards object)) ;; filter out link/text cards wtih no card_id
            user-id   (or user-id api/*current-user-id*)
            views     (map (fn [dashcard]
                               {:model      "card"
                                :model_id   (u/id (:card_id dashcard))
                                :user_id    user-id
                                :has_access (readable-dashcard? dashcard)
                                :context    "dashboard"})
                           dashcards)
            dash-view (generate-view event)]
        (record-views! (cons dash-view views)))
      (catch Throwable e
        (log/warnf e "Failed to process view_log event. %s" topic)))))
(derive ::table-read :metabase/event)
(derive :event/table-read ::table-read)
(m/defmethod events/publish-event! ::table-read
  "Handle processing for the table read event. Does a basic permissions check to see if the the user has data perms for
  the table."
  [topic {:keys [object user-id] :as event}]
  (span/with-span!
    {:name "view-log-table-read"
     :topic topic
     :user-id user-id}
    (try
      (let [table-id    (u/id object)
            database-id (:db_id object)
            has-access? (when (= api/*current-user-id* user-id)
                          (query-perms/can-query-table? database-id table-id))]
        (-> event
            (assoc :has-access has-access?)
            generate-view
            record-views!))
      (catch Throwable e
        (log/warnf e "Failed to process view_log event. %s" topic)))))
 

Provides functions that support formatting results data. In particular, customizing formatting for when timezone, column metadata, and visualization-settings are known. These functions can be used for uniform rendering of all artifacts such as generated CSV or image files that need consistent formatting across the board.

(ns metabase.formatter
  (:require
   [clojure.pprint :refer [cl-format]]
   [clojure.string :as str]
   [hiccup.util]
   [metabase.formatter.datetime :as datetime]
   [metabase.public-settings :as public-settings]
   [metabase.shared.models.visualization-settings :as mb.viz]
   [metabase.shared.util.currency :as currency]
   [metabase.types :as types]
   [metabase.util.ui-logic :as ui-logic]
   [potemkin.types :as p.types]
   [schema.core :as s])
  (:import
   (java.math RoundingMode)
   (java.net URL)
   (java.text DecimalFormat DecimalFormatSymbols)))
(set! *warn-on-reflection* true)

Fool Eastwood into thinking this namespace is used

(comment hiccup.util/keep-me)

Schema used for functions that operate on pulse card contents and their attachments

(def RenderedPulseCard
  {:attachments                  (s/maybe {s/Str URL})
   :content                      [s/Any]
   (s/optional-key :render/text) (s/maybe s/Str)})
(p.types/defrecord+ NumericWrapper [^String num-str ^Number num-value]
  hiccup.util/ToString
  (to-str [_] num-str)
  Object
  (toString [_] num-str))
(defn- strip-trailing-zeroes
  [num-as-string decimal]
  (if (str/includes? num-as-string (str decimal))
    (let [pattern (re-pattern (str/escape (str decimal \$) {\. "\\."}))]
      (-> num-as-string
          (str/split #"0+$")
          first
          (str/split pattern)
          first))
    num-as-string))
(defn- digits-after-decimal
  ([value] (digits-after-decimal value "."))
  ([value decimal]
   (if (zero? value)
     0
     (let [val-string (-> (condp = (type value)
                            java.math.BigDecimal (.toPlainString ^BigDecimal value)
                            java.lang.Double (format "%.20f" value)
                            java.lang.Float (format "%.20f" value)
                            (str value))
                          (strip-trailing-zeroes (str decimal)))
           [_n d] (str/split val-string #"[^\d*]")]
       (count d)))))
(defn- sig-figs-after-decimal
  [value decimal]
  (if (zero? value)
    0
    (let [val-string (-> (condp = (type value)
                           java.math.BigDecimal (.toPlainString ^BigDecimal value)
                           java.lang.Double (format "%.20f" value)
                           java.lang.Float (format "%.20f" value)
                           (str value))
                         (strip-trailing-zeroes (str decimal)))
          figs (last (str/split val-string #"[\.0]+"))]
      (count figs))))

Return a function that will take a number and format it according to its column viz settings. Useful to compute the format string once and then apply it over many values.

(defn number-formatter
  [{:keys [semantic_type effective_type base_type]
    col-id :id field-ref :field_ref col-name :name :as _column}
   viz-settings]
  (let [col-id (or col-id (second field-ref))
        column-settings (-> (get viz-settings ::mb.viz/column-settings)
                            (update-keys #(select-keys % [::mb.viz/field-id ::mb.viz/column-name])))
        column-settings (or (get column-settings {::mb.viz/field-id col-id})
                            (get column-settings {::mb.viz/column-name col-name}))
        global-settings (::mb.viz/global-column-settings viz-settings)
        currency?       (boolean (or (= (::mb.viz/number-style column-settings) "currency")
                                     (and (nil? (::mb.viz/number-style column-settings))
                                          (or
                                           (::mb.viz/currency-style column-settings)
                                           (::mb.viz/currency column-settings)))))
        {::mb.viz/keys [number-separators decimals scale number-style
                        prefix suffix currency-style currency]} (merge
                                                                 (when currency?
                                                                   (:type/Currency global-settings))
                                                                 (:type/Number global-settings)
                                                                 column-settings)
        integral?       (isa? (or effective_type base_type) :type/Integer)
        relation?       (isa? semantic_type :Relation/*)
        percent?        (or (isa? semantic_type :type/Percentage) (= number-style "percent"))
        scientific?     (= number-style "scientific")
        [decimal grouping] (or number-separators
                               (get-in (public-settings/custom-formatting) [:type/Number :number_separators])
                               ".,")
        symbols            (doto (DecimalFormatSymbols.)
                             (cond-> decimal (.setDecimalSeparator decimal))
                             (cond-> grouping (.setGroupingSeparator grouping)))
        base               (cond-> (if (or scientific? relation?) "0" "#,##0")
                             (not grouping) (str/replace #"," ""))]
    (fn [value]
      (if (number? value)
        (let [scaled-value      (cond-> (* value (or scale 1))
                                  percent?
                                  (* 100))
              decimals-in-value (digits-after-decimal scaled-value)
              decimal-digits (cond
                               decimals decimals ;; if user ever specifies # of decimals, use that
                               integral? 0
                               currency? (get-in currency/currency [(keyword (or currency "USD")) :decimal_digits])
                               percent?  (min 2 decimals-in-value) ;; 5.5432 -> %554.32
                               :else (if (>= scaled-value 1)
                                       (min 2 decimals-in-value) ;; values greater than 1 round to 2 decimal places
                                       (let [n-figs (sig-figs-after-decimal scaled-value decimal)]
                                         (if (> n-figs 2)
                                           (max 2 (- decimals-in-value (- n-figs 2))) ;; values less than 1 round to 2 sig-dig
                                           decimals-in-value))))
              fmt-str (cond-> base
                        (not (zero? decimal-digits)) (str "." (apply str (repeat decimal-digits "0")))
                        scientific? (str "E0"))
              fmtr (doto (DecimalFormat. fmt-str symbols) (.setRoundingMode RoundingMode/HALF_UP))]
          (map->NumericWrapper
           {:num-value value
            :num-str   (let [inline-currency? (and currency?
                                                   (false? (::mb.viz/currency-in-header column-settings)))]
                         (str (when prefix prefix)
                              (when (and inline-currency? (or (nil? currency-style)
                                                       (= currency-style "symbol")))
                                (get-in currency/currency [(keyword (or currency "USD")) :symbol]))
                              (when (and inline-currency? (= currency-style "code"))
                                (str (get-in currency/currency [(keyword (or currency "USD")) :code]) \space))
                              (cond-> (.format fmtr scaled-value)
                                (and (not currency?) (not decimals))
                                (strip-trailing-zeroes decimal)
                                percent?    (str "%"))
                              (when (and inline-currency? (= currency-style "name"))
                                (str \space (get-in currency/currency [(keyword (or currency "USD")) :name_plural])))
                              (when suffix suffix)))}))
        value))))
(s/defn format-number :- NumericWrapper
  "Format a number `n` and return it as a NumericWrapper; this type is used to do special formatting in other
  `pulse.render` namespaces."
  ([n :- s/Num]
   (map->NumericWrapper {:num-str   (cl-format nil (if (integer? n) "~:d" "~,2f") n)
                         :num-value n}))
  ([value column viz-settings]
   (let [fmttr (number-formatter column viz-settings)]
     (fmttr value))))

Return a pair of [get-x-axis get-y-axis] functions that can be used to get the x-axis and y-axis values in a row, or columns, respectively.

(defn graphing-column-row-fns
  [card data]
  [(or (ui-logic/x-axis-rowfn card data)
       first)
   (or (ui-logic/y-axis-rowfn card data)
       second)])

Graal polyglot system (not the JS machine itself, the polyglot system) is not happy with BigInts or BigDecimals. For more information, this is the GraalVM issue, open a while https://github.com/oracle/graal/issues/2737 Because of this unfortunately they all have to get smushed into normal ints and decimals in JS land.

(defn coerce-bignum-to-int
  [row]
  (for [member row]
    (cond
      ;; this returns true for bigint only, not normal int or long
      (instance? clojure.lang.BigInt member)
      (int member)
      ;; this returns true for bigdec only, not actual normal decimals
      ;; not the clearest clojure native function in the world
      (decimal? member)
      (double member)
      :else
      member)))

Preprocess rows.

  • Removes any rows that have a nil value for the x-axis-fn OR y-axis-fn
  • Normalizes bigints and bigdecs to ordinary sizes
(defn row-preprocess
  [x-axis-fn y-axis-fn rows]
  (->> rows
       (filter (every-pred x-axis-fn y-axis-fn))
       (map coerce-bignum-to-int)))

Create a formatter for a column based on its timezone, column metadata, and visualization-settings

(s/defn create-formatter
  [timezone-id :- (s/maybe s/Str) col visualization-settings]
  (cond
    ;; for numbers, return a format function that has already computed the differences.
    ;; todo: do the same for temporal strings
    (types/temporal-field? col)
    #(datetime/format-temporal-str timezone-id % col visualization-settings)
    ;; todo integer columns with a unit
    (or (isa? (:effective_type col) :type/Number)
        (isa? (:base_type col) :type/Number))
    (number-formatter col visualization-settings)
    :else
    str))
 

Logic for rendering datetimes when context such as timezone, column metadata, and visualization settings are known.

(ns metabase.formatter.datetime
  (:require
   [clojure.string :as str]
   [java-time.api :as t]
   [metabase.public-settings :as public-settings]
   [metabase.query-processor.streaming.common :as common]
   [metabase.shared.formatting.constants :as constants]
   [metabase.shared.models.visualization-settings :as mb.viz]
   [metabase.util.date-2 :as u.date]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log])
  (:import
   (com.ibm.icu.text RuleBasedNumberFormat)
   (java.util Locale)))
(set! *warn-on-reflection* true)

Returns true if the string s is parseable as a datetime.

(temporal-string? "asdf") -> false (temporal-string? "2020-02-02") -> true

(defn temporal-string?
  [s]
  (boolean
   (try
     (u.date/parse s)
     (catch Exception _e false))))
(defn- reformat-temporal-str [timezone-id s new-format-string]
  (t/format new-format-string (u.date/parse s timezone-id)))
(defn- day-of-week
  [n abbreviate]
  (let [fmtr (java.time.format.DateTimeFormatter/ofPattern (if abbreviate "EEE" "EEEE"))]
    (.format fmtr (java.time.DayOfWeek/of n))))
(defn- month-of-year
  [n abbreviate]
  (let [fmtr (java.time.format.DateTimeFormatter/ofPattern (if abbreviate "MMM" "MMMM"))]
    (.format fmtr (java.time.Month/of n))))

Format an integer as x-th of y, for example, 2nd week of year.

(defn- x-of-y
  [n]
  (let [nf (RuleBasedNumberFormat. (Locale. (public-settings/site-locale)) RuleBasedNumberFormat/ORDINAL)]
    (.format nf n)))
(defn- hour-of-day
  [s time-style]
  (let [n  (parse-long s)
        ts (u.date/parse "2022-01-01-00:00:00")]
    (u.date/format time-style (t/plus ts (t/hours n)))))

Get the column-settings map for the given column from the viz-settings.

(defn- viz-settings-for-col
  [{column-name :name :keys [field_ref]} viz-settings]
  (let [[_ field-id-or-name] field_ref
        all-cols-settings (-> viz-settings
                              ::mb.viz/column-settings
                              ;; update the keys so that they will have only the :field-id or :column-name
                              ;; and not have any metadata. Since we don't know the metadata, we can never
                              ;; match a key with metadata, even if we do have the correct name or id
                              (update-keys #(select-keys % [::mb.viz/field-id ::mb.viz/column-name])))]
    (or (all-cols-settings {::mb.viz/field-id field-id-or-name})
        (all-cols-settings {::mb.viz/column-name (or field-id-or-name column-name)}))))

Given viz-settings with a time-style and possible time-enabled (precision) entry, create the format string. Note that if the :time-enabled key is present but the value is nil, we explicitly do not show the time.

(defn- determine-time-format
  [{:keys [time-style] :or {time-style "h:mm A"} :as viz-settings}]
  ;; NOTE - If :time-enabled is present but nil it will return nil
  (when-some [base-time-format (case (get viz-settings :time-enabled "minutes")
                               "minutes" "mm"
                               "seconds" "mm:ss"
                               "milliseconds" "mm:ss.SSS"
                               nil nil)]
    (case time-style
      "HH:mm" (format "HH:%s" base-time-format)
      ;; Deprecated time style which should be already converted to HH:mm when viz settings are
      ;; normalized, but we'll handle it here too just in case. (#18112)
      "k:mm" (str "h" base-time-format)
      ("h:mm A" "h:mm a") (format "h:%s a" base-time-format)
      time-style)))

The Java pattern for DateTimeFormatter is a for AM/PM and A for milli-of-day. However, to reconcile formats with Moment.js on the FE, we use h:mm A to denote AM/PM in our code base. This function replaces time format patterns that use the MB 'A' with 'a' so that DateTimeFormatter properly formats times. We should consider looking into metabase.shared.util.time to see if we can eliminate this altogether.

(defn- fix-time-style
  [time-style default-time-style]
  (str/replace (or time-style default-time-style) #"A" "a"))

Potentially modify a date style to abbreviate names or add a different date separator.

(defn- post-process-date-style
  [date-style {:keys [date-abbreviate date-separator]}]
  (let [conditional-changes
        (cond-> (-> date-style (str/replace #"dddd" "EEEE"))
          date-separator (str/replace #"/" date-separator)
          date-abbreviate (-> (str/replace #"MMMM" "MMM")
                         (str/replace #"EEEE" "EEE")
                         (str/replace #"DDD" "D")))]
    (-> conditional-changes
        ;; 'D' formats as Day of year, we want Day of month, which is  'd' (issue #27469)
        (str/replace #"D" "d"))))

The dispatch function logic for format format-timestring. Find the first of the unit or highest type of the object.

(def ^:private col-type
  (some-fn :unit :semantic_type :effective_type :base_type))

Reformat a temporal literal string to the desired format based on column :unit, if provided, then on the column type. The type is the highest present of semantic, effective, or base type. This is currently expected to be one of: - :type/Time - The hour, minute, second, etc. portion of a day, not anchored to a date - :type/Date - A date without hour and minute information - :type/DateTime - A full date plus hour, minute, seconds, etc. If neither a unit nor a temporal type is provided, just bottom out by assuming a date.

(defmulti format-timestring
  (fn [_timezone-id _temporal-str col _viz-settings] (col-type col)))
(defmethod format-timestring :minute [timezone-id temporal-str _col {:keys [date-style time-style] :as viz-settings}]
  (reformat-temporal-str timezone-id temporal-str
                         (-> (or date-style "MMMM, yyyy")
                             (str ", " (fix-time-style time-style constants/default-time-style))
                             (post-process-date-style viz-settings))))
(defmethod format-timestring :hour [timezone-id temporal-str _col {:keys [date-style time-style] :as viz-settings}]
  (reformat-temporal-str timezone-id temporal-str
                         (-> (or date-style "MMMM, yyyy")
                             (str ", " (fix-time-style time-style "h a"))
                             (post-process-date-style viz-settings))))
(defmethod format-timestring :day [timezone-id temporal-str _col {:keys [date-style] :as viz-settings}]
  (reformat-temporal-str timezone-id temporal-str
                         (-> (or date-style "EEEE, MMMM d, YYYY")
                             (post-process-date-style viz-settings))))
(defmethod format-timestring :week [timezone-id temporal-str _col _viz-settings]
  (str (tru "Week ") (reformat-temporal-str timezone-id temporal-str "w - YYYY")))
(defmethod format-timestring :month [timezone-id temporal-str _col {:keys [date-style] :as viz-settings}]
  (reformat-temporal-str timezone-id temporal-str
                         (-> (or date-style "MMMM, yyyy")
                             (post-process-date-style viz-settings))))
(defmethod format-timestring :quarter [timezone-id temporal-str _col _viz-settings]
  (reformat-temporal-str timezone-id temporal-str "QQQ - yyyy"))
(defmethod format-timestring :year [timezone-id temporal-str _col _viz-settings]
  (reformat-temporal-str timezone-id temporal-str "YYYY"))
(defmethod format-timestring :day-of-week [_timezone-id temporal-str _col {:keys [date-abbreviate]}]
  (day-of-week (parse-long temporal-str) date-abbreviate))
(defmethod format-timestring :month-of-year [_timezone-id temporal-str _col {:keys [date-abbreviate]}]
  (month-of-year (parse-long temporal-str) date-abbreviate))
(defmethod format-timestring :quarter-of-year [_timezone-id temporal-str _col _viz-settings]
  (format "Q%s" temporal-str))
(defmethod format-timestring :hour-of-day [_timezone-id temporal-str _col {:keys [time-style]}]
  (hour-of-day temporal-str (fix-time-style time-style "h a")))
(defmethod format-timestring :week-of-year [_timezone-id temporal-str _col _viz-settings]
  (x-of-y (parse-long temporal-str)))
(defmethod format-timestring :minute-of-hour [_timezone-id temporal-str _col _viz-settings]
  (x-of-y (parse-long temporal-str)))
(defmethod format-timestring :day-of-month [_timezone-id temporal-str _col _viz-settings]
  (x-of-y (parse-long temporal-str)))
(defmethod format-timestring :day-of-year [_timezone-id temporal-str _col _viz-settings]
  (x-of-y (parse-long temporal-str)))
(defmethod format-timestring :type/Time [timezone-id temporal-str _col viz-settings]
  (let [time-style (some-> (determine-time-format viz-settings)
                           (fix-time-style constants/default-time-style))]
    ;; ATM, the FE can technically say the time style is `nil` via the `:time-enabled` key. While this doesn't really
    ;; make sense, we should guard against it by returning an empty string if the time style is `nil`.
    (if time-style
      (reformat-temporal-str timezone-id temporal-str time-style)
      "")))
(defmethod format-timestring :type/Date [timezone-id temporal-str _col {:keys [date-style] :as viz-settings}]
  (let [date-format (post-process-date-style (or date-style "MMMM d, yyyy") viz-settings)]
    (reformat-temporal-str timezone-id temporal-str date-format)))
(defmethod format-timestring :type/DateTime [timezone-id temporal-str _col {:keys [date-style] :as viz-settings}]
  (let [date-style            (or date-style "MMMM d, yyyy")
        time-style            (some-> (determine-time-format viz-settings)
                                      (fix-time-style constants/default-time-style))
        date-time-style       (cond-> date-style
                                time-style
                                (str ", " time-style))
        default-format-string (post-process-date-style date-time-style viz-settings)]
    (t/format default-format-string (u.date/parse temporal-str timezone-id))))
(defmethod format-timestring :default [timezone-id temporal-str {:keys [unit] :as col} {:keys [date-style] :as viz-settings}]
  (if (= :default unit)
    ;; When the unit is the `:default` literal we want to retry formatting with the data types contained in col.
    (format-timestring timezone-id temporal-str (dissoc col :unit) viz-settings)
    ;; We're making an assumption when we bottom out here that the string is compatible with this default format,
    ;; 'MMMM d, yyyy'. If the time string isn't compatible with this format, we just return the string.
    ;; This is not likely to happen IRL since you generally have a useful unit or know the type of the colum. A failure
    ;; mode that can be reproduced in test is trying to format a time string (e.g.'15:30:45Z') when the column has no
    ;; type information (e.g. a semantic or effective type of `:type/Time`).
    (let [date-format (post-process-date-style (or date-style "MMMM d, yyyy") viz-settings)]
      (try
        (reformat-temporal-str timezone-id temporal-str date-format)
        (catch Exception _
          (log/warnf "Could not format temporal string %s in time zone %s with format %s."
                     temporal-str
                     timezone-id
                     date-format)
          temporal-str)))))

Reformat a temporal literal string by combining time zone, column, and viz setting information to create a final desired output format.

(defn format-temporal-str
  ([timezone-id temporal-str col] (format-temporal-str timezone-id temporal-str col {}))
  ([timezone-id temporal-str col viz-settings]
   (Locale/setDefault (Locale. (public-settings/site-locale)))
   (let [merged-viz-settings (common/normalize-keys
                               (common/viz-settings-for-col col viz-settings))]
     (if (str/blank? temporal-str)
       ""
       (format-timestring timezone-id temporal-str col merged-viz-settings)))))
 

Shared functionality used by different integrations.

(ns metabase.integrations.common
  (:require
   [clojure.data :as data]
   [clojure.set :as set]
   [metabase.models.permissions-group :as perms-group]
   [metabase.models.permissions-group-membership
    :as perms-group-membership
    :refer [PermissionsGroupMembership]]
   [metabase.models.setting.multi-setting :refer [define-multi-setting
                                                  define-multi-setting-impl]]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru
                               trs]]
   [metabase.util.log :as log]
   [toucan2.core :as t2]))

Update the PermissionsGroups a User belongs to, adding or deleting membership entries as needed so that Users is only in new-groups-or-ids. Ignores special groups like all-users, and only touches groups with mappings set.

(defn sync-group-memberships!
  [user-or-id new-groups-or-ids mapped-groups-or-ids]
  (let [mapped-group-ids   (set (map u/the-id mapped-groups-or-ids))
        excluded-group-ids #{(u/the-id (perms-group/all-users))}
        user-id            (u/the-id user-or-id)
        current-group-ids  (when (seq mapped-group-ids)
                             (t2/select-fn-set :group_id PermissionsGroupMembership
                                               {:where
                                                [:and
                                                 [:= :user_id user-id]
                                                 [:in :group_id mapped-group-ids]
                                                 [:not-in :group_id excluded-group-ids]]}))
        new-group-ids      (set/intersection (set (map u/the-id new-groups-or-ids))
                                             mapped-group-ids)
        ;; determine what's different between current mapped groups and new mapped groups
        [to-remove to-add] (data/diff current-group-ids new-group-ids)]
    ;; remove membership from any groups as needed
    (when (seq to-remove)
      (log/debugf "Removing user %s from group(s) %s" user-id to-remove)
      (try
       (t2/delete! PermissionsGroupMembership :group_id [:in to-remove], :user_id user-id)
       (catch clojure.lang.ExceptionInfo e
         ;; in case sync attempts to delete the last admin, the pre-delete hooks of
         ;; [[metabase.models.permissions-group-membership/PermissionsGroupMembership]] will throw an exception.
         ;; but we don't want to block user from logging-in, so catch this exception and log a warning
         (if (= (ex-message e) (str perms-group-membership/fail-to-remove-last-admin-msg))
           (log/warn "Attempted to remove the last admin during group sync!"
                     "Check your SSO group mappings and make sure the Administrators group is mapped correctly.")
           (throw e)))))
    ;; add new memberships for any groups as needed
    (doseq [id    to-add
            :when (not (excluded-group-ids id))]
      (log/debugf "Adding user %s to group %s" user-id id)
      ;; if adding membership fails for one reason or another (i.e. if the group doesn't exist) log the error add the
      ;; user to the other groups rather than failing entirely
      (try
        (t2/insert! PermissionsGroupMembership :group_id id, :user_id user-id)
        (catch Throwable e
          (log/error e (trs "Error adding User {0} to Group {1}" user-id id)))))))
(define-multi-setting send-new-sso-user-admin-email?
  (deferred-tru "Should new email notifications be sent to admins, for all new SSO users?")
  (fn [] (if (premium-features/enable-any-sso?)
           :ee
           :oss)))
(define-multi-setting-impl send-new-sso-user-admin-email? :oss
  :getter (fn [] (constantly true))
  :setter :none)
 
(ns metabase.integrations.google
  (:require
   [cheshire.core :as json]
   [clj-http.client :as http]
   [clojure.string :as str]
   [metabase.api.common :as api]
   [metabase.config :as config]
   [metabase.integrations.google.interface :as google.i]
   [metabase.models.interface :as mi]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.models.setting.multi-setting
    :refer [define-multi-setting-impl]]
   [metabase.models.user :as user :refer [User]]
   [metabase.plugins.classloader :as classloader]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [toucan2.core :as t2]))

Load EE implementation if available

(when config/ee-available?
  (classloader/require 'metabase-enterprise.enhancements.integrations.google))
(def ^:private non-existant-account-message
  (deferred-tru "You'll need an administrator to create a Metabase account before you can use Google to log in."))
(defsetting google-auth-client-id
  (deferred-tru "Client ID for Google Sign-In.")
  :visibility :public
  :audit      :getter
  :setter     (fn [client-id]
                (if (seq client-id)
                  (let [trimmed-client-id (str/trim client-id)]
                    (when-not (str/ends-with? trimmed-client-id ".apps.googleusercontent.com")
                      (throw (ex-info (tru "Invalid Google Sign-In Client ID: must end with \".apps.googleusercontent.com\)
                                      {:status-code 400})))
                    (setting/set-value-of-type! :string :google-auth-client-id trimmed-client-id))
                  (do
                   (setting/set-value-of-type! :string :google-auth-client-id nil)
                   (setting/set-value-of-type! :boolean :google-auth-enabled false)))))
(defsetting google-auth-configured
  (deferred-tru "Is Google Sign-In configured?")
  :type   :boolean
  :setter :none
  :getter (fn [] (boolean (google-auth-client-id))))
(defsetting google-auth-enabled
  (deferred-tru "Is Google Sign-in currently enabled?")
  :visibility :public
  :type       :boolean
  :audit      :getter
  :getter     (fn []
                (if-some [value (setting/get-value-of-type :boolean :google-auth-enabled)]
                  value
                  (boolean (google-auth-client-id))))
  :setter     (fn [new-value]
                (if-let [new-value (boolean new-value)]
                  (if-not (google-auth-client-id)
                    (throw (ex-info (tru "Google Sign-In is not configured. Please set the Client ID first.")
                                    {:status-code 400}))
                    (setting/set-value-of-type! :boolean :google-auth-enabled new-value))
                  (setting/set-value-of-type! :boolean :google-auth-enabled new-value))))
(define-multi-setting-impl google.i/google-auth-auto-create-accounts-domain :oss
  :getter (fn [] (setting/get-value-of-type :string :google-auth-auto-create-accounts-domain))
  :setter (fn [domain]
              (when (and domain (str/includes? domain ","))
                ;; Multiple comma-separated domains requires the `:sso-google` premium feature flag
                (throw (ex-info (tru "Invalid domain") {:status-code 400})))
              (setting/set-value-of-type! :string :google-auth-auto-create-accounts-domain domain)))
(def ^:private google-auth-token-info-url "https://www.googleapis.com/oauth2/v3/tokeninfo?id_token=%s")
(defn- google-auth-token-info
  ([token-info-response]
   (google-auth-token-info token-info-response (google-auth-client-id)))
  ([token-info-response client-id]
   (let [{:keys [status body]} token-info-response]
     (when-not (= status 200)
       (throw (ex-info (tru "Invalid Google Sign-In token.") {:status-code 400})))
     (u/prog1 (json/parse-string body keyword)
       (let [audience (:aud <>)
             audience (if (string? audience) [audience] audience)]
         (when-not (contains? (set audience) client-id)
           (throw (ex-info (tru
                             (str "Google Sign-In token appears to be incorrect. "
                                  "Double check that it matches in Google and Metabase."))
                           {:status-code 400}))))
       (when-not (= (:email_verified <>) "true")
         (throw (ex-info (tru "Email is not verified.") {:status-code 400})))))))
(defn- autocreate-user-allowed-for-email? [email]
  (boolean
   (when-let [domains (google.i/google-auth-auto-create-accounts-domain)]
     (some
      (partial u/email-in-domain? email)
      (str/split domains #"\s*,\s*")))))

Throws if an admin needs to intervene in the account creation.

(defn- check-autocreate-user-allowed-for-email
  [email]
  (when-not (autocreate-user-allowed-for-email? email)
    (throw
     (ex-info (str non-existant-account-message)
              {:status-code 401
               :errors  {:_error non-existant-account-message}}))))
(mu/defn ^:private google-auth-create-new-user!
  [{:keys [email] :as new-user} :- user/NewUser]
  (check-autocreate-user-allowed-for-email email)
  ;; this will just give the user a random password; they can go reset it if they ever change their mind and want to
  ;; log in without Google Auth; this lets us keep the NOT NULL constraints on password / salt without having to make
  ;; things hairy and only enforce those for non-Google Auth users
  (user/create-new-google-auth-user! new-user))
(mu/defn ^:private google-auth-fetch-or-create-user! :- (mi/InstanceOf User)
  [first-name last-name email]
  (or (t2/select-one [User :id :email :last_login] :%lower.email (u/lower-case-en email))
      (google-auth-create-new-user! {:first_name first-name
                                     :last_name  last-name
                                     :email      email})))

Call to Google to perform an authentication

(defn do-google-auth
  [{{:keys [token]} :body, :as _request}]
  (let [token-info-response                    (http/post (format google-auth-token-info-url token))
        {:keys [given_name family_name email]} (google-auth-token-info token-info-response)]
    (log/info (trs "Successfully authenticated Google Sign-In token for: {0} {1}" given_name family_name))
    (api/check-500 (google-auth-fetch-or-create-user! given_name family_name email))))
 
(ns metabase.integrations.google.interface
  (:require
   [metabase.models.setting.multi-setting :refer [define-multi-setting]]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.util.i18n :refer [deferred-tru]]))
#_{:clj-kondo/ignore [:missing-docstring]}
(define-multi-setting google-auth-auto-create-accounts-domain
  (deferred-tru "When set, allow users to sign up on their own if their Google account email address is from this domain.")
  (fn [] (if (premium-features/enable-sso-google?) :ee :oss)))
 
(ns metabase.integrations.ldap
  (:require
   [cheshire.core :as json]
   [clj-ldap.client :as ldap]
   [metabase.config :as config]
   [metabase.integrations.ldap.default-implementation :as default-impl]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.models.user :refer [User]]
   [metabase.plugins.classloader :as classloader]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru tru]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms])
  (:import
   (com.unboundid.ldap.sdk DN LDAPConnectionPool LDAPException)))
(set! *warn-on-reflection* true)

Load the EE namespace up front so that the extra Settings it defines are available immediately. Otherwise, this would only happen the first time find-user or fetch-or-create-user! is called.

(when config/ee-available?
  (classloader/require 'metabase-enterprise.enhancements.integrations.ldap))
(defsetting ldap-host
  (deferred-tru "Server hostname.")
  :audit :getter)
(defsetting ldap-port
  (deferred-tru "Server port, usually 389 or 636 if SSL is used.")
  :type    :integer
  :default 389
  :audit   :getter)
(defsetting ldap-security
  (deferred-tru "Use SSL, TLS or plain text.")
  :type    :keyword
  :default :none
  :audit   :raw-value
  :setter  (fn [new-value]
             (when (some? new-value)
               (assert (#{:none :ssl :starttls} (keyword new-value))))
             (setting/set-value-of-type! :keyword :ldap-security new-value)))
(defsetting ldap-bind-dn
  (deferred-tru "The Distinguished Name to bind as (if any), this user will be used to lookup information about other users.")
  :audit :getter)
(defsetting ldap-password
  (deferred-tru "The password to bind with for the lookup user.")
  :sensitive? true
  :audit     :getter)
(defsetting ldap-user-base
  (deferred-tru "Search base for users. (Will be searched recursively)")
  :audit :getter)
(defsetting ldap-user-filter
  (deferred-tru "User lookup filter. The placeholder '{login}' will be replaced by the user supplied login.")
  :default "(&(objectClass=inetOrgPerson)(|(uid={login})(mail={login})))"
  :audit   :getter)
(defsetting ldap-attribute-email
  (deferred-tru "Attribute to use for the user''s email. (usually ''mail'', ''email'' or ''userPrincipalName'')")
  :default "mail"
  :getter  (fn [] (u/lower-case-en (setting/get-value-of-type :string :ldap-attribute-email)))
  :audit   :getter)
(defsetting ldap-attribute-firstname
  (deferred-tru "Attribute to use for the user''s first name. (usually ''givenName'')")
  :default "givenName"
  :getter  (fn [] (u/lower-case-en (setting/get-value-of-type :string :ldap-attribute-firstname)))
  :audit   :getter)
(defsetting ldap-attribute-lastname
  (deferred-tru "Attribute to use for the user''s last name. (usually ''sn'')")
  :default "sn"
  :getter  (fn [] (u/lower-case-en (setting/get-value-of-type :string :ldap-attribute-lastname)))
  :audit   :getter)
(defsetting ldap-group-sync
  (deferred-tru "Enable group membership synchronization with LDAP.")
  :type    :boolean
  :default false
  :audit   :getter)
(defsetting ldap-group-base
  (deferred-tru "Search base for groups. Not required for LDAP directories that provide a ''memberOf'' overlay, such as Active Directory. (Will be searched recursively)")
  :audit   :getter)
(defsetting ldap-group-mappings
  ;; Should be in the form: {"cn=Some Group,dc=...": [1, 2, 3]} where keys are LDAP group DNs and values are lists of
  ;; MB groups IDs
  (deferred-tru "JSON containing LDAP to Metabase group mappings.")
  :type    :json
  :cache?  false
  :default {}
  :audit   :getter
  :getter  (fn []
             (json/parse-string (setting/get-value-of-type :string :ldap-group-mappings) #(DN. (str %))))
  :setter  (fn [new-value]
             (cond
               (string? new-value)
               (recur (json/parse-string new-value))
               (map? new-value)
               (do (doseq [k (keys new-value)]
                     (when-not (DN/isValidDN (u/qualified-name k))
                       (throw (IllegalArgumentException. (tru "{0} is not a valid DN." (u/qualified-name k))))))
                   (setting/set-value-of-type! :json :ldap-group-mappings new-value)))))
(defsetting ldap-configured?
  (deferred-tru "Have the mandatory LDAP settings (host and user search base) been validated and saved?")
  :type       :boolean
  :visibility :public
  :setter     :none
  :getter     (fn [] (boolean (and (ldap-host)
                                   (ldap-user-base))))
  :doc        false)

Mappings from Metabase setting names to keys to use for LDAP connections

(def mb-settings->ldap-details
  {:ldap-host                :host
   :ldap-port                :port
   :ldap-bind-dn             :bind-dn
   :ldap-password            :password
   :ldap-security            :security
   :ldap-user-base           :user-base
   :ldap-user-filter         :user-filter
   :ldap-attribute-email     :attribute-email
   :ldap-attribute-firstname :attribute-firstname
   :ldap-attribute-lastname  :attribute-lastname
   :ldap-group-sync          :group-sync
   :ldap-group-base          :group-base})
(defn- details->ldap-options [{:keys [host port bind-dn password security]}]
  (let [security (keyword security)
        port     (if (string? port)
                   (Integer/parseInt port)
                   port)]
    ;; Connecting via IPv6 requires us to use this form for :host, otherwise
    ;; clj-ldap will find the first : and treat it as an IPv4 and port number
    {:host      {:address host
                 :port    port}
     :bind-dn   bind-dn
     :password  password
     :ssl?      (= security :ssl)
     :startTLS? (= security :starttls)}))
(defn- settings->ldap-options []
  (details->ldap-options {:host      (ldap-host)
                          :port      (ldap-port)
                          :bind-dn   (ldap-bind-dn)
                          :password  (ldap-password)
                          :security  (ldap-security)}))

Connects to LDAP with the currently set settings and returns the connection.

(defn- get-connection
  ^LDAPConnectionPool []
  (ldap/connect (settings->ldap-options)))

Impl for [[with-ldap-connection]] macro.

(defn do-with-ldap-connection
  [f]
  (with-open [conn (get-connection)]
    (f conn)))

Execute body with connection-binding bound to a LDAP connection.

(defmacro with-ldap-connection
  [[connection-binding] & body]
  `(do-with-ldap-connection (fn [~(vary-meta connection-binding assoc :tag `LDAPConnectionPool)]
                              ~@body)))

TODO -- the usage of :ERROR and :STATUS like this is weird. Just do something like {::error nil} for success and {::error exception} for an error

(def ^:private user-base-error  {:status :ERROR, :message "User search base does not exist or is unreadable"})
(def ^:private group-base-error {:status :ERROR, :message "Group search base does not exist or is unreadable"})

Test the connection to an LDAP server to determine if we can find the search base.

Takes in a dictionary of properties such as:

{:host "localhost" :port 389 :bind-dn "cn=Directory Manager" :password "password" :security "none" :user-base "ou=Birds,dc=metabase,dc=com" :group-base "ou=Groups,dc=metabase,dc=com"}

(defn test-ldap-connection
  [{:keys [user-base group-base], :as details}]
  (try
    (with-open [^LDAPConnectionPool conn (ldap/connect (details->ldap-options details))]
      (or
       (try
         (when-not (ldap/get conn user-base)
           user-base-error)
         (catch Exception _e
           user-base-error))
       (when group-base
         (try
           (when-not (ldap/get conn group-base)
             group-base-error)
           (catch Exception _e
             group-base-error)))
       {:status :SUCCESS}))
    (catch LDAPException e
      {:status :ERROR, :message (.getMessage e), :code (.getResultCode e)})
    (catch Exception e
      {:status :ERROR, :message (.getMessage e)})))

Tests the connection to an LDAP server using the currently set settings.

(defn test-current-ldap-details
  []
  (let [settings (into {} (for [[k v] mb-settings->ldap-details]
                            [v (setting/get k)]))]
    (test-ldap-connection settings)))

Verifies if the supplied password is valid for the user-info (from find-user) or DN.

(defn verify-password
  ([user-info password]
   (with-ldap-connection [conn]
     (verify-password conn user-info password)))
  ([conn user-info password]
   (let [dn (if (string? user-info) user-info (:dn user-info))]
     (ldap/bind? conn dn password))))

A map of all ldap settings

(defn ldap-settings
  []
  {:first-name-attribute (ldap-attribute-firstname)
   :last-name-attribute  (ldap-attribute-lastname)
   :email-attribute      (ldap-attribute-email)
   :sync-groups?         (ldap-group-sync)
   :user-base            (ldap-user-base)
   :user-filter          (ldap-user-filter)
   :group-base           (ldap-group-base)
   :group-mappings       (ldap-group-mappings)})
(mu/defn find-user :- [:maybe default-impl/UserInfo]
  "Get user information for the supplied username."
  ([username :- ms/NonBlankString]
   (with-ldap-connection [conn]
     (find-user conn username)))
  ([ldap-connection :- (ms/InstanceOfClass LDAPConnectionPool)
    username        :- ms/NonBlankString]
   (default-impl/find-user ldap-connection username (ldap-settings))))
(mu/defn fetch-or-create-user! :- (ms/InstanceOf User)
  "Using the `user-info` (from [[find-user]]) get the corresponding Metabase user, creating it if necessary."
  [user-info :- default-impl/UserInfo]
  (default-impl/fetch-or-create-user! user-info (ldap-settings)))
 

Default LDAP integration. This integration is used by OSS or for EE if enterprise features are not enabled.

(ns metabase.integrations.ldap.default-implementation
  (:require
   [clj-ldap.client :as ldap]
   [clojure.string :as str]
   [metabase.integrations.common :as integrations.common]
   [metabase.models.user :as user :refer [User]]
   [metabase.public-settings.premium-features :refer [defenterprise-schema]]
   [metabase.util :as u]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2])
  (:import
   (com.unboundid.ldap.sdk DN Filter LDAPConnectionPool)))
(set! *warn-on-reflection* true)

Schema for LDAP User info as returned by user-info and used as input to fetch-or-create-user!.

(def UserInfo
  [:map
   [:dn         ms/NonBlankString]
   [:first-name [:maybe ms/NonBlankString]]
   [:last-name  [:maybe ms/NonBlankString]]
   [:email      ms/Email]
   [:groups     [:maybe [:sequential ms/NonBlankString]]]])

Options passed to LDAP integration implementations. These are just the various LDAP Settings from metabase.integrations.ldap, packaged up as a single map so implementations don't need to fetch Setting values directly.

(def LDAPSettings
  [:map
   [:first-name-attribute ms/NonBlankString]
   [:last-name-attribute  ms/NonBlankString]
   [:email-attribute      ms/NonBlankString]
   [:sync-groups?         :boolean]
   [:user-base            ms/NonBlankString]
   [:user-filter          ms/NonBlankString]
   [:group-base           [:maybe ms/NonBlankString]]
   [:group-mappings       [:maybe [:map-of (ms/InstanceOfClass DN) [:sequential ms/PositiveInt]]]]])

--------------------------------------------------- find-user ----------------------------------------------------

(def ^:private filter-placeholder
  "{login}")
(def ^:private group-membership-filter
  "(member={dn})")
(mu/defn search :- [:maybe :map]
  "Search for a LDAP user with `username`."
  [ldap-connection                 :- (ms/InstanceOfClass LDAPConnectionPool)
   username                        :- ms/NonBlankString
   {:keys [user-base user-filter]} :- LDAPSettings]
  (some-> (first
           (ldap/search
            ldap-connection
            user-base
            {:scope      :sub
             :filter     (str/replace user-filter filter-placeholder (Filter/encodeValue ^String username))
             :size-limit 1}))
          u/lower-case-map-keys))
(mu/defn ^:private process-group-membership-filter :- ms/NonBlankString
  "Replace DN and UID placeholders with values returned by the LDAP server."
  [group-membership-filter :- ms/NonBlankString
   dn                      :- ms/NonBlankString
   uid                     :- [:maybe ms/NonBlankString]]
  (let [uid-string (or uid )]
    (-> group-membership-filter
        (str/replace "{dn}" (Filter/encodeValue ^String dn))
        (str/replace "{uid}" (Filter/encodeValue ^String uid-string)))))
(mu/defn ^:private user-groups :- [:maybe [:sequential ms/NonBlankString]]
  "Retrieve groups for a supplied DN."
  [ldap-connection         :- (ms/InstanceOfClass LDAPConnectionPool)
   dn                      :- ms/NonBlankString
   uid                     :- [:maybe ms/NonBlankString]
   {:keys [group-base]}    :- LDAPSettings
   group-membership-filter :- ms/NonBlankString]
  (when group-base
    (let [results (ldap/search
                   ldap-connection
                   group-base
                   {:scope  :sub
                    :filter (process-group-membership-filter group-membership-filter dn uid)})]
      (map :dn results))))
(mu/defn ldap-search-result->user-info :- [:maybe UserInfo]
  "Convert the result "
  [ldap-connection               :- (ms/InstanceOfClass LDAPConnectionPool)
   {:keys [dn uid], :as result}  :- :map
   {:keys [first-name-attribute
           last-name-attribute
           email-attribute
           sync-groups?]
    :as   settings}              :- LDAPSettings
   group-membership-filter       :- ms/NonBlankString]
  (let [{first-name (keyword first-name-attribute)
         last-name  (keyword last-name-attribute)
         email      (keyword email-attribute)} result]
    {:dn         dn
     :first-name first-name
     :last-name  last-name
     :email      email
     :groups     (when sync-groups?
                   ;; Active Directory and others (like FreeIPA) will supply a `memberOf` overlay attribute for
                   ;; groups. Otherwise we have to make the inverse query to get them.
                   (or (u/one-or-many (:memberof result))
                       (user-groups ldap-connection dn uid settings group-membership-filter)
                       []))}))
(defenterprise-schema find-user :- [:maybe UserInfo]
  "Get user information for the supplied username."
  metabase-enterprise.enhancements.integrations.ldap
  [ldap-connection :- (ms/InstanceOfClass LDAPConnectionPool)
   username        :- ms/NonBlankString
   settings        :- LDAPSettings]
  (when-let [result (search ldap-connection username settings)]
    (ldap-search-result->user-info ldap-connection result settings group-membership-filter)))

--------------------------------------------- fetch-or-create-user! ----------------------------------------------

(mu/defn ldap-groups->mb-group-ids :- [:set ms/PositiveInt]
  "Translate a set of a user's group DNs to a set of MB group IDs using the configured mappings."
  [ldap-groups              :- [:maybe [:sequential ms/NonBlankString]]
   {:keys [group-mappings]} :- [:select-keys LDAPSettings [:group-mappings]]]
  (-> group-mappings
      (select-keys (map #(DN. (str %)) ldap-groups))
      vals
      flatten
      set))
(mu/defn all-mapped-group-ids :- [:set ms/PositiveInt]
  "Returns the set of all MB group IDs that have configured mappings."
  [{:keys [group-mappings]} :- [:select-keys LDAPSettings [:group-mappings]]]
  (-> group-mappings
      vals
      flatten
      set))
(defenterprise-schema fetch-or-create-user! :- (ms/InstanceOf User)
  "Using the `user-info` (from `find-user`) get the corresponding Metabase user, creating it if necessary."
  metabase-enterprise.enhancements.integrations.ldap
  [{:keys [first-name last-name email groups]} :- UserInfo
   {:keys [sync-groups?], :as settings}        :- LDAPSettings]
  (let [user     (t2/select-one [User :id :last_login :first_name :last_name :is_active]
                   :%lower.email (u/lower-case-en email))
        new-user (if user
                   (let [old-first-name (:first_name user)
                         old-last-name  (:last_name user)
                         user-changes   (merge
                                          (when (not= first-name old-first-name) {:first_name first-name})
                                          (when (not= last-name old-last-name) {:last_name last-name}))]
                     (if (seq user-changes)
                       (do
                         (t2/update! User (:id user) user-changes)
                         (t2/select-one [User :id :last_login :is_active] :id (:id user))) ; Reload updated user
                       user))
                   (-> (user/create-new-ldap-auth-user! {:first_name first-name
                                                         :last_name  last-name
                                                         :email      email})
                       (assoc :is_active true)))]
    (u/prog1 new-user
      (when sync-groups?
        (let [group-ids            (ldap-groups->mb-group-ids groups settings)
              all-mapped-group-ids (all-mapped-group-ids settings)]
          (integrations.common/sync-group-memberships! new-user group-ids all-mapped-group-ids))))))
 
(ns metabase.integrations.slack
  (:require
   [cheshire.core :as json]
   [clj-http.client :as http]
   [clojure.java.io :as io]
   [clojure.string :as str]
   [java-time.api :as t]
   [medley.core :as m]
   [metabase.email.messages :as messages]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date]
   [metabase.util.i18n :refer [deferred-tru trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [metabase.util.string :as u.str]))
(set! *warn-on-reflection* true)
(defsetting slack-token
  (deferred-tru
    (str "Deprecated Slack API token for connecting the Metabase Slack bot. "
         "Please use a new Slack app integration instead."))
  :deprecated "0.42.0"
  :visibility :settings-manager
  :doc        false
  :audit      :never)
(defsetting slack-app-token
  (deferred-tru
   (str "Bot user OAuth token for connecting the Metabase Slack app. "
        "This should be used for all new Slack integrations starting in Metabase v0.42.0."))
  :visibility :settings-manager
  :getter (fn []
            (-> (setting/get-value-of-type :string :slack-app-token)
                (u.str/mask 9))))
(defn- unobfuscated-slack-app-token
  []
  (setting/get-value-of-type :string :slack-app-token))
(defsetting slack-token-valid?
  (deferred-tru
    (str "Whether the current Slack app token, if set, is valid. "
         "Set to 'false' if a Slack API request returns an auth error."))
  :type       :boolean
  :visibility :settings-manager
  :doc        false
  :audit      :never)

Converts empty strings to nil, and removes leading # from the channel name if present.

(defn process-files-channel-name
  [channel-name]
  (when-not (str/blank? channel-name)
    (if (str/starts-with? channel-name "#") (subs channel-name 1) channel-name)))

A cache shared between instances for storing an instance's slack channels and users.

(defsetting slack-cached-channels-and-usernames
  :visibility :internal
  :type       :json
  :doc        false
  :audit      :never)
(def ^:private zoned-time-epoch (t/zoned-date-time 1970 1 1 0))

The updated-at time for the [[slack-cached-channels-and-usernames]] setting.

(defsetting slack-channels-and-usernames-last-updated
  :visibility :internal
  :cache?     false
  :type       :timestamp
  :default    zoned-time-epoch
  :doc        false
  :audit      :never)
(defsetting slack-files-channel
  (deferred-tru "The name of the channel to which Metabase files should be initially uploaded")
  :default "metabase_files"
  :visibility :settings-manager
  :audit      :getter
  :setter (fn [channel-name]
            (setting/set-value-of-type! :string :slack-files-channel (process-files-channel-name channel-name))))

Is Slack integration configured?

(defn slack-configured?
  []
  (boolean (or (seq (slack-app-token)) (seq (slack-token)))))

List of error codes that indicate an invalid or revoked Slack token.

(def ^:private slack-token-error-codes
  ;; If any of these error codes are received from the Slack API, we send an email to all admins indicating that the
  ;; Slack integration is broken. In practice, the "account_inactive" error code is the one that is most likely to be
  ;; received. This would happen if access to the Slack workspace is manually revoked via the Slack UI.
  #{"invalid_auth", "account_inactive", "token_revoked", "token_expired"})

Whether to send an email to all admins when an invalid or revoked token error is received in response to a Slack API call. Should be set to false when checking if an unsaved token is valid. (Default: true)

(def ^:private ^:dynamic *send-token-error-emails?*
  true)
(defn- handle-error [body]
  (let [invalid-token? (slack-token-error-codes (:error body))
        message        (if invalid-token?
                         (trs "Invalid token")
                         (trs "Slack API error: {0}" (:error body)))
        error          (if invalid-token?
                         {:error-code (:error body)
                          :errors     {:slack-token message}}
                         {:error-code (:error body)
                          :message    message
                          :response   body})]
    (when (and invalid-token? *send-token-error-emails?*)
      ;; Check `slack-token-valid?` before sending emails to avoid sending repeat emails for the same invalid token.
      ;; We should send an email if `slack-token-valid?` is `true` or `nil` (i.e. a pre-existing bot integration is
      ;; being used)
      (when (slack-token-valid?) (messages/send-slack-token-error-emails!))
      (slack-token-valid?! false))
    (when invalid-token?
      (log/warn (u/pprint-to-str 'red (trs "🔒 Your Slack authorization token is invalid or has been revoked. Please update your integration in Admin Settings -> Slack."))))
    (throw (ex-info message error))))
(defn- handle-response [{:keys [status body]}]
  (with-open [reader (io/reader body)]
    (let [body (json/parse-stream reader true)]
      (if (and (= 200 status) (:ok body))
        body
        (handle-error body)))))
(defn- do-slack-request [request-fn endpoint request]
  (let [token (or (get-in request [:query-params :token])
                  (get-in request [:form-params :token])
                  (unobfuscated-slack-app-token)
                  (slack-token))]
    (when token
      (let [url     (str "https://slack.com/api/" (name endpoint))
            _       (log/trace "Slack API request: %s %s" (pr-str url) (pr-str request))
            request (m/deep-merge
                     {:headers        {:authorization (str "Bearer\n" token)}
                      :as             :stream
                      ;; use a relatively long connection timeout (10 seconds) in cases where we're fetching big
                      ;; amounts of data -- see #11735
                      :conn-timeout   10000
                      :socket-timeout 10000}
                     (m/dissoc-in request [:query-params :token]))]
        (try
          (handle-response (request-fn url request))
          (catch Throwable e
            (throw (ex-info (.getMessage e) (merge (ex-data e) {:url url}) e))))))))

Make a GET request to the Slack API.

(defn- GET
  [endpoint & {:as query-params}]
  (do-slack-request http/get endpoint {:query-params query-params}))

Make a POST request to the Slack API.

(defn- POST
  [endpoint body]
  (do-slack-request http/post endpoint body))

Get a cursor for the next page of results in a Slack API response, if one exists.

(defn- next-cursor
  [response]
  (not-empty (get-in response [:response_metadata :next_cursor])))

Absolute maximum number of results to fetch from Slack API list endpoints. To prevent unbounded pagination of results. Don't set this too low -- some orgs have many thousands of channels (see #12978)

(def ^:private max-list-results
  10000)

Make a GET request to a Slack API list endpoint, returning a sequence of objects returned by the top level results-key in the response. If additional pages of results exist, fetches those lazily, up to a total of max-list-results.

(defn- paged-list-request
  [endpoint response->data params]
  ;; use default limit (page size) of 1000 instead of 100 so we don't end up making a hundred API requests for orgs
  ;; with a huge number of channels or users.
  (let [default-params {:limit 1000}
        response       (m/mapply GET endpoint (merge default-params params))
        data           (response->data response)]
    (when (seq response)
      (take
       max-list-results
       (concat
        data
        (when-let [next-cursor (next-cursor response)]
          (lazy-seq
           (paged-list-request endpoint response->data (assoc params :cursor next-cursor)))))))))

Transformation from slack's api representation of a channel to our own.

(defn channel-transform
  [channel]
  {:display-name (str \# (:name channel))
   :name         (:name channel)
   :id           (:id channel)
   :type         "channel"})

Calls Slack API conversations.list and returns list of available 'conversations' (channels and direct messages). By default only fetches channels, and returns them with their # prefix. Note the call to [[paged-list-request]] will only fetch the first [[max-list-results]] items.

(defn conversations-list
  [& {:as query-parameters}]
  (let [params (merge {:exclude_archived true, :types "public_channel"} query-parameters)]
    (paged-list-request "conversations.list"
                        ;; response -> channel names
                        #(->> % :channels (map channel-transform))
                        params)))

Returns a Boolean indicating whether a channel with a given name exists in the cache.

(defn channel-exists?
  [channel-name]
  (boolean
   (let [channel-names (into #{} (comp (map (juxt :name :id))
                                       cat)
                             (:channels (slack-cached-channels-and-usernames)))]
     (and channel-name (contains? channel-names channel-name)))))

Check whether a Slack token is valid by checking if the conversations.list Slack api accepts it.

(mu/defn valid-token?
  [token :- ms/NonBlankString]
  (try
    (binding [*send-token-error-emails?* false]
      (boolean (take 1 (:channels (GET "conversations.list" :limit 1, :token token)))))
    (catch Throwable e
      (if (slack-token-error-codes (:error-code (ex-data e)))
        false
        (throw e)))))

Tranformation from slack api user to our own internal representation.

(defn user-transform
  [member]
  {:display-name (str \@ (:name member))
   :type         "user"
   :name         (:name member)
   :id           (:id member)})

Calls Slack API users.list endpoint and returns the list of available users with their @ prefix. Note the call to [[paged-list-request]] will only fetch the first [[max-list-results]] items.

(defn users-list
  [& {:as query-parameters}]
  (->> (paged-list-request "users.list"
                           ;; response -> user names
                           #(->> % :members (map user-transform))
                           query-parameters)
       ;; remove deleted users and bots. At the time of this writing there's no way to do this in the Slack API
       ;; itself so we need to do it after the fact.
       (remove :deleted)
       (remove :is_bot)))
(defonce ^:private refresh-lock (Object.))
(defn- needs-refresh? []
  (u.date/older-than?
   (slack-channels-and-usernames-last-updated)
   (t/minutes 10)))

Clear the Slack channels cache, and reset its last-updated timestamp to its default value (the Unix epoch).

(defn clear-channel-cache!
  []
  (slack-channels-and-usernames-last-updated! zoned-time-epoch)
  (slack-cached-channels-and-usernames! {:channels []}))

Refreshes users and conversations in slack-cache. finds both in parallel, sets [[slack-cached-channels-and-usernames]], and resets the [[slack-channels-and-usernames-last-updated]] time.

(defn refresh-channels-and-usernames!
  []
  (when (slack-configured?)
    (log/info "Refreshing slack channels and usernames.")
    (let [users (future (vec (users-list)))
          conversations (future (vec (conversations-list)))]
      (slack-cached-channels-and-usernames! {:channels (concat @conversations @users)})
      (slack-channels-and-usernames-last-updated! (t/zoned-date-time)))))

Refreshes users and conversations in slack-cache on a per-instance lock.

(defn refresh-channels-and-usernames-when-needed!
  []
  (when (needs-refresh?)
    (locking refresh-lock
      (when (needs-refresh?)
        (refresh-channels-and-usernames!)))))

Looks in [[slack-cached-channels-and-usernames]] to check whether a channel exists with the expected name from the [[slack-files-channel]] setting with an # prefix. If it does, returns the channel details as a map. If it doesn't, throws an error that advices an admin to create it.

(defn files-channel
  []
  (let [channel-name (slack-files-channel)]
    (if (channel-exists? channel-name)
      channel-name
      (let [message (str (tru "Slack channel named `{0}` is missing!" channel-name)
                         " "
                         (tru "Please create or unarchive the channel in order to complete the Slack integration.")
                         " "
                         (tru "The channel is used for storing images that are included in dashboard subscriptions."))]
        (log/error (u/format-color 'red message))
        (throw (ex-info message {:status-code 400}))))))
(def ^:private NonEmptyByteArray
  [:and
   (ms/InstanceOfClass (Class/forName "[B"))
   [:fn not-empty]])

Given a channel ID, calls Slack API conversations.join endpoint to join the channel as the Metabase Slack app. This must be done before uploading a file to the channel, if using a Slack app integration.

(mu/defn join-channel!
  [channel-id :- ms/NonBlankString]
  (POST "conversations.join" {:form-params {:channel channel-id}}))

Slack requires the slack app to be in the channel that we post all of our attachments to. Slack changed (around June 2022 #23229) the "conversations.join" api to require the internal slack id rather than the common name. This makes a lot of sense to ensure we continue to operate despite channel renames. Attempt to look up the channel-id in the list of channels to obtain the internal id. Fallback to using the current channel-id.

(defn- maybe-lookup-id
  [channel-id cached-channels]
  (let [name->id    (into {} (comp (filter (comp #{"channel"} :type))
                                   (map (juxt :name :id)))
                          (:channels cached-channels))
        channel-id' (get name->id channel-id channel-id)]
    channel-id'))

Calls Slack API files.upload endpoint and returns the URL of the uploaded file.

(mu/defn upload-file!
  [file       :- NonEmptyByteArray
   filename   :- ms/NonBlankString
   channel-id :- ms/NonBlankString]
  {:pre [(slack-configured?)]}
  (let [request  {:multipart [{:name "file",     :content file}
                              {:name "filename", :content filename}
                              {:name "channels", :content channel-id}]}
        response (try
                   (POST "files.upload" request)
                   (catch Throwable e
                     ;; If file upload fails with a "not_in_channel" error, we join the channel and try again.
                     ;; This is expected to happen the first time a Slack subscription is sent.
                     (if (= "not_in_channel" (:error-code (ex-data e)))
                       (do (-> channel-id
                               (maybe-lookup-id (slack-cached-channels-and-usernames))
                               join-channel!)
                           (POST "files.upload" request))
                       (throw e))))]
    (u/prog1 (get-in response [:file :url_private])
      (log/debug (trs "Uploaded image") <>))))

Calls Slack API chat.postMessage endpoint and posts a message to a channel. attachments should be serialized JSON.

(mu/defn post-chat-message!
  [channel-id  :- ms/NonBlankString
   text-or-nil :- [:maybe :string]
   & [attachments]]
  ;; TODO: it would be nice to have an emoji or icon image to use here
  (POST "chat.postMessage"
        {:form-params
         {:channel     channel-id
          :username    "MetaBot"
          :icon_url    "http://static.metabase.com/metabot_slack_avatar_whitebg.png"
          :text        text-or-nil
          :attachments (when (seq attachments)
                         (json/generate-string attachments))}}))
 
(ns metabase.lib.aggregation
  (:refer-clojure :exclude [count distinct max min var])
  (:require
   [medley.core :as m]
   [metabase.lib.common :as lib.common]
   [metabase.lib.dispatch :as lib.dispatch]
   [metabase.lib.equality :as lib.equality]
   [metabase.lib.hierarchy :as lib.hierarchy]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.options :as lib.options]
   [metabase.lib.ref :as lib.ref]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.aggregation :as lib.schema.aggregation]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.temporal-bucket :as lib.temporal-bucket]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.lib.util :as lib.util]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util :as u]
   [metabase.util.malli :as mu]))
(mu/defn column-metadata->aggregation-ref :- :mbql.clause/aggregation
  "Given `:metadata/column` column metadata for an aggregation, construct an `:aggregation` reference."
  [metadata :- lib.metadata/ColumnMetadata]
  (let [options {:lib/uuid       (str (random-uuid))
                 :effective-type ((some-fn :effective-type :base-type) metadata)}
        ag-uuid (:lib/source-uuid metadata)]
    (assert ag-uuid "Metadata for an aggregation reference should include :lib/source-uuid")
    [:aggregation options ag-uuid]))
(mu/defn resolve-aggregation :- ::lib.schema.aggregation/aggregation
  "Resolve an aggregation with a specific `ag-uuid`."
  [query        :- ::lib.schema/query
   stage-number :- :int
   ag-uuid      :- :string]
  (let [{aggregations :aggregation} (lib.util/query-stage query stage-number)
        found (m/find-first (comp #{ag-uuid} :lib/uuid second) aggregations)]
    (when-not found
      (throw (ex-info (i18n/tru "No aggregation with uuid {0}" ag-uuid)
                      {:uuid         ag-uuid
                       :query        query
                       :stage-number stage-number})))
    found))
(defmethod lib.metadata.calculation/describe-top-level-key-method :aggregation
  [query stage-number _k]
  (when-let [aggregations (not-empty (:aggregation (lib.util/query-stage query stage-number)))]
    (lib.util/join-strings-with-conjunction
     (i18n/tru "and")
     (for [aggregation aggregations]
       (lib.metadata.calculation/display-name query stage-number aggregation :long)))))
(defmethod lib.metadata.calculation/metadata-method :aggregation
  [query stage-number [_ag {:keys [base-type effective-type], :as _opts} index, :as _aggregation-ref]]
  (let [aggregation (resolve-aggregation query stage-number index)]
    (merge
     (lib.metadata.calculation/metadata query stage-number aggregation)
     {:lib/source :source/aggregations
      :lib/source-uuid (:lib/uuid (second aggregation))}
     (when base-type
       {:base-type base-type})
     (when effective-type
       {:effective-type effective-type}))))

TODO -- merge this stuff into defop somehow.

(defmethod lib.metadata.calculation/display-name-method :aggregation
  [query stage-number [_tag _opts index] style]
  (lib.metadata.calculation/display-name query stage-number (resolve-aggregation query stage-number index) style))
(lib.hierarchy/derive ::count-aggregation ::aggregation)

count and cumulative count can both be used either with no args (count of rows) or with one arg (count of X, which I think means count where X is not NULL or something like that. Basically count(x) in SQL)

(doseq [tag [:count
             :cum-count]]
  (lib.hierarchy/derive tag ::count-aggregation))
(defmethod lib.metadata.calculation/display-name-method ::count-aggregation
  [query stage-number [tag _opts x] style]
  ;; x is optional.
  (if x
    (let [x-display-name (lib.metadata.calculation/display-name query stage-number x style)]
      (case tag
        :count     (i18n/tru "Count of {0}" x-display-name)
        :cum-count (i18n/tru "Cumulative count of {0}" x-display-name)))
    (case tag
      :count     (i18n/tru "Count")
      :cum-count (i18n/tru "Cumulative count"))))
(defmethod lib.metadata.calculation/column-name-method ::count-aggregation
  [_query _stage-number [tag :as _clause]]
  (case tag
    :count     "count"
    :cum-count "cum_count"))
(defmethod lib.metadata.calculation/metadata-method ::count-aggregation
  [query stage-number clause]
  (assoc ((get-method lib.metadata.calculation/metadata-method ::aggregation) query stage-number clause)
         :semantic-type :type/Quantity))
(defmethod lib.metadata.calculation/display-name-method :case
  [_query _stage-number _case _style]
  (i18n/tru "Case"))
(defmethod lib.metadata.calculation/column-name-method :case
  [_query _stage-number _case]
  "case")

TODO - Should :case derive from ::aggregation as well???

(lib.hierarchy/derive ::unary-aggregation ::aggregation)
(doseq [tag [:avg
             :cum-sum
             :distinct
             :max
             :median
             :min
             :stddev
             :sum
             :var]]
  (lib.hierarchy/derive tag ::unary-aggregation))
(defmethod lib.metadata.calculation/column-name-method ::unary-aggregation
  [_query _stage-number [tag _opts _arg]]
  (case tag
    :avg       "avg"
    :cum-sum   "sum"
    :distinct  "count"
    :max       "max"
    :median    "median"
    :min       "min"
    :stddev    "stddev"
    :sum       "sum"
    :var       "var"))
(defmethod lib.metadata.calculation/display-name-method ::unary-aggregation
  [query stage-number [tag _opts arg] style]
  (let [arg (lib.metadata.calculation/display-name query stage-number arg style)]
    (case tag
      :avg       (i18n/tru "Average of {0}"            arg)
      :cum-sum   (i18n/tru "Cumulative sum of {0}"     arg)
      :distinct  (i18n/tru "Distinct values of {0}"    arg)
      :max       (i18n/tru "Max of {0}"                arg)
      :median    (i18n/tru "Median of {0}"             arg)
      :min       (i18n/tru "Min of {0}"                arg)
      :stddev    (i18n/tru "Standard deviation of {0}" arg)
      :sum       (i18n/tru "Sum of {0}"                arg)
      :var       (i18n/tru "Variance of {0}"           arg))))
(defmethod lib.metadata.calculation/display-name-method :percentile
  [query stage-number [_percentile _opts x p] style]
  (i18n/tru "{0}th percentile of {1}" p (lib.metadata.calculation/display-name query stage-number x style)))
(defmethod lib.metadata.calculation/column-name-method :percentile
  [_query _stage-number _clause]
  "percentile")
(lib.hierarchy/derive :percentile ::aggregation)

we don't currently have sophisticated logic for generating nice display names for filter clauses.

TODO : wait a minute, we do have that stuff now!

(defmethod lib.metadata.calculation/display-name-method :sum-where
  [query stage-number [_sum-where _opts x _pred] style]
  (i18n/tru "Sum of {0} matching condition" (lib.metadata.calculation/display-name query stage-number x style)))
(defmethod lib.metadata.calculation/column-name-method :sum-where
  [query stage-number [_sum-where _opts x _pred]]
  (str "sum_where_" (lib.metadata.calculation/column-name query stage-number x)))
(lib.hierarchy/derive :sum-where ::aggregation)
(defmethod lib.metadata.calculation/display-name-method :share
  [_query _stage-number _share _style]
  (i18n/tru "Share of rows matching condition"))
(defmethod lib.metadata.calculation/column-name-method :share
  [_query _stage-number _share]
  "share")
(lib.hierarchy/derive :share ::aggregation)
(defmethod lib.metadata.calculation/display-name-method :count-where
  [_query _stage-number _count-where _style]
  (i18n/tru "Count of rows matching condition"))
(defmethod lib.metadata.calculation/column-name-method :count-where
  [_query _stage-number _count-where]
  "count-where")
(lib.hierarchy/derive :count-where ::aggregation)
(defmethod lib.metadata.calculation/metadata-method ::aggregation
  [query stage-number [_tag _opts first-arg :as clause]]
  (merge
   ;; flow the `:options` from the field we're aggregating. This is important, for some reason.
   ;; See [[metabase.query-processor-test.aggregation-test/field-settings-for-aggregate-fields-test]]
   (when first-arg
     (select-keys (lib.metadata.calculation/metadata query stage-number first-arg) [:settings]))
   ((get-method lib.metadata.calculation/metadata-method :default) query stage-number clause)))
(lib.common/defop count       [] [x])
(lib.common/defop cum-count   [] [x])
(lib.common/defop count-where [x y])
(lib.common/defop avg         [x])
(lib.common/defop distinct    [x])
(lib.common/defop max         [x])
(lib.common/defop median      [x])
(lib.common/defop min         [x])
(lib.common/defop percentile  [x y])
(lib.common/defop share       [x])
(lib.common/defop stddev      [x])
(lib.common/defop sum         [x])
(lib.common/defop cum-sum     [x])
(lib.common/defop sum-where   [x y])
(lib.common/defop var         [x])
(defmethod lib.ref/ref-method :aggregation
  [aggregation-clause]
  aggregation-clause)

Schema for something you can pass to [[aggregate]] to add to a query as an aggregation.

(def ^:private Aggregable
  [:or
   ::lib.schema.aggregation/aggregation
   ::lib.schema.common/external-op
   lib.metadata/MetricMetadata])
(mu/defn aggregate :- ::lib.schema/query
  "Adds an aggregation to query."
  ([query aggregable]
   (aggregate query -1 aggregable))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    aggregable :- Aggregable]
   ;; if this is a Metric metadata, convert it to `:metric` MBQL clause before adding.
   (if (= (lib.dispatch/dispatch-value aggregable) :metadata/metric)
     (recur query stage-number (lib.ref/ref aggregable))
     (lib.util/add-summary-clause query stage-number :aggregation aggregable))))
(mu/defn aggregations :- [:maybe [:sequential ::lib.schema.aggregation/aggregation]]
  "Get the aggregations in a given stage of a query."
  ([query]
   (aggregations query -1))
  ([query        :- ::lib.schema/query
    stage-number :- :int]
   (not-empty (:aggregation (lib.util/query-stage query stage-number)))))
(mu/defn aggregations-metadata :- [:maybe [:sequential lib.metadata/ColumnMetadata]]
  "Get metadata about the aggregations in a given stage of a query."
  ([query]
   (aggregations-metadata query -1))
  ([query        :- ::lib.schema/query
    stage-number :- :int]
   (some->> (not-empty (:aggregation (lib.util/query-stage query stage-number)))
            (into [] (map (fn [aggregation]
                            (let [metadata (lib.metadata.calculation/metadata query stage-number aggregation)]
                              (-> metadata
                                  (u/assoc-default :effective-type (or (:base-type metadata) :type/*))
                                  (assoc :lib/source :source/aggregations
                                         :lib/source-uuid (:lib/uuid (second aggregation)))))))))))
(def ^:private OperatorWithColumns
  [:merge
   ::lib.schema.aggregation/operator
   [:map
    [:columns {:optional true} [:sequential lib.metadata/ColumnMetadata]]]])
(defmethod lib.metadata.calculation/display-name-method :operator/aggregation
  [_query _stage-number {:keys [display-info]} _display-name-style]
  (:display-name (display-info)))
(defmethod lib.metadata.calculation/display-info-method :operator/aggregation
  [_query _stage-number {:keys [display-info requires-column? selected?] short-name :short}]
  (cond-> (assoc (display-info)
                 :short-name (u/qualified-name short-name)
                 :requires-column requires-column?)
    (some? selected?) (assoc :selected selected?)))
(mu/defn aggregation-operator-columns :- [:maybe [:sequential lib.metadata/ColumnMetadata]]
  "Returns the columns for which `aggregation-operator` is applicable."
  [aggregation-operator :- OperatorWithColumns]
  (:columns aggregation-operator))
(mu/defn available-aggregation-operators :- [:maybe [:sequential OperatorWithColumns]]
  "Returns the available aggegation operators for the stage with `stage-number` of `query`.
  If `stage-number` is omitted, uses the last stage."
  ([query]
   (available-aggregation-operators query -1))
  ([query :- ::lib.schema/query
    stage-number :- :int]
   (let [db-features (or (:features (lib.metadata/database query)) #{})
         stage (lib.util/query-stage query stage-number)
         columns (lib.metadata.calculation/visible-columns query stage-number stage)
         with-columns (fn [{:keys [requires-column? supported-field] :as operator}]
                        (cond
                          (not requires-column?)
                          operator
                          (= supported-field :any)
                          (assoc operator :columns columns)
                          :else
                          (when-let [cols (->> columns
                                               (filterv #(lib.types.isa/field-type? supported-field %))
                                               not-empty)]
                            (assoc operator :columns cols))))]
     (not-empty
      (into []
            (comp (filter (fn [op]
                            (let [feature (:driver-feature op)]
                              (or (nil? feature) (db-features feature)))))
                  (keep with-columns)
                  (map #(assoc % :lib/type :operator/aggregation)))
            lib.schema.aggregation/aggregation-operators)))))
(mu/defn aggregation-clause :- ::lib.schema.aggregation/aggregation
  "Returns a standalone aggregation clause for an `aggregation-operator` and
  a `column`.
  For aggregations requiring an argument `column` is mandatory, otherwise
  it is optional."
  ([aggregation-operator :- ::lib.schema.aggregation/operator]
   (if-not (:requires-column? aggregation-operator)
     (lib.options/ensure-uuid [(:short aggregation-operator) {}])
     (throw (ex-info (lib.util/format "aggregation operator %s requires an argument"
                                      (:short aggregation-operator))
                     {:aggregation-operator aggregation-operator}))))
  ([aggregation-operator :- ::lib.schema.aggregation/operator
    column]
   (lib.options/ensure-uuid [(:short aggregation-operator) {} (lib.common/->op-arg column)])))
(def ^:private SelectedOperatorWithColumns
  [:merge
   ::lib.schema.aggregation/operator
   [:map
    [:columns {:optional true} [:sequential lib.metadata/ColumnMetadata]]
    [:selected? {:optional true} :boolean]]])
(mu/defn selected-aggregation-operators :- [:maybe [:sequential SelectedOperatorWithColumns]]
  "Mark the operator and the column (if any) in `agg-operators` selected by `agg-clause`."
  [agg-operators :- [:maybe [:sequential OperatorWithColumns]]
   agg-clause]
  (when (seq agg-operators)
    (let [[op _ agg-col] agg-clause
          agg-temporal-unit (-> agg-col lib.options/options :temporal-unit)]
      (mapv (fn [agg-op]
              (cond-> agg-op
                (= (:short agg-op) op)
                (-> (assoc :selected? true)
                    (m/update-existing
                      :columns
                      (fn [cols]
                        (if (lib.util/ref-clause? agg-col)
                          (let [cols (lib.equality/mark-selected-columns
                                       cols
                                       [(lib.options/update-options agg-col dissoc :temporal-unit)])]
                            (mapv (fn [c]
                                    (cond-> c
                                      (some? agg-temporal-unit)
                                      (lib.temporal-bucket/with-temporal-bucket agg-temporal-unit)))
                                  cols))
                          cols))))))
            agg-operators))))
(mu/defn aggregation-ref :- :mbql.clause/aggregation
  "Find the aggregation at `ag-index` and create an `:aggregation` ref for it. Intended for use
  when creating queries using threading macros e.g.
    (-> (lib/query ...)
        (lib/aggregate (lib/avg ...))
        (as-> <> (lib/order-by <> (lib/aggregation-ref <> 0))))"
  ([query ag-index]
   (aggregation-ref query -1 ag-index))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    ag-index     :- ::lib.schema.common/int-greater-than-or-equal-to-zero]
   (if-let [[_ {ag-uuid :lib/uuid}] (get (:aggregation (lib.util/query-stage query stage-number)) ag-index)]
     (lib.options/ensure-uuid [:aggregation {} ag-uuid])
     (throw (ex-info (str "Undefined aggregation " ag-index)
                     {:aggregation-index ag-index
                      :query             query
                      :stage-number      stage-number})))))
(mu/defn aggregation-at-index :- [:maybe ::lib.schema.aggregation/aggregation]
  "Get the aggregation at `index` in a stage of the query if it exists, otherwise `nil`. This is mostly for working
  with legacy references like
    [:aggregation 0]"
  [query        :- ::lib.schema/query
   stage-number :- :int
   index        :- ::lib.schema.common/int-greater-than-or-equal-to-zero]
  (let [ags (aggregations query stage-number)]
    (when (> (clojure.core/count ags) index)
      (nth ags index))))
 
(ns metabase.lib.binning
  (:require
   [metabase.lib.binning.util :as lib.binning.util]
   [metabase.lib.dispatch :as lib.dispatch]
   [metabase.lib.hierarchy :as lib.hierarchy]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.binning :as lib.schema.binning]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.shared.formatting.numbers :as fmt.num]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util.malli :as mu]))

Implementation for [[with-binning]]. Implement this to tell [[with-binning]] how to add binning to a particular MBQL clause.

(defmulti with-binning-method
  {:arglists '([x binning])}
  (fn [x _binning]
    (lib.dispatch/dispatch-value x)) :hierarchy lib.hierarchy/hierarchy)

Add binning to an MBQL clause or something that can be converted to an MBQL clause. Eg. for a Field or Field metadata or :field clause, this might do something like this:

(with-binning some-field (bin-by :num-bins 4))

=>

[:field {:binning {:strategy :num-bins :num-bins 4}} 1]

Pass nil binning to remove any binning.

(mu/defn with-binning
  {:style/indent [:form]}
  [x binning :- [:maybe [:or ::lib.schema.binning/binning ::lib.schema.binning/binning-option]]]
  (with-binning-method x (if (contains? binning :mbql)
                           (:mbql binning)
                           binning)))

Implementation of [[binning]]. Return the current binning options associated with x.

(defmulti binning-method
  {:arglists '([x])}
  lib.dispatch/dispatch-value
  :hierarchy lib.hierarchy/hierarchy)
(defmethod binning-method :default
  [_x]
  nil)
(mu/defn binning :- [:maybe ::lib.schema.binning/binning]
  "Get the current binning options associated with `x`, if any."
  [x]
  (binning-method x))

Implementation for [[available-binning-strategies]]. Return a set of binning strategies from :metabase.lib.schema.binning/strategy that are allowed to be used with x.

(defmulti available-binning-strategies-method
  {:arglists '([query stage-number x])}
  (fn [_query _stage-number x]
    (lib.dispatch/dispatch-value x))
  :hierarchy lib.hierarchy/hierarchy)
(defmethod available-binning-strategies-method :default
  [_query _stage-number _x]
  nil)
(mu/defn available-binning-strategies :- [:sequential [:ref ::lib.schema.binning/binning-option]]
  "Get a set of available binning strategies for `x`. Returns nil if none are available."
  ([query x]
   (available-binning-strategies query -1 x))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    x]
   (available-binning-strategies-method query stage-number x)))
(mu/defn default-auto-bin :- ::lib.schema.binning/binning-option
  "Returns the basic auto-binning strategy.
  Public because it's used directly by some drill-thrus."
  []
  {:lib/type     :option/binning
   :display-name (i18n/tru "Auto bin")
   :default      true
   :mbql         {:strategy :default}})
(defn- with-binning-option-type [m]
  (assoc m :lib/type :option/binning))
(mu/defn numeric-binning-strategies :- [:sequential ::lib.schema.binning/binning-option]
  "List of binning options for numeric fields. These split the data evenly into a fixed number of bins."
  []
  (mapv with-binning-option-type
        [(default-auto-bin)
         {:display-name (i18n/tru "10 bins")  :mbql {:strategy :num-bins :num-bins 10}}
         {:display-name (i18n/tru "50 bins")  :mbql {:strategy :num-bins :num-bins 50}}
         {:display-name (i18n/tru "100 bins") :mbql {:strategy :num-bins :num-bins 100}}]))
(mu/defn coordinate-binning-strategies :- [:sequential ::lib.schema.binning/binning-option]
  "List of binning options for coordinate fields (ie. latitude and longitude). These split the data into as many
  ranges as necessary, with each range being a certain number of degrees wide."
  []
  (mapv with-binning-option-type
        [(default-auto-bin)
         {:display-name (i18n/tru "Bin every 0.1 degrees") :mbql {:strategy :bin-width :bin-width 0.1}}
         {:display-name (i18n/tru "Bin every 1 degree")    :mbql {:strategy :bin-width :bin-width 1.0}}
         {:display-name (i18n/tru "Bin every 10 degrees")  :mbql {:strategy :bin-width :bin-width 10.0}}
         {:display-name (i18n/tru "Bin every 20 degrees")  :mbql {:strategy :bin-width :bin-width 20.0}}]))
(mu/defn binning-display-name :- ::lib.schema.common/non-blank-string
  "This is implemented outside of [[lib.metadata.calculation/display-name]] because it needs access to the field type.
  It's called directly by `:field` or `:metadata/column`'s [[lib.metadata.calculation/display-name]]."
  [{:keys [bin-width num-bins strategy] :as binning-options} :- ::lib.schema.binning/binning
   column-metadata                                           :- ::lib.schema.metadata/column]
  (when binning-options
    (case strategy
      :num-bins  (i18n/trun "{0} bin" "{0} bins" num-bins)
      :bin-width (str (fmt.num/format-number bin-width {})
                      (when (isa? (:semantic-type column-metadata) :type/Coordinate)
                        "°"))
      :default   (i18n/tru "Auto binned"))))
(defmethod lib.metadata.calculation/display-info-method :option/binning
  [_query _stage-number binning-option]
  (select-keys binning-option [:display-name :default :selected]))
(defmethod lib.metadata.calculation/display-info-method ::binning
  [query stage-number binning-value]
  (let [field-metadata ((:metadata-fn binning-value) query stage-number)]
    (merge {:display-name (binning-display-name binning-value field-metadata)}
           (when (= :default (:strategy binning-value))
             {:default true}))))
(mu/defn strategy= :- boolean?
  "Given a binning option (as returned by [[available-binning-strategies]]) and the binning value (possibly nil) from
  a column, check if they match."
  [binning-option :- ::lib.schema.binning/binning-option
   column-binning :- [:maybe ::lib.schema.binning/binning]]
  (= (:mbql binning-option)
     (select-keys column-binning [:strategy :num-bins :bin-width])))
(mu/defn resolve-bin-width :- [:maybe [:map
                                       [:bin-width ::lib.schema.binning/bin-width]
                                       [:min-value number?]
                                       [:max-value number?]]]
  "If a `column` is binned, resolve the actual bin width that will be used when a query is processed as well as min
  and max values."
  [metadata-providerable :- ::lib.schema.metadata/metadata-providerable
   column-metadata       :- ::lib.schema.metadata/column
   value                 :- number?]
  (when-let [binning-options (binning column-metadata)]
    (case (:strategy binning-options)
      :num-bins
      (when-let [{min-value :min, max-value :max, :as _number-fingerprint} (get-in column-metadata [:fingerprint :type :type/Number])]
        (let [{:keys [num-bins]} binning-options
              bin-width          (lib.binning.util/nicer-bin-width min-value max-value num-bins)]
          {:bin-width bin-width
           :min-value value
           :max-value (+ value bin-width)}))
      :bin-width
      (let [{:keys [bin-width]} binning-options]
        (assert (number? bin-width))
        {:bin-width bin-width
         :min-value value
         :max-value (+ value bin-width)})
      :default
      (when-let [{min-value :min, max-value :max, :as _number-fingerprint} (get-in column-metadata [:fingerprint :type :type/Number])]
        (when-let [[_strategy {:keys [bin-width]}] (lib.binning.util/resolve-options metadata-providerable
                                                                                     :default
                                                                                     nil
                                                                                     column-metadata
                                                                                     min-value
                                                                                     max-value)]
          {:bin-width bin-width
           :min-value value
           :max-value (+ value bin-width)})))))
 
(ns metabase.lib.binning.util
  (:require
   [clojure.math :as math]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.schema.binning :as lib.schema.binning]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.util :as u]
   [metabase.util.malli :as mu]))
(mu/defn ^:private calculate-bin-width :- ::lib.schema.binning/bin-width
  "Calculate bin width required to cover interval [`min-value`, `max-value`] with `num-bins`."
  [min-value :- number?
   max-value :- number?
   num-bins  :- ::lib.schema.binning/num-bins]
  (u/round-to-decimals 5 (/ (- max-value min-value)
                            num-bins)))
(mu/defn ^:private calculate-num-bins :- ::lib.schema.binning/num-bins
  "Calculate number of bins of width `bin-width` required to cover interval [`min-value`, `max-value`]."
  [min-value :- number?
   max-value :- number?
   bin-width :- ::lib.schema.binning/bin-width]
  (max (long (math/ceil (/ (- max-value min-value)
                           bin-width)))
       1))
(def ^:private ResolvedStrategy
  [:tuple
   [:enum :bin-width :num-bins]
   [:map
    [:bin-width ::lib.schema.binning/bin-width]
    [:num-bins  ::lib.schema.binning/num-bins]]])
(mu/defn ^:private resolve-default-strategy :- ResolvedStrategy
  "Determine the approprate strategy & options to use when `:default` strategy was specified."
  [metadata-providerable :- ::lib.schema.metadata/metadata-providerable
   column                :- ::lib.schema.metadata/column
   min-value             :- number?
   max-value             :- number?]
  (if (lib.types.isa/coordinate? column)
    (let [bin-width (lib.metadata/setting metadata-providerable :breakout-bin-width)]
      [:bin-width
       {:bin-width bin-width
        :num-bins  (calculate-num-bins min-value max-value bin-width)}])
    (let [num-bins (lib.metadata/setting metadata-providerable :breakout-bins-num)]
      [:num-bins
       {:num-bins  num-bins
        :bin-width (calculate-bin-width min-value max-value num-bins)}])))

------------------------------------- Humanized binning with nicer-breakout --------------------------------------

(defn- ceil-to
  [precision x]
  (* (math/ceil (/ x precision)) precision))
(defn- floor-to
  [precision x]
  (* (math/floor (/ x precision)) precision))
(def ^:private pleasing-numbers [1 1.25 2 2.5 3 5 7.5 10])
(mu/defn nicer-bin-width :- ::lib.schema.binning/bin-width
  "Calculate the bin width we should use for `:num-bins` binning based on `min-value` and `max-value`, taken from a
  column's fingerprint... rather than simply doing
    (/ (- max-value min-value) num-bins)
  this function attempts to return a 'pleasing' bin width, e.g. 20 instead of 15.01."
  [min-value :- number?
   max-value :- number?
   num-bins  :- ::lib.schema.binning/num-bins]
  (let [min-bin-width (calculate-bin-width min-value max-value num-bins)
        scale         (math/pow 10 (u/order-of-magnitude min-bin-width))]
    (some (fn [pleasing-number]
            (let [candidate-width (* pleasing-number scale)]
              (when (>= candidate-width min-bin-width)
                candidate-width)))
          pleasing-numbers)))
(mu/defn ^:private nicer-bounds :- [:tuple number? number?]
  [min-value :- number?
   max-value :- number?
   bin-width :- ::lib.schema.binning/bin-width]
  [(floor-to bin-width min-value) (ceil-to bin-width max-value)])
(def ^:private ^:const max-steps 10)
(defn- fixed-point
  [f]
  (fn [x]
    (->> (iterate f x)
         (partition 2 1)
         (take max-steps)
         (drop-while (partial apply not=))
         ffirst)))
(mu/defn ^:private nicer-breakout* :- :map
  "Humanize binning: extend interval to start and end on a \"nice\" number and, when number of bins is fixed, have a
  \"nice\" step (bin width)."
  [strategy                                         :- ::lib.schema.binning/strategy
   {:keys [min-value max-value bin-width num-bins]} :- [:map
                                                        [:min-value number?]
                                                        [:max-value number?]
                                                        [:bin-width {:optional true} ::lib.schema.binning/bin-width]
                                                        [:num-bins  {:optional true} ::lib.schema.binning/num-bins]]]
  (let [bin-width             (if (= strategy :num-bins)
                                (nicer-bin-width min-value max-value num-bins)
                                bin-width)
        [min-value max-value] (nicer-bounds min-value max-value bin-width)]
    {:min-value min-value
     :max-value max-value
     :num-bins  (if (= strategy :num-bins)
                  num-bins
                  (calculate-num-bins min-value max-value bin-width))
     :bin-width bin-width}))
(mu/defn nicer-breakout :- [:maybe :map]
  "Make the current breakout a little nicer? Not 100% sure exactly how this is used, refer
  to [[metabase.query-processor.middleware.binning/update-binned-field]]."
  [strategy :- ::lib.schema.binning/strategy
   opts     :- :map]
  (let [f (partial nicer-breakout* strategy)]
    ((fixed-point f) opts)))
(mu/defn resolve-options :- ResolvedStrategy
  "Given any binning `:strategy`, determine the `:bin-width` and `:num-bins` we should use based on the column's
  fingerprint."
  [metadata-providerable :- ::lib.schema.metadata/metadata-providerable
   strategy              :- ::lib.schema.binning/strategy
   strategy-param        :- [:maybe number?]
   column                :- ::lib.schema.metadata/column
   min-value             :- number?
   max-value             :- number?]
  (case strategy
    :num-bins
    [:num-bins
     {:num-bins  strategy-param
      :bin-width (calculate-bin-width min-value max-value strategy-param)}]
    :bin-width
    [:bin-width
     {:bin-width strategy-param
      :num-bins  (calculate-num-bins min-value max-value strategy-param)}]
    :default
    (resolve-default-strategy metadata-providerable column min-value max-value)))
 
(ns metabase.lib.breakout
  (:require
   [clojure.string :as str]
   [metabase.lib.equality :as lib.equality]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.ref :as lib.ref]
   [metabase.lib.remove-replace :as lib.remove-replace]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.expression :as lib.schema.expression]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.lib.schema.ref :as lib.schema.ref]
   [metabase.lib.temporal-bucket :as lib.temporal-bucket]
   [metabase.lib.util :as lib.util]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util.malli :as mu]))
(defmethod lib.metadata.calculation/describe-top-level-key-method :breakout
  [query stage-number _k]
  (when-let [breakouts (not-empty (:breakout (lib.util/query-stage query stage-number)))]
    (i18n/tru "Grouped by {0}"
              (str/join (str \space (i18n/tru "and") \space)
                        (for [breakout breakouts]
                          (lib.metadata.calculation/display-name query stage-number breakout :long))))))
(mu/defn breakout :- ::lib.schema/query
  "Add a new breakout on an expression, presumably a Field reference."
  ([query expr]
   (breakout query -1 expr))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    expr         :- some?]
   (let [expr (lib.ref/ref (if (fn? expr)
                             (expr query stage-number)
                             expr))]
     (lib.util/add-summary-clause query stage-number :breakout expr))))
(mu/defn breakouts :- [:maybe [:sequential ::lib.schema.expression/expression]]
  "Return the current breakouts"
  ([query]
   (breakouts query -1))
  ([query :- ::lib.schema/query
    stage-number :- :int]
   (not-empty (:breakout (lib.util/query-stage query stage-number)))))
(mu/defn breakouts-metadata :- [:maybe [:sequential ::lib.schema.metadata/column]]
  "Get metadata about the breakouts in a given stage of a `query`."
  ([query]
   (breakouts-metadata query -1))
  ([query        :- ::lib.schema/query
    stage-number :- :int]
   (some->> (breakouts query stage-number)
            (mapv (fn [field-ref]
                    (-> (lib.metadata.calculation/metadata query stage-number field-ref)
                        (assoc :lib/source :source/breakouts)))))))
(mu/defn breakoutable-columns :- [:sequential ::lib.schema.metadata/column]
  "Get column metadata for all the columns that can be broken out by in
  the stage number `stage-number` of the query `query`
  If `stage-number` is omitted, the last stage is used.
  The rules for determining which columns can be broken out by are as follows:
  1. custom `:expressions` in this stage of the query
  2. Fields 'exported' by the previous stage of the query, if there is one;
     otherwise Fields from the current `:source-table`
  3. Fields exported by explicit joins
  4. Fields in Tables that are implicitly joinable."
  ([query :- ::lib.schema/query]
   (breakoutable-columns query -1))
  ([query        :- ::lib.schema/query
    stage-number :- :int]
   (let [cols (let [stage   (lib.util/query-stage query stage-number)
                    options {:include-implicitly-joinable-for-source-card? false}]
                (lib.metadata.calculation/visible-columns query stage-number stage options))]
     (when (seq cols)
       (let [matching (into {} (keep-indexed (fn [index a-breakout]
                                               (when-let [col (lib.equality/find-matching-column
                                                               query stage-number a-breakout cols
                                                               {:generous? true})]
                                                 [col index]))
                                             (or (breakouts query stage-number) [])))]
         (mapv #(let [pos (matching %)]
                  (cond-> %
                    pos (assoc :breakout-position pos)))
               cols))))))
(mu/defn existing-breakouts :- [:maybe [:sequential {:min 1} ::lib.schema.ref/ref]]
  "Returns existing breakouts (as MBQL expressions) for `column` in a stage if there are any. Returns `nil` if there
  are no existing breakouts."
  ([query stage-number column]
   (existing-breakouts query stage-number column nil))
  ([query                                         :- ::lib.schema/query
    stage-number                                  :- :int
    column                                        :- ::lib.schema.metadata/column
    {:keys [same-temporal-bucket?], :as _options} :- [:maybe
                                                      [:map
                                                       [:same-temporal-bucket? {:optional true} [:maybe :boolean]]]]]
   (not-empty
    (into []
          (filter (fn [a-breakout]
                    (and (lib.equality/find-matching-column query stage-number a-breakout [column] {:generous? true})
                         (if same-temporal-bucket?
                           (= (lib.temporal-bucket/temporal-bucket a-breakout)
                              (lib.temporal-bucket/temporal-bucket column))
                           true))))
          (breakouts query stage-number)))))

Returns if column is a breakout column of stage with stage-number of query.

(defn breakout-column?
  [query stage-number column]
  (seq (existing-breakouts query stage-number column)))
(mu/defn remove-existing-breakouts-for-column :- ::lib.schema/query
  "Remove all existing breakouts against `column` if there are any in the stage in question. Disregards temporal
  bucketing and binning."
  ([query column]
   (remove-existing-breakouts-for-column query -1 column))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    column       :- ::lib.schema.metadata/column]
   (reduce
    (fn [query a-breakout]
      (lib.remove-replace/remove-clause query stage-number a-breakout))
    query
    (existing-breakouts query stage-number column))))
 
(ns metabase.lib.cache)

(CLJS only; this is a pass-through in CLJ.)

Attaches a JS property __mbcache to x (a JS object or CLJS map) if it doesn't already have one. This property holds an (atom {}), which is used as a "personal" cache attached to x. This property is ignored by CLJS, which only uses specific keys on the JS objects used to implement CLJS maps. Since CLJS maps are immutable, any assoc, update, etc. will create a new object without the cache property.

If there is not already a key subkey in the map, calls (f x) and caches the value at subkey. If there is a value at subkey, it is returned directly.

(defn side-channel-cache
  [subkey x f]
  (comment subkey) ; Avoids lint warning for half-unused `subkey`.
  #?(:clj  (f x)
     :cljs (if (or (object? x) (map? x))
             (do
               (when-not (.-__mbcache ^js x)
                 (set! (.-__mbcache ^js x) (atom {})))
               (if-let [cache (.-__mbcache ^js x)]
                 (if-let [cached (get @cache subkey)]
                   cached
                   ;; Cache miss - generate the value and cache it.
                   (let [value (f x)]
                     (swap! cache assoc subkey value)
                     value))
                 (f x)))
             (f x))))
 
(ns metabase.lib.card
  (:require
   [metabase.lib.convert :as lib.convert]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.query :as lib.query]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.lib.util :as lib.util]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util :as u]
   [metabase.util.humanization :as u.humanization]
   [metabase.util.malli :as mu]))
(defmethod lib.metadata.calculation/display-name-method :metadata/card
  [_query _stage-number card-metadata _style]
  ((some-fn :display-name :name) card-metadata))
(defmethod lib.metadata.calculation/metadata-method :metadata/card
  [_query _stage-number {card-name :name, :keys [display-name], :as card-metadata}]
  (cond-> card-metadata
    (not display-name) (assoc :display-name (u.humanization/name->human-readable-name :simple card-name))))
(defmethod lib.metadata.calculation/visible-columns-method :metadata/card
  [query
   stage-number
   {:keys [fields result-metadata] :as card-metadata}
   {:keys [include-implicitly-joinable? unique-name-fn] :as options}]
  (concat
    (lib.metadata.calculation/returned-columns query stage-number card-metadata options)
    (when include-implicitly-joinable?
      (lib.metadata.calculation/implicitly-joinable-columns
        query stage-number (concat fields result-metadata) unique-name-fn))))
(mu/defn fallback-display-name :- ::lib.schema.common/non-blank-string
  "If for some reason the metadata is unavailable. This is better than returning nothing I guess."
  [card-id :- ::lib.schema.id/card]
  (i18n/tru "Question {0}" (pr-str card-id)))
(defmethod lib.metadata.calculation/describe-top-level-key-method :source-card
  [query stage-number _k]
  (let [{:keys [source-card]} (lib.util/query-stage query stage-number)]
    (when source-card
      (or (when-let [card-metadata (lib.metadata/card query source-card)]
            (lib.metadata.calculation/display-name query stage-number card-metadata :long))
          (fallback-display-name source-card)))))
(mu/defn ^:private infer-returned-columns :- [:maybe [:sequential ::lib.schema.metadata/column]]
  [metadata-providerable :- lib.metadata/MetadataProviderable
   card-query            :- :map]
  (when (some? card-query)
    (lib.metadata.calculation/returned-columns (lib.query/query metadata-providerable (lib.convert/->pMBQL card-query)))))
(def ^:private Card
  [:map
   {:error/message "Card with :dataset-query"}
   [:dataset-query :map]])

Things are fundamentally broken because of #29763, and every time I try to fix this is ends up being a giant mess to untangle. The FE currently ignores results metadata for ad-hoc queries, and thus cannot match up 'correct' Field refs like 'Products__CATEGORY'... for the time being we'll have to force ID refs even when we should be using nominal refs so as to not completely destroy the FE. Once we port more stuff over maybe we can fix this.

(def ^:dynamic *force-broken-card-refs*
  true)
(mu/defn ->card-metadata-column :- ::lib.schema.metadata/column
  "Massage possibly-legacy Card results metadata into MLv2 ColumnMetadata."
  ([metadata-providerable col]
   (->card-metadata-column metadata-providerable nil col))
  ([metadata-providerable :- lib.metadata/MetadataProviderable
    card-or-id            :- [:maybe [:or ::lib.schema.id/card ::lib.schema.metadata/card]]
    col                   :- :map]
   (let [col (-> col
                 (update-keys u/->kebab-case-en)
                 ;; ignore `:field-ref`, it's very likely a legacy field ref, and it's probably wrong either way. We
                 ;; can always calculate a new one.
                 (dissoc :field-ref))]
     (merge
      {:base-type :type/*, :lib/type :metadata/column}
      (when-let [field-id (:id col)]
        (try
          (lib.metadata/field metadata-providerable field-id)
          (catch #?(:clj Throwable :cljs :default) _
            nil)))
      col
      {:lib/type                :metadata/column
       :lib/source              :source/card
       :lib/source-column-alias ((some-fn :lib/source-column-alias :name) col)}
      (when card-or-id
        {:lib/card-id (u/the-id card-or-id)})
      (when (and *force-broken-card-refs*
                 ;; never force broken refs for datasets, because datasets can have give columns with completely
                 ;; different names the Field ID of a different column, somehow. See #22715
                 (or
                  ;; we can only do this check if `card-or-id` is passed in.
                  (not card-or-id)
                  (not (:dataset (lib.metadata/card metadata-providerable (u/the-id card-or-id))))))
        {::force-broken-id-refs true}
        #_(when-let [legacy-join-alias (:source-alias col)]
            {:lib/desired-column-alias (lib.util/format "%s__%s" legacy-join-alias (:name col))}))))))
(def ^:private CardColumnMetadata
  [:merge
   ::lib.schema.metadata/column
   [:map
    [:lib/source [:= :source/card]]]])
(def ^:private CardColumns
  [:maybe [:sequential {:min 1} CardColumnMetadata]])
(mu/defn ^:private card-metadata-columns :- CardColumns
  [metadata-providerable :- lib.metadata/MetadataProviderable
   card                  :- Card]
  (when-let [result-metadata (or (:fields card)
                                 (:result-metadata card)
                                 (infer-returned-columns metadata-providerable (:dataset-query card)))]
    ;; Card `result-metadata` SHOULD be a sequence of column infos, but just to be safe handle a map that
    ;; contains` :columns` as well.
    (when-let [cols (not-empty (cond
                                 (map? result-metadata)        (:columns result-metadata)
                                 (sequential? result-metadata) result-metadata))]
      (mapv (partial ->card-metadata-column metadata-providerable card)
            cols))))
(mu/defn saved-question-metadata :- CardColumns
  "Metadata associated with a Saved Question with `card-id`."
  [metadata-providerable :- lib.metadata/MetadataProviderable
   card-id               :- ::lib.schema.id/card]
  ;; it seems like in some cases (unit tests) the FE is renaming `:result-metadata` to `:fields`, not 100% sure why
  ;; but handle that case anyway. (#29739)
  (when-let [card (lib.metadata/card metadata-providerable card-id)]
    (card-metadata-columns metadata-providerable card)))
(defmethod lib.metadata.calculation/returned-columns-method :metadata/card
  [query _stage-number card {:keys [unique-name-fn], :as _options}]
  (mapv (fn [col]
          (let [desired-alias ((some-fn :lib/desired-column-alias :lib/source-column-alias :name) col)]
            (assoc col :lib/desired-column-alias (unique-name-fn desired-alias))))
        (card-metadata-columns query card)))
 
(ns metabase.lib.column-group
  (:require
   [metabase.lib.card :as lib.card]
   [metabase.lib.equality :as lib.equality]
   [metabase.lib.join :as lib.join]
   [metabase.lib.join.util :as lib.join.util]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.options :as lib.options]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.lib.util :as lib.util]
   [metabase.util.malli :as mu]))
(def ^:private GroupType
  [:enum
   ;; the `:group-type/main` group includes all the columns from the source Table/Card/previous stage as well as ones
   ;; added in this stage.
   :group-type/main
   ;; the other two group types are for various types of joins.
   :group-type/join.explicit
   :group-type/join.implicit])

Schema for the metadata returned by [[group-columns]], and accepted by [[columns-group-columns]].

(def ^:private ColumnGroup
  [:and
   [:map
    [:lib/type    [:= :metadata/column-group]]
    [::group-type GroupType]
    [::columns    [:sequential lib.metadata/ColumnMetadata]]]
   [:multi
    {:dispatch ::group-type}
    [:group-type/main
     any?]
    ;; if we're in the process of BUILDING a join and using this in combination
    ;; with [[metabase.lib.join/join-condition-rhs-columns]], the alias won't be present yet, so group things by the
    ;; joinable -- either the Card we're joining, or the Table we're joining. See #32493
    [:group-type/join.explicit
     [:and
      [:map
       [:join-alias {:optional true} [:ref ::lib.schema.common/non-blank-string]]
       [:table-id   {:optional true} [:ref ::lib.schema.id/table]]
       [:card-id    {:optional true} [:ref ::lib.schema.id/card]]]
      [:fn
       {:error/message ":group-type/join.explicit should only have at most one of :join-alias, :table-id, or :card-id"}
       (fn [m]
         (>= (count (keys (select-keys m [:join-alias :table-id :card-id]))) 1))]]]
    [:group-type/join.implicit
     [:map
      ;; TODO: Strings are allowed here to work around a QP bug; see #37067.
      [:fk-field-id [:or [:ref ::lib.schema.id/field] ::lib.schema.common/non-blank-string]]]]]])
(defmethod lib.metadata.calculation/metadata-method :metadata/column-group
  [_query _stage-number column-group]
  column-group)
(defmulti ^:private display-info-for-group-method
  {:arglists '([query stage-number column-group])}
  (fn [_query _stage-number column-group]
    (::group-type column-group)))
(defmethod display-info-for-group-method :group-type/main
  [query stage-number _column-group]
  (merge
   (let [stage (lib.util/query-stage query stage-number)]
     (or
      (when-let [table (some->> (:source-table stage) (lib.metadata/table query))]
        (lib.metadata.calculation/display-info query stage-number table))
      (when-let [card (some->> (:source-card stage) (lib.metadata/card query))]
        (lib.metadata.calculation/display-info query stage-number card))
      ;; for multi-stage queries return an empty string (#30108)
      (when (next (:stages query))
        {:display-name ""})
      ;; if this is a native query or something else that doesn't have a source Table or source Card then use the
      ;; stage display name.
      {:display-name (lib.metadata.calculation/display-name query stage-number stage)}))
   {:is-from-join           false
    :is-implicitly-joinable false}))
(defmethod display-info-for-group-method :group-type/join.explicit
  [query stage-number {:keys [join-alias table-id card-id], :as _column-group}]
  (merge
   (or
    (when join-alias
      (when-let [join (lib.join/resolve-join query stage-number join-alias)]
        (lib.metadata.calculation/display-info query stage-number join)))
    (when table-id
      (when-let [table (lib.metadata/table query table-id)]
        (lib.metadata.calculation/display-info query stage-number table)))
    (when card-id
      (if-let [card (lib.metadata/card query card-id)]
        (lib.metadata.calculation/display-info query stage-number card)
        {:display-name (lib.card/fallback-display-name card-id)})))
   {:is-from-join           true
    :is-implicitly-joinable false}))
(defmethod display-info-for-group-method :group-type/join.implicit
  [query stage-number {:keys [fk-field-id], :as _column-group}]
  (merge
   (when-let [field (if (string? fk-field-id)
                      ;; TODO: This is probably working around a QP bug. See #37067 - the `data.cols` from the API has
                      ;; fk_field_id: "customer_id" but I think that's wrong and it should not have dropped the real
                      ;; field ID somewhere in the QP.
                      (some->> (lib.util/query-stage query stage-number)
                               (lib.metadata.calculation/visible-columns query stage-number)
                               (lib.equality/find-matching-column
                                 query stage-number
                                 (lib.options/ensure-uuid [:field {:base-type :type/*} fk-field-id]))
                               :id
                               (lib.metadata/field query))
                      (lib.metadata/field query fk-field-id))]
     (let [field-info (lib.metadata.calculation/display-info query stage-number field)]
       ;; Implicitly joined column pickers don't use the target table's name, they use the FK field's name with
       ;; "ID" dropped instead.
       ;; This is very intentional: one table might have several FKs to one foreign table, each with different
       ;; meaning (eg. ORDERS.customer_id vs. ORDERS.supplier_id both linking to a PEOPLE table).
       ;; See #30109 for more details.
       (assoc field-info :fk-reference-name (lib.util/strip-id (:display-name field-info)))))
   {:is-from-join           false
    :is-implicitly-joinable true}))
(defmethod lib.metadata.calculation/display-info-method :metadata/column-group
  [query stage-number column-group]
  (display-info-for-group-method query stage-number column-group))
(defmulti ^:private column-group-info-method
  {:arglists '([column-metadata])}
  :lib/source)
(defmethod column-group-info-method :source/implicitly-joinable
  [column-metadata]
  {::group-type :group-type/join.implicit,
   :fk-field-id (:fk-field-id column-metadata)
   :fk-join-alias (:fk-join-alias column-metadata)})
(defmethod column-group-info-method :source/joins
  [{:keys [table-id], :lib/keys [card-id], :as column-metadata}]
  (merge
   {::group-type :group-type/join.explicit}
   ;; if we're in the process of BUILDING a join and using this in combination
   ;; with [[metabase.lib.join/join-condition-rhs-columns]], the alias won't be present yet, so group things by the
   ;; joinable -- either the Card we're joining, or the Table we're joining. Prefer `:lib/card-id` because when we
   ;; join a Card the Fields might have `:table-id` but we want the entire Card to appear as one group. See #32493
   (or
    (when-let [join-alias (lib.join.util/current-join-alias column-metadata)]
      {:join-alias join-alias})
    (when card-id
      {:card-id card-id})
    (when table-id
      {:table-id table-id}))))
(defmethod column-group-info-method :default
  [_column-metadata]
  {::group-type :group-type/main})
(mu/defn ^:private column-group-info :- [:map [::group-type GroupType]]
  "The value we should use to `group-by` inside [[group-columns]]."
  [column-metadata :- lib.metadata/ColumnMetadata]
  (column-group-info-method column-metadata))
(mu/defn group-columns :- [:sequential ColumnGroup]
  "Given a group of columns returned by a function like [[metabase.lib.order-by/orderable-columns]], group the columns
  by Table or equivalent (e.g. Saved Question) so that they're in an appropriate shape for showing in the Query
  Builder. e.g a sequence of columns like
    [venues.id
     venues.name
     venues.category-id
     ;; implicitly joinable
     categories.id
     categories.name]
  would get grouped into groups like
    [{::columns [venues.id
                 venues.name
                 venues.category-id]}
     {::columns [categories.id
                 categories.name]}]
  Groups have the type `:metadata/column-group` and can be passed directly
  to [[metabase.lib.metadata.calculation/display-info]]."
  [column-metadatas :- [:sequential lib.metadata/ColumnMetadata]]
  (mapv (fn [[group-info columns]]
          (assoc group-info
                 :lib/type :metadata/column-group
                 ::columns columns))
        (group-by column-group-info column-metadatas)))
(mu/defn columns-group-columns :- [:sequential lib.metadata/ColumnMetadata]
  "Get the columns associated with a column group"
  [column-group :- ColumnGroup]
  (::columns column-group))
 

Currently this is mostly a convenience namespace for REPL and test usage. We'll probably have a slightly different version of this for namespace for QB and QP usage in the future -- TBD.

(ns metabase.lib.core
  (:refer-clojure :exclude [filter remove replace and or not = < <= > ->> >= not-empty case count distinct max min
                            + - * / time abs concat replace ref var])
  (:require
   [metabase.lib.aggregation :as lib.aggregation]
   [metabase.lib.binning :as lib.binning]
   [metabase.lib.breakout :as lib.breakout]
   [metabase.lib.card :as lib.card]
   [metabase.lib.column-group :as lib.column-group]
   [metabase.lib.common :as lib.common]
   [metabase.lib.database :as lib.database]
   [metabase.lib.drill-thru :as lib.drill-thru]
   [metabase.lib.drill-thru.pivot :as lib.drill-thru.pivot]
   [metabase.lib.equality :as lib.equality]
   [metabase.lib.expression :as lib.expression]
   [metabase.lib.fe-util :as lib.fe-util]
   [metabase.lib.field :as lib.field]
   [metabase.lib.filter :as lib.filter]
   [metabase.lib.filter.update :as lib.filter.update]
   [metabase.lib.join :as lib.join]
   [metabase.lib.limit :as lib.limit]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.metadata.composed-provider :as lib.metadata.composed-provider]
   [metabase.lib.metric :as lib.metric]
   [metabase.lib.native :as lib.native]
   [metabase.lib.normalize :as lib.normalize]
   [metabase.lib.order-by :as lib.order-by]
   [metabase.lib.query :as lib.query]
   [metabase.lib.ref :as lib.ref]
   [metabase.lib.remove-replace :as lib.remove-replace]
   [metabase.lib.segment :as lib.segment]
   [metabase.lib.stage :as lib.stage]
   [metabase.lib.table :as lib.table]
   [metabase.lib.temporal-bucket :as lib.temporal-bucket]
   [metabase.shared.util.namespaces :as shared.ns]))
(comment lib.aggregation/keep-me
         lib.binning/keep-me
         lib.breakout/keep-me
         lib.card/keep-me
         lib.column-group/keep-me
         lib.common/keep-me
         lib.database/keep-me
         lib.drill-thru/keep-me
         lib.drill-thru.pivot/keep-me
         lib.equality/keep-me
         lib.expression/keep-me
         lib.field/keep-me
         lib.filter/keep-me
         lib.filter.update/keep-me
         lib.join/keep-me
         lib.limit/keep-me
         lib.metadata.calculation/keep-me
         lib.metadata.composed-provider/keep-me
         lib.metric/keep-me
         lib.native/keep-me
         lib.normalize/keep-me
         lib.order-by/keep-me
         lib.query/keep-me
         lib.ref/keep-me
         lib.segment/keep-me
         lib.stage/keep-me
         lib.table/keep-me
         lib.temporal-bucket/keep-me)
(shared.ns/import-fns
 [lib.aggregation
  aggregate
  aggregation-clause
  aggregation-ref
  aggregation-operator-columns
  aggregations
  aggregations-metadata
  available-aggregation-operators
  selected-aggregation-operators
  count
  avg
  count-where
  distinct
  max
  median
  min
  percentile
  share
  stddev
  sum
  sum-where
  var
  cum-count
  cum-sum]
 [lib.binning
  available-binning-strategies
  binning
  with-binning]
 [lib.breakout
  breakout
  breakoutable-columns
  breakouts
  breakouts-metadata]
 [lib.column-group
  columns-group-columns
  group-columns]
 [lib.common
  external-op]
 [lib.database
  database-id]
 [lib.drill-thru
  available-drill-thrus
  drill-thru]
 [lib.drill-thru.pivot
  pivot-columns-for-type
  pivot-types]
 [lib.equality
  find-column-for-legacy-ref
  find-matching-column]
 [lib.expression
  expression
  expressions
  expressions-metadata
  expressionable-columns
  expression-ref
  with-expression-name
  +
  -
  *
  /
  case
  coalesce
  abs
  log
  exp
  sqrt
  ceil
  floor
  round
  power
  interval
  relative-datetime
  time
  absolute-datetime
  now
  convert-timezone
  get-week
  get-year
  get-month
  get-day
  get-hour
  get-minute
  get-second
  get-quarter
  datetime-add
  datetime-subtract
  concat
  substring
  replace
  regexextract
  length
  trim
  ltrim
  rtrim
  upper
  lower]
 [lib.fe-util
  expression-clause
  expression-parts
  filter-args-display-name]
 [lib.field
  add-field
  field-id
  legacy-card-or-table-id
  fieldable-columns
  fields
  find-visible-column-for-legacy-ref
  find-visible-column-for-ref
  remove-field
  with-fields]
 [lib.filter
  filter
  filters
  filterable-columns
  filterable-column-operators
  filter-clause
  filter-operator
  find-filter-for-legacy-filter
  find-filterable-column-for-legacy-ref
  and
  or
  not
  = !=
  < <=
  > >=
  between
  inside
  is-null not-null
  is-empty not-empty
  starts-with ends-with
  contains does-not-contain
  time-interval
  segment]
 [lib.filter.update
  update-lat-lon-filter
  update-numeric-filter
  update-temporal-filter]
 [lib.join
  available-join-strategies
  join
  join-clause
  join-condition-lhs-columns
  join-condition-operators
  join-condition-rhs-columns
  join-condition-update-temporal-bucketing
  join-conditions
  join-fields
  join-lhs-display-name
  join-strategy
  joinable-columns
  joins
  raw-join-strategy
  suggested-join-conditions
  with-join-alias
  with-join-fields
  with-join-strategy
  with-join-conditions]
 [lib.limit
  current-limit
  limit]
 [lib.metadata.calculation
  column-name
  describe-query
  describe-top-level-key
  display-name
  display-info
  metadata
  returned-columns
  suggested-name
  type-of
  visible-columns]
 [lib.metadata.composed-provider
  composed-metadata-provider]
 [lib.metric
  available-metrics]
 [lib.native
  native-query
  raw-native-query
  with-native-query
  template-tags
  engine
  with-template-tags
  required-native-extras
  native-extras
  with-native-extras
  with-different-database
  has-write-permission
  extract-template-tags]
 [lib.order-by
  change-direction
  order-by
  order-by-clause
  order-bys
  orderable-columns]
 [lib.normalize
  normalize]
 [lib.query
  can-run
  query
  stage-count
  with-different-table]
 [lib.ref
  ref]
 [lib.remove-replace
  remove-clause
  remove-join
  rename-join
  replace-clause
  replace-join]
 [lib.segment
  available-segments]
 [lib.stage
  append-stage
  drop-stage
  drop-stage-if-empty]
 [lib.temporal-bucket
  describe-temporal-unit
  describe-temporal-interval
  describe-relative-datetime
  available-temporal-buckets
  temporal-bucket
  with-temporal-bucket])
 
(ns metabase.lib.database
  (:require
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.lib.util :as lib.util]
   [metabase.mbql.schema :as mbql.s]
   [metabase.util.malli :as mu]))
(mu/defn database-id :- [:maybe ::lib.schema.id/database]
  "Get the Database ID (`:database`) associated with a query. If the query is using
  the [[mbql.s/saved-questions-virtual-database-id]] (used in some situations for queries with a `:source-card`)
    {:database -1337}
  we will attempt to resolve the correct Database ID by getting metadata for the source Card and returning its
  `:database-id`; if this is not available for one reason or another this will return `nil`."
  [query :- ::lib.schema/query]
  (when-let [id (:database query)]
    (if (not= id mbql.s/saved-questions-virtual-database-id)
      id
      (when-let [source-card-id (lib.util/source-card-id query)]
        (when-let [card-metadata (lib.metadata/card query source-card-id)]
          (:database-id card-metadata))))))
 
(ns metabase.lib.dispatch
  (:require [metabase.util :as u]))
(defn- mbql-clause-type [x]
  (when (and (vector? x)
             (keyword? (first x)))
    (first x)))

Dispatch value for a clause, map, or other object. Dispatch rules are as follows:

  1. If it is an MBQL clause (vector with a keyword as its first argument), dispatch on that clause keyword

  2. If it is a map with a :lib/type key, dispatch on that;

  3. Otherwise, dispatch on a keyword representing the class of the object, e.g. :dispatch-type/string for a String. The main reason this returns weird keywords like this rather than class names like String is to make it easier to write cross-compatible code. See [[u/dispatch-type-keyword]] for more info.

(defn dispatch-value
  [x]
  ;; TODO -- for Clj, we should probably handle Toucan instances as well, and dispatch off
  ;; of [[toucan2.core/model]]?
  (or (mbql-clause-type x)
      (when (map? x)
        (:lib/type x))
      (u/dispatch-type-keyword x)))
 
(ns metabase.lib.drill-thru
  (:require
   [metabase.lib.drill-thru.automatic-insights :as lib.drill-thru.automatic-insights]
   [metabase.lib.drill-thru.column-filter :as lib.drill-thru.column-filter]
   [metabase.lib.drill-thru.common :as lib.drill-thru.common]
   [metabase.lib.drill-thru.distribution :as lib.drill-thru.distribution]
   [metabase.lib.drill-thru.fk-details :as lib.drill-thru.fk-details]
   [metabase.lib.drill-thru.fk-filter :as lib.drill-thru.fk-filter]
   [metabase.lib.drill-thru.object-details :as lib.drill-thru.object-details]
   [metabase.lib.drill-thru.pivot :as lib.drill-thru.pivot]
   [metabase.lib.drill-thru.pk :as lib.drill-thru.pk]
   [metabase.lib.drill-thru.quick-filter :as lib.drill-thru.quick-filter]
   [metabase.lib.drill-thru.sort :as lib.drill-thru.sort]
   [metabase.lib.drill-thru.summarize-column :as lib.drill-thru.summarize-column]
   [metabase.lib.drill-thru.summarize-column-by-time :as lib.drill-thru.summarize-column-by-time]
   [metabase.lib.drill-thru.underlying-records :as lib.drill-thru.underlying-records]
   [metabase.lib.drill-thru.zoom :as lib.drill-thru.zoom]
   [metabase.lib.drill-thru.zoom-in-bins :as lib.drill-thru.zoom-in-bins]
   [metabase.lib.drill-thru.zoom-in-geographic :as lib.drill-thru.zoom-in-geographic]
   [metabase.lib.drill-thru.zoom-in-timeseries :as lib.drill-thru.zoom-in-timeseries]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.drill-thru :as lib.schema.drill-thru]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]))
(comment
  lib.drill-thru.fk-details/keep-me
  lib.drill-thru.pk/keep-me
  lib.drill-thru.zoom/keep-me)
(defmethod lib.metadata.calculation/display-info-method ::drill-thru
  [query stage-number drill-thru]
  (lib.drill-thru.common/drill-thru-info-method query stage-number drill-thru))

TODO: Different ways to apply drill-thru to a query. So far: - :filter on each :operators of :drill-thru/quick-filter applied with (lib/filter query stage filter-clause)

TODO: ActionMode, PublicMode, MetabotMode need to be captured in the FE before calling available-drill-thrus.

Some drill thru functions are expected to return drills for just the specified :column; others are expected to ignore that column and return drills for all of the columns specified in :dimensions. :return-drills-for-dimensions? specifies which type we have.

TODO: Missing drills: format.

(def ^:private available-drill-thru-fns
  [{:f #'lib.drill-thru.automatic-insights/automatic-insights-drill,             :return-drills-for-dimensions? false}
   {:f #'lib.drill-thru.column-filter/column-filter-drill,                       :return-drills-for-dimensions? true}
   {:f #'lib.drill-thru.distribution/distribution-drill,                         :return-drills-for-dimensions? true}
   {:f #'lib.drill-thru.fk-filter/fk-filter-drill,                               :return-drills-for-dimensions? false}
   {:f #'lib.drill-thru.object-details/object-detail-drill,                      :return-drills-for-dimensions? false}
   {:f #'lib.drill-thru.pivot/pivot-drill,                                       :return-drills-for-dimensions? false}
   {:f #'lib.drill-thru.quick-filter/quick-filter-drill,                         :return-drills-for-dimensions? false}
   {:f #'lib.drill-thru.sort/sort-drill,                                         :return-drills-for-dimensions? true}
   {:f #'lib.drill-thru.summarize-column/summarize-column-drill,                 :return-drills-for-dimensions? true}
   {:f #'lib.drill-thru.summarize-column-by-time/summarize-column-by-time-drill, :return-drills-for-dimensions? true}
   {:f #'lib.drill-thru.underlying-records/underlying-records-drill,             :return-drills-for-dimensions? false}
   {:f #'lib.drill-thru.zoom-in-timeseries/zoom-in-timeseries-drill,             :return-drills-for-dimensions? false}
   {:f #'lib.drill-thru.zoom-in-geographic/zoom-in-geographic-drill,             :return-drills-for-dimensions? true}
   {:f #'lib.drill-thru.zoom-in-bins/zoom-in-binning-drill,                      :return-drills-for-dimensions? true}])
(mu/defn ^:private dimension-contexts :- [:maybe [:sequential {:min 1} ::lib.schema.drill-thru/context]]
  "Create new context maps (with updated `:column` and `:value` keys) for each of the `:dimensions` passed in. Some
  drill thru functions are expected to return drills for each of these columns, while others are expected to ignore
  them. Why? Who knows."
  [{:keys [dimensions], :as context} :- ::lib.schema.drill-thru/context]
  (not-empty
    (for [dimension dimensions]
      (merge context dimension))))
(mu/defn available-drill-thrus :- [:sequential [:ref ::lib.schema.drill-thru/drill-thru]]
  "Get a list (possibly empty) of available drill-thrus for a column, or a column + value pair.
  Note that if `:value nil` in the `context`, that implies the value is *missing*, ie. that this was a column click.
  For a value of `NULL` from the database, use the sentinel `:null`. Most of this file only cares whether the value
  was provided or not, but some things (eg. quick filters) treat `NULL` values differently.
  See [[metabase.lib.js/available-drill-thrus]]."
  ([query context]
   (available-drill-thrus query -1 context))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    context      :- ::lib.schema.drill-thru/context]
   (try
     (into []
           (when (lib.metadata/editable? query)
             (let [dim-contexts (dimension-contexts context)]
               (for [{:keys [f return-drills-for-dimensions?]} available-drill-thru-fns
                     context                                   (if (and return-drills-for-dimensions? dim-contexts)
                                                                 dim-contexts
                                                                 [context])
                     :let                                      [drill (f query stage-number context)]
                     :when                                     drill]
                 drill))))
     (catch #?(:clj Throwable :cljs :default) e
       (throw (ex-info (str "Error getting available drill thrus for query: " (ex-message e))
                       {:query        query
                        :stage-number stage-number
                        :context      context}
                       e))))))
(mu/defn drill-thru :- ::lib.schema/query
  "`(drill-thru query stage-number drill-thru)`
  Applies the `drill-thru` to the query and stage. Keyed on the `:type` of the drill-thru. The `drill-thru` should be
  one of those returned by a call to [[available-drill-thrus]] with the same `query` and `stage-number`.
  Returns the updated query."
  ([query drill]
   (drill-thru query -1 drill))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    drill        :- ::lib.schema.drill-thru/drill-thru
    & args]
   (log/debugf "Applying drill thru: %s"
               (u/pprint-to-str {:query query, :stage-number stage-number, :drill drill, :args args}))
   (apply lib.drill-thru.common/drill-thru-method query stage-number drill args)))
 
(ns metabase.lib.drill-thru.automatic-insights
  (:require
   [metabase.lib.drill-thru.common :as lib.drill-thru.common]
   [metabase.lib.drill-thru.underlying-records :as lib.drill-thru.underlying-records]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.drill-thru :as lib.schema.drill-thru]
   [metabase.lib.util :as lib.util]
   [metabase.util.malli :as mu]))
(mu/defn automatic-insights-drill :- [:maybe ::lib.schema.drill-thru/drill-thru]
  "Automatic insights appears:
  - When clicking on a value with a breakout - eg. a point in a time series, a cell of a table, a bar or pie slice
  - Or when clicking a pivot cell, with a value but no column.
  - Or when clicking a chart legend, in which case there's no column or value set.
  - There must be at least 1 breakout
  - X-rays must be enabled (check the settings)
  There are two forms: X-ray, and \"Compare to the rest\". This is a simple user choice and does not need extra data."
  [query                                        :- ::lib.schema/query
   stage-number                                 :- :int
   {:keys [column column-ref dimensions value]} :- ::lib.schema.drill-thru/context]
  (when (and (lib.drill-thru.common/mbql-stage? query stage-number)
             ;; Column with no value is not allowed - that's a column header click. Other combinations are allowed.
             (or (not column) (some? value))
             (lib.metadata/setting query :enable-xrays)
             (not-empty dimensions))
    {:lib/type   :metabase.lib.drill-thru/drill-thru
     :type       :drill-thru/automatic-insights
     :column-ref column-ref
     :dimensions dimensions}))
(defmethod lib.drill-thru.common/drill-thru-method :drill-thru/automatic-insights
  [query _stage-number drill-thru & _]
  ;; Returns a dummy query with the right filters for the underlying query. Rather than using this query directly, the
  ;; FE logic for this drill will grab the filters and build a URL with them.
  (-> query
      ;; Drop any existing filters so they aren't duplicated.
      (lib.util/update-query-stage -1 dissoc :filters)
      ;; Then transform the aggregations and selected breakouts into filters.
      (lib.drill-thru.underlying-records/drill-underlying-records drill-thru)))
 

Enables "Filter by this column" menu item.

The caveat here is that for aggregation and breakout columns we need to append a stage before adding a filter. There is a helper function called filterDrillDetails which returns the query with a possibly appended stage, and the corresponding column for that stage. In each test case where drill thru is allowed we need to verify that filterDrillDetails appended the stage where needed.

Another caveat is that we need to verify that filterDrillDetails returned a filterable column, i.e. a column obtained from filterableColumns call. A good way to verify that is to call filterableColumnOperators and check that a non-empty list is returned.

Entry points:

  • Column header

Requirements:

  • Column not type/Structured

Query transformation:

  • None/identity. The FE will show the FilterPicker and not call drillThru for this drill.

Question transformation: - None

(ns metabase.lib.drill-thru.column-filter
  (:require
   [medley.core :as m]
   [metabase.lib.drill-thru.common :as lib.drill-thru.common]
   [metabase.lib.equality :as lib.equality]
   [metabase.lib.filter :as lib.filter]
   [metabase.lib.filter.operator :as lib.filter.operator]
   [metabase.lib.ref :as lib.ref]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.drill-thru :as lib.schema.drill-thru]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.lib.stage :as lib.stage]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.lib.util :as lib.util]
   [metabase.util.malli :as mu]))
(mu/defn filter-drill-adjusted-query :- [:map
                                         [:query ::lib.schema/query]
                                         [:stage-number :int]
                                         [:column lib.filter/ColumnWithOperators]]
  "If the column we're filtering on is an aggregation, the filtering must happen in a later stage. This function returns
  a map with that possibly-updated `:query` and `:stage-number`, plus the `:column` for filtering in that stage (with
  filter operators, as returned by [[lib.filter/filterable-columns]]).
  If the column is an aggregation but the query already has a later stage, that stage is reused.
  If the column is not an aggregation, the query and stage-number are returned unchanged, but the
  [[lib.filter/filterable-columns]] counterpart of the input `column` is still returned.
  This query and filterable column are exactly what the FE needs to render the filtering UI for a column filter drill,
  or certain tricky cases of quick filter."
  [query        :- ::lib.schema/query
   stage-number :- :int
   column       :- ::lib.schema.metadata/column]
  (let [next-stage    (->> (lib.util/canonical-stage-index query stage-number)
                           (lib.util/next-stage-number query))
        base          (cond
                        ;; Not an aggregation: just the input query and stage.
                        (not= (:lib/source column) :source/aggregations)
                        {:query        query
                         :stage-number stage-number}
                        ;; Aggregation column: if there's a later stage, use it.
                        next-stage {:query        query
                                    :stage-number next-stage}
                        ;; Aggregation column with no later stage; append a stage.
                        :else      {:query        (lib.stage/append-stage query)
                                    :stage-number -1})
        columns       (lib.filter/filterable-columns (:query base) (:stage-number base))
        filter-column (or (lib.equality/find-matching-column
                            (:query base) (:stage-number base) (lib.ref/ref column) columns)
                          (and (:lib/source-uuid column)
                               (m/find-first #(= (:lib/source-uuid %) (:lib/source-uuid column))
                                             columns)))]
    (assoc base :column filter-column)))
(mu/defn column-filter-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.column-filter]
  "Filtering at the column level, based on its type. Displays a submenu of eg. \"Today\", \"This Week\", etc. for date
  columns.
  Note that if the clicked column is an aggregation, filtering by it will require a new stage. Therefore this drill
  returns a possibly-updated `:query` and `:stage-number` along with a `:column` referencing that later stage."
  [query                  :- ::lib.schema/query
   stage-number           :- :int
   {:keys [column value]} :- ::lib.schema.drill-thru/context]
  ;; Note: original code uses an addition `clicked.column.field_ref != null` condition.
  (when (and (lib.drill-thru.common/mbql-stage? query stage-number)
             column
             (nil? value)
             (not (lib.types.isa/structured? column)))
    (let [initial-op (when-not (lib.types.isa/temporal? column) ; Date fields have special handling in the FE.
                       (-> (lib.filter.operator/filter-operators column)
                           first
                           (assoc :lib/type :operator/filter)))]
      (merge
        {:lib/type   :metabase.lib.drill-thru/drill-thru
         :type       :drill-thru/column-filter
         :initial-op initial-op}
        ;; When the column we would be filtering on is an aggregation, it can't be filtered without adding a stage.
        (filter-drill-adjusted-query query stage-number column)))))
(defmethod lib.drill-thru.common/drill-thru-info-method :drill-thru/column-filter
  [_query _stage-number {:keys [initial-op]}]
  {:type       :drill-thru/column-filter
   :initial-op initial-op})
(mu/defmethod lib.drill-thru.common/drill-thru-method :drill-thru/column-filter :- ::lib.schema/query
  [query                            :- ::lib.schema/query
   stage-number                     :- :int
   {:keys [column] :as _drill-thru} :- ::lib.schema.drill-thru/drill-thru.column-filter
   filter-op                        :- [:or :keyword :string] ; filter tag
   value                            :- :any]
  (lib.filter/filter query stage-number (lib.filter/filter-clause filter-op column value)))
 
(ns metabase.lib.drill-thru.common
  (:require
   [metabase.lib.hierarchy :as lib.hierarchy]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.util :as lib.util]))

Is this query stage an MBQL stage?

(defn mbql-stage?
  [query stage-number]
  (-> (lib.util/query-stage query stage-number)
      :lib/type
      (= :mbql.stage/mbql)))
(defn- drill-thru-dispatch [_query _stage-number drill-thru & _args]
  (:type drill-thru))

e.g.

(drill-thru-method query stage-number drill-thru)`

Applies the drill-thru to the query and stage. Keyed on the :type of the drill-thru. Returns the updated query.

(defmulti drill-thru-method
  {:arglists '([query stage-number drill-thru & args])}
  drill-thru-dispatch
  :hierarchy lib.hierarchy/hierarchy)

Helper for getting the display-info of each specific type of drill-thru.

(defmulti drill-thru-info-method
  {:arglists '([query stage-number drill-thru])}
  drill-thru-dispatch
  :hierarchy lib.hierarchy/hierarchy)
(defmethod drill-thru-info-method :default
  [_query _stage-number drill-thru]
  ;; Several drill-thrus are rendered as a fixed label for that type, with no reference to the column or value,
  ;; so the default is simply the drill-thru type.
  (select-keys drill-thru [:type :display-name]))

Does the source table for this query have more than one primary key?

(defn many-pks?
  [query]
  (> (count (lib.metadata.calculation/primary-keys query)) 1))
 

Raw data with a breakout based on the selected column.

For date columns, sets "Month" as a temporal unit. For numeric columns, uses the default binning strategy. Other columns are not changed.

Entry points:

  • Column header

Requirements:

  • No aggregation or breakout clauses in the query
  • Column not type/PK, type/SerializedJSON, type/Description, type/Comment

Query transformation (last stage only):

  • Remove all aggregation, breakout, orderBy, limit clauses

  • Aggregate by "count" operator

  • Breakout by the selected column. If the column is a date column, add "Month" temporal unit. If the column is a numeric column, apply the default binning strategy. Otherwise use the column as it is.

Question transformation:

  • Set "bar" display
(ns metabase.lib.drill-thru.distribution
  (:require
   [metabase.lib.aggregation :as lib.aggregation]
   [metabase.lib.binning :as lib.binning]
   [metabase.lib.breakout :as lib.breakout]
   [metabase.lib.drill-thru.common :as lib.drill-thru.common]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.drill-thru :as lib.schema.drill-thru]
   [metabase.lib.temporal-bucket :as lib.temporal-bucket]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.lib.util :as lib.util]
   [metabase.util.malli :as mu]))

TODO: The original Question.distribution() sets the display to bar, but that's out of scope for MLv2. Make sure the FE does this on the question after evolving the query.

(mu/defn distribution-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.distribution]
  "Select a column and see a histogram of how many rows fall into an automatic set of bins/buckets.
  - For dates, breaks out by month by default.
  - For numeric values, by an auto-selected set of bins
  - For strings, by each distinct value (which might be = the number of rows)"
  [query                  :- ::lib.schema/query
   stage-number           :- :int
   {:keys [column value]} :- ::lib.schema.drill-thru/context]
  (when (and (lib.drill-thru.common/mbql-stage? query stage-number)
             column
             (nil? value)
             (not= (:lib/source column) :source/aggregations)
             (not (lib.types.isa/primary-key? column))
             (not (lib.types.isa/structured?  column))
             (not (lib.types.isa/comment?     column))
             (not (lib.types.isa/description? column))
             (not (lib.breakout/breakout-column? query stage-number column)))
    {:lib/type  :metabase.lib.drill-thru/drill-thru
     :type      :drill-thru/distribution
     :column    column}))
(defn- add-temporal-bucketing-or-binning
  [column]
  (cond
    (lib.types.isa/temporal? column)
    (lib.temporal-bucket/with-temporal-bucket column :month)
    (and (lib.types.isa/numeric? column)
         (not (lib.types.isa/foreign-key? column)))
    (lib.binning/with-binning column (lib.binning/default-auto-bin))
    :else
    column))
(mu/defmethod lib.drill-thru.common/drill-thru-method :drill-thru/distribution :- ::lib.schema/query
  [query                            :- ::lib.schema/query
   stage-number                     :- :int
   {:keys [column] :as _drill-thru} :- ::lib.schema.drill-thru/drill-thru.distribution]
  (when (lib.drill-thru.common/mbql-stage? query stage-number)
    (let [breakout (add-temporal-bucketing-or-binning column)]
      (-> query
          ;; Remove most of the target stage.
          (lib.util/update-query-stage stage-number dissoc :aggregation :breakout :limit :order-by)
          ;; Then set a count aggregation and the breakout above.
          (lib.aggregation/aggregate stage-number (lib.aggregation/count))
          (lib.breakout/breakout stage-number breakout)))))
 

Object details drill for FK fields. Creates a new query based on the FK table with a = filter based on selected value.

Entry points:

  • Cell

Requirements:

  • Column is type/FK
  • value is not null

Query transformation:

  • Find the target table for the selected FK

  • Create a new query that targets the FK table and add a = filter using the corresponding PK column and the selected value

  • Preserve filters from the original query that use = operator and are based on other FK columns targeting the same FK table as the selected FK. This can only happen when the target table's PK consists of multiple columns.

Question transformation:

  • Set default display

An FK details drill is one where you click a foreign key value in a table view e.g. ORDERS.USER_ID and choose the 'View details' option, then it shows you the PEOPLE record in question (e.g. Person 5 if USER_ID was 5).

We will only possibly return one of the 'object details' drills ([[metabase.lib.drill-thru.pk]], [[metabase.lib.drill-thru.fk-details]], or [[metabase.lib.drill-thru.zoom]]); see [[metabase.lib.drill-thru.object-details]] for the high-level logic that calls out to the individual implementations.

(ns metabase.lib.drill-thru.fk-details
  (:require
   [metabase.lib.drill-thru.common :as lib.drill-thru.common]
   [metabase.lib.filter :as lib.filter]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.query :as lib.query]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.drill-thru :as lib.schema.drill-thru]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.util.malli :as mu]))
(mu/defn fk-details-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.fk-details]
  "Return an `:fk-details` 'View details' drill when clicking on the value of a FK column."
  [query                               :- ::lib.schema/query
   _stage-number                       :- :int
   {:keys [column value] :as _context} :- ::lib.schema.drill-thru/context]
  (when (and (lib.types.isa/foreign-key? column)
             (some? value)
             (not= value :null))
    {:lib/type  :metabase.lib.drill-thru/drill-thru
     :type      :drill-thru/fk-details
     :column    column
     :object-id value
     :many-pks? (lib.drill-thru.common/many-pks? query)}))
(defmethod lib.drill-thru.common/drill-thru-info-method :drill-thru/fk-details
  [_query _stage-number drill-thru]
  (select-keys drill-thru [:many-pks? :object-id :type]))
(defmethod lib.drill-thru.common/drill-thru-method :drill-thru/fk-details
  [query stage-number {:keys [column object-id]} & _]
  ;; generate a NEW query against the FK target table and column, e.g. if the original query was
  ;; ORDERS/ORDERS.USER_ID, the new query should by PEOPLE/PEOPLE.ID.
  (let [fk-column-id    (:fk-target-field-id column)
        fk-column       (some->> fk-column-id (lib.metadata/field query))
        fk-column-table (some->> (:table-id fk-column) (lib.metadata/table query))]
    (-> (lib.query/query query fk-column-table)
        (lib.filter/filter stage-number (lib.filter/= fk-column object-id)))))
 

Adds a simple = filter for the selected FK column. Enables option like View this Product's Reviews.

Entry points:

  • Cell

Requirements:

  • Selected column is type/FK

  • Structured (MBQL) query

  • Return columnName and tableName for the FK column. On the FE we strip ID suffix and turn Product ID into Product's and pluralize the table name.

Query transformation:

  • Add a = filter for the selected column and value. Make sure to append the query stage when needed.

Question transformation: - None

(ns metabase.lib.drill-thru.fk-filter
  (:require
   [metabase.lib.drill-thru.common :as lib.drill-thru.common]
   [metabase.lib.filter :as lib.filter]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.options :as lib.options]
   [metabase.lib.ref :as lib.ref]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.drill-thru :as lib.schema.drill-thru]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.lib.util :as lib.util]
   [metabase.util.malli :as mu]))
(mu/defn fk-filter-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.fk-filter]
  "When clicking on a foreign key value, filter this query by that column.
  This has the same effect as the `=` filter on a generic field (ie. not a key), but renders differently.
  Contrast [[metabase.lib.drill-thru.object-details/object-detail-drill]], which shows the details of the foreign
  object."
  [query                                :- ::lib.schema/query
   stage-number                        :- :int
   {:keys [column value], :as _context} :- ::lib.schema.drill-thru/context]
  (when (and column
             (some? value)
             (not= value :null)         ; If the FK is null, don't show this option.
             (lib.drill-thru.common/mbql-stage? query stage-number)
             (not (lib.types.isa/primary-key? column))
             (lib.types.isa/foreign-key? column))
    (let [source (or (some->> query lib.util/source-table-id (lib.metadata/table query))
                     (some->> query lib.util/source-card-id (lib.metadata/card query)))]
      {:lib/type :metabase.lib.drill-thru/drill-thru
       :type     :drill-thru/fk-filter
       :filter   (lib.options/ensure-uuid [:= {} (lib.ref/ref column) value])
       :column-name (lib.metadata.calculation/display-name query stage-number column :long)
       :table-name (lib.metadata.calculation/display-name query 0 source)})))
(defmethod lib.drill-thru.common/drill-thru-info-method :drill-thru/fk-filter
  [_query _stage-number drill-thru]
  (select-keys drill-thru [:type :column-name :table-name]))
(mu/defmethod lib.drill-thru.common/drill-thru-method :drill-thru/fk-filter :- ::lib.schema/query
  [query        :- ::lib.schema/query
   stage-number :- :int
   drill-thru   :- ::lib.schema.drill-thru/drill-thru.fk-filter
   & _args]
  ;; if the stage in question is an MBQL stage, we can simply add a `=` filter to it. If it's a native stage, we have
  ;; to apply the drill to the stage after that stage, which will be an MBQL stage, adding it if needed (native stages
  ;; are currently only allowed to be the first stage.)
  (let [[query stage-number] (if (lib.drill-thru.common/mbql-stage? query stage-number)
                               [query stage-number]
                               ;; native stage
                               (let [;; convert the stage number e.g. `-1` to the canonical non-relative stage number
                                     stage-number      (lib.util/canonical-stage-index query stage-number)
                                     ;; make sure the query has at least one MBQL stage after the native stage, which we
                                     ;; know is the first stage.
                                     query             (lib.util/ensure-mbql-final-stage query)
                                     next-stage-number (lib.util/next-stage-number query stage-number)]
                                 (assert (lib.util/query-stage query next-stage-number)
                                         "Sanity check: there should be an additional stage by now")
                                 [query next-stage-number]))]
    (lib.filter/filter query stage-number (:filter drill-thru))))
 
(ns metabase.lib.drill-thru.object-details
  (:require
   [metabase.lib.drill-thru.fk-details :as lib.drill-thru.fk-details]
   [metabase.lib.drill-thru.pk :as lib.drill-thru.pk]
   [metabase.lib.drill-thru.zoom :as lib.drill-thru.zoom]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.drill-thru :as lib.schema.drill-thru]
   [metabase.util.malli :as mu]))
(mu/defn object-detail-drill :- [:maybe [:or
                                         ::lib.schema.drill-thru/drill-thru.pk
                                         ::lib.schema.drill-thru/drill-thru.zoom
                                         ::lib.schema.drill-thru/drill-thru.fk-details]]
  "When clicking a foreign key or primary key value, drill through to the details for that specific object.
  Contrast [[metabase.lib.drill-thru.fk-filter/fk-filter-drill]], which filters this query to only those rows with a
  specific value for a FK column."
  [query        :- ::lib.schema/query
   stage-number :- :int
   context      :- ::lib.schema.drill-thru/context]
  (some (fn [f]
          (f query stage-number context))
        [lib.drill-thru.fk-details/fk-details-drill
         lib.drill-thru.pk/pk-drill
         lib.drill-thru.zoom/zoom-drill]))
 

"Breakout by" transform.

Entry points:

  • Cell

Requirements:

  • Query with at least 1 aggregation

  • Column from the aggregation clause was selected

For different query types/shapes different breakout columns are allowed:

  • No aggregations and no breakouts - type/Date, type/Address, and type/Category (only which are not also type/Address)

  • At least 1 aggregation and exactly 1 breakout based on Address column - Date, Category

  • At least 1 aggregation and 1-2 breakouts based on Category columns - Date, Category

  • At least 1 aggregation and either (1 breakout on a date column OR 1st breakout is Date and 2nd is Category) - Address, Category

  • In other cases the drill is not supported

Query transformation is similar to zoom-in but can be simplified because legend items aren't supported:

  • Remove existing breakouts

  • Add filters based on dimensions, i.e. filters for all existing breakout

  • Add a breakout based on the selected column

Question transformation:

  • Set default display

Other functions:

  • pivotTypes function that return available column types for the drill - "category" | "location" | "time"

  • pivotColumnsForType returns the list of available columns for the drill and the selected type

(ns metabase.lib.drill-thru.pivot
  (:require
   [metabase.lib.aggregation :as lib.aggregation]
   [metabase.lib.breakout :as lib.breakout]
   [metabase.lib.drill-thru.common :as lib.drill-thru.common]
   [metabase.lib.filter :as lib.filter]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.drill-thru :as lib.schema.drill-thru]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.util.malli :as mu]))
(mu/defn ^:private pivot-drill-pred :- [:sequential lib.metadata/ColumnMetadata]
  "Implementation for pivoting on various kinds of fields.
  Don't call this directly; call [[pivot-drill]]."
  [query                  :- ::lib.schema/query
   stage-number           :- :int
   {:keys [column value]} :- ::lib.schema.drill-thru/context
   field-pred             :- [:=> [:cat lib.metadata/ColumnMetadata] boolean?]]
  (when (and (lib.drill-thru.common/mbql-stage? query stage-number)
             column
             (some? value)
             (= (:lib/source column) :source/aggregations))
    (->> (lib.breakout/breakoutable-columns query stage-number)
         (filter field-pred))))
(def ^:private pivot-type-predicates
  {:category (every-pred lib.types.isa/category?
                         (complement lib.types.isa/address?))
   :location lib.types.isa/address?
   :time     lib.types.isa/temporal?})
(defn- breakout-type [query stage-number breakout]
  (let [column (lib.metadata.calculation/metadata query stage-number breakout)]
    (cond
      (lib.types.isa/temporal? column) :date
      (lib.types.isa/address? column) :address
      (lib.types.isa/category? column) :category)))
(mu/defn ^:private permitted-pivot-types :- [:maybe [:set ::lib.schema.drill-thru/pivot-types]]
  "This captures some complex conditions formerly encoded by `visualizations/click-actions/Mode/*` in the FE.
  See [here](https://github.com/metabase/metabase/blob/f4415fec8563353615ef600f52de871507a052ec/frontend/src/metabase/visualizations/click-actions/Mode/utils.ts#L15)
  for the original logic. (It returns `MODE_TYPE_*` enums, which are referenced below.)
  Pivot drills are only available in certain conditions, like all drills: structured queries with aggregation(s), when
  clicking a specific cell.
  - No breakouts: any pivot is permitted. (`metric` mode)
  - Exactly one date breakout, with an optional category breakout: no `:time` pivot. (`timeseries` mode)
  - Exactly one breakout and it's an address: no `:location` pivot. (`geo` mode)
  - One or two category breakouts: no `:location` pivot. (`pivot` mode)
  - If all these conditions fail, no pivots are allowed and the pivot drill should not be returned.
  This function encodes all these rules, returning a (possibly emtpy) set of permitted types."
  [query                                         :- ::lib.schema/query
   stage-number                                  :- :int]
  (case (->> (lib.breakout/breakouts query stage-number)
             (map #(breakout-type query stage-number %))
             frequencies)
    ({:date 1}
     {:date 1, :category 1})
    #{:category :location}
    {:address 1}
    #{:category :time}
    {}
    #{:category :location :time}
    ({:category 1} {:category 2})
    #{:category :time}
    ;; If there are breakouts but none of those conditions matched, no pivots are permitted.
    #{}))
(mu/defn pivot-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.pivot]
  "Return all possible pivoting options on the given column and value.
  See `:pivots` key, which holds a map `{t [breakouts...]}` where `t` is `:category`, `:location`, or `:time`.
  If a key is missing, there are no breakouts of that kind."
  [query                                         :- ::lib.schema/query
   stage-number                                  :- :int
   {:keys [column dimensions value] :as context} :- ::lib.schema.drill-thru/context]
  (when (and (lib.drill-thru.common/mbql-stage? query stage-number)
             column
             (some? value)
             (= (:lib/source column) :source/aggregations)
             (-> (lib.aggregation/aggregations query stage-number) count pos?))
    (let [breakout-pivot-types (permitted-pivot-types query stage-number)
          pivots               (into {} (for [pivot-type breakout-pivot-types
                                              :let [pred    (get pivot-type-predicates pivot-type)
                                                    columns (pivot-drill-pred query stage-number context pred)]
                                              :when (not-empty columns)]
                                          [pivot-type columns]))]
      (when-not (empty? pivots)
        {:lib/type   :metabase.lib.drill-thru/drill-thru
         :type       :drill-thru/pivot
         :dimensions dimensions
         :pivots     pivots}))))
(defmethod lib.drill-thru.common/drill-thru-info-method :drill-thru/pivot
  [_query _stage-number drill-thru]
  (select-keys drill-thru [:many-pks? :object-id :type]))

Note that pivot drills have specific public functions for accessing the nested pivoting options. Therefore the [[drill-thru-info-method]] is just the default {:type :drill-thru/pivot}.

(mu/defn pivot-types :- [:sequential ::lib.schema.drill-thru/pivot-types]
  "A helper for the FE. Returns the set of pivot types (category, location, time) that apply to this drill-thru."
  [drill-thru :- [:and ::lib.schema.drill-thru/drill-thru
                  [:map [:type [:= :drill-thru/pivot]]]]]
  (-> drill-thru :pivots keys sort))
(mu/defn pivot-columns-for-type :- [:sequential lib.metadata/ColumnMetadata]
  "A helper for the FE. Returns all the columns of the given type which can be used to pivot the query."
  [drill-thru :- [:and ::lib.schema.drill-thru/drill-thru
                  [:map [:type [:= :drill-thru/pivot]]]]
   pivot-type :- ::lib.schema.drill-thru/pivot-types]
  (get-in drill-thru [:pivots pivot-type]))
(defn- breakouts->filters [query stage-number {:keys [column value] :as _dimension}]
  (-> query
      (lib.breakout/remove-existing-breakouts-for-column stage-number column)
      (lib.filter/filter stage-number (lib.filter/= column value))))

Pivot drills are in play when clicking an aggregation cell. Pivoting is applied by: 1. For each "dimension", ie. the specific values for all breakouts at the originally clicked cell: a. Filter the query to have the dimension's column = the dimension's value at that cell. b. Go through the breakouts, and remove any that match this dimension from the query. 2. Add a new breakout for the selected column.

(defmethod lib.drill-thru.common/drill-thru-method :drill-thru/pivot
  [query stage-number drill-thru & [column]]
  (let [filtered (reduce #(breakouts->filters %1 stage-number %2) query (:dimensions drill-thru))]
    (lib.breakout/breakout filtered stage-number column)))
 

Object details drill for cases when there is multiple PK columns.

Entry points:

  • Cell

Requirements:

  • Selected column is not a FK column

  • There are multiple PK columns in returned columns

  • Select column is a PK column OR the query has no aggregations (in this case the first available PK column and its value are used instead of the selected one)

  • The PK value is not null. Make sure to take the previous point into account, e.g. the selected column's value can be null but the PK column value in the same row can be not null).

Query transformation:

  • Add = filter for the PK column and it's value

Question transformation:

  • None

A :pk drill is a 'View details' (AKA object details) drill that adds filter(s) for the value(s) of a PK(s). It is only presented for Tables that have multiple PKs; for Tables with a single PK you'd instead see [[metabase.lib.drill-thru.zoom]].

We will only possibly return one of the 'object details' drills ([[metabase.lib.drill-thru.pk]], [[metabase.lib.drill-thru.fk-details]], or [[metabase.lib.drill-thru.zoom]]); see [[metabase.lib.drill-thru.object-details]] for the high-level logic that calls out to the individual implementations.

(ns metabase.lib.drill-thru.pk
  (:require
   [medley.core :as m]
   [metabase.lib.drill-thru.common :as lib.drill-thru.common]
   [metabase.lib.filter :as lib.filter]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.drill-thru :as lib.schema.drill-thru]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.util.malli :as mu]))
(mu/defn pk-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.pk]
  "'View details' drill when you click on a value in a table that has MULTIPLE PKs. There are two subtypes of PK
  drills:
  1) if you click on a PK column value, then we return a drill that will add a filter for that PK column/value
  2) if you click a non-PK column value, then we return a drill that will add filters for the PK columns/values in the
     row. This is never returned for FK columns; we return [[metabase.lib.drill-thru.fk-details]] drills instead."
  [query                                   :- ::lib.schema/query
   stage-number                            :- :int
   {:keys [column value row] :as _context} :- ::lib.schema.drill-thru/context]
  (when (and
         ;; ignore column header clicks (value = nil). NULL values (value = :null) are ok if this is a click on a
         ;; non-PK column.
         (some? value)
         (lib.drill-thru.common/mbql-stage? query stage-number)
         ;; `:pk` drills are only for Tables with multiple PKs. For Tables with one PK, we do
         ;; a [[metabase.lib.drill-thru.zoom]] drill instead.
         (lib.drill-thru.common/many-pks? query)
         ;; if this is an FK column we should return an [[metabase.lib.drill-thru.fk-details]] drill instead.
         (not (lib.types.isa/foreign-key? column)))
    (if (lib.types.isa/primary-key? column)
      ;; 1) we clicked on a PK column: return a drill thru for that PK column + value. Ignore `nil` values.
      (when (and (some? value)
                 (not= value :null))
        {:lib/type   :metabase.lib.drill-thru/drill-thru
         :type       :drill-thru/pk
         :dimensions [{:column column
                       :value  value}]})
      ;; 2) we clicked on a non-PK column: return a drill for ALL of the PK columns + values. Ignore any
      ;;   `nil` (`:null`) values.
      (let [pk-columns (lib.metadata.calculation/primary-keys query)
            dimensions (for [pk-column pk-columns
                             :let      [value (->> row
                                                   (m/find-first #(-> % :column :name (= (:name pk-column))))
                                                   :value)]
                             ;; ignore any PKs that don't have a value in this row.
                             :when     value]
                         {:column pk-column, :value value})]
        (when (seq dimensions)
          {:lib/type   :metabase.lib.drill-thru/drill-thru
           :type       :drill-thru/pk
           ;; return the dimensions sorted by column ID so the return value is determinate.
           :dimensions (vec (sort-by #(get-in % [:column :id]) dimensions))})))))
(defmethod lib.drill-thru.common/drill-thru-info-method :drill-thru/pk
  [_query _stage-number drill-thru]
  (select-keys drill-thru [:type :dimensions]))
(defmethod lib.drill-thru.common/drill-thru-method :drill-thru/pk
  [query stage-number {:keys [dimensions], :as _pk-drill}]
  (reduce
   (fn [query {:keys [column value], :as _dimension}]
     (lib.filter/filter query stage-number (lib.filter/= column value)))
   query
   dimensions))
 

Adds a filter clause with simple operators like <, >, =, , contains, does-not-contain`.

Entry points:

  • Cell

Requirements:

  • Column not type/PK, type/FK, or type/Structured

  • Column can be filtered upon (exists in filterableColumns)

  • For null value, allow only = and operators, which map to is-null and not-null filter operators

  • For date and numeric columns, allow <, >, =, operators

  • For string columns which have type/Comment or type/Description semantic type, allow contains and does-not-contain operators.

  • For other cases, including string columns, allow only = and operators.

  • Return raw value in displayInfo for the drill. Is it used to show Is ${value} for string column operators.

Query transformation:

  • Add a filter clause based on the selected column, value, and the operator

  • Append a query stage if the selected column is coming from an aggregation or breakout clause.

Question transformation:

  • None

There is a separate function filterDrillDetails which returns query and column used for the FilterPicker. It should automatically append a query stage and find the corresponding filterable column in this stage. It is used for contains and does-not-contain operators.

(ns metabase.lib.drill-thru.quick-filter
  (:require
   [medley.core :as m]
   [metabase.lib.drill-thru.column-filter :as lib.drill-thru.column-filter]
   [metabase.lib.drill-thru.common :as lib.drill-thru.common]
   [metabase.lib.filter :as lib.filter]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.options :as lib.options]
   [metabase.lib.ref :as lib.ref]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.drill-thru :as lib.schema.drill-thru]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.util.malli :as mu]))
(defn- operator [op & args]
  (lib.options/ensure-uuid (into [op {}] args)))
(mu/defn ^:private operators-for :- [:sequential ::lib.schema.drill-thru/drill-thru.quick-filter.operator]
  [column :- lib.metadata/ColumnMetadata
   value]
  (let [field-ref (lib.ref/ref column)]
    (cond
      (lib.types.isa/structured? column)
      []
      (= value :null)
      [{:name "=" :filter (operator :is-null  field-ref)}
       {:name "≠" :filter (operator :not-null field-ref)}]
      (or (lib.types.isa/numeric? column)
          (lib.types.isa/temporal? column))
      (for [[op label] [[:<  "<"]
                        [:>  ">"]
                        [:=  "="]
                        [:!= "≠"]]]
        {:name   label
         :filter (operator op field-ref value)})
      (lib.types.isa/string? column)
      (for [[op label] [[:=  "="]
                        [:!= "≠"]
                        [:contains "contains"]
                        [:does-not-contain "does-not-contain"]]]
        {:name   label
         :filter (operator op field-ref value)})
      :else
      (for [[op label] [[:=  "="]
                        [:!= "≠"]]]
        {:name   label
         :filter (operator op field-ref value)}))))
(mu/defn quick-filter-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.quick-filter]
  "Filter the current query based on the value clicked.
  The options vary depending on the type of the field:
  - `:is-null` and `:not-null` for a `NULL` value;
  - `:=` and `:!=` for everything else;
  - plus `:<` and `:>` for numeric and date columns.
  Note that this returns a single `::drill-thru` value with 1 or more `:operators`; these are rendered as a set of small
  buttons in a single row of the drop-down."
  [query                                :- ::lib.schema/query
   stage-number                         :- :int
   {:keys [column value], :as _context} :- ::lib.schema.drill-thru/context]
  (when (and (lib.drill-thru.common/mbql-stage? query stage-number)
             column
             (some? value) ; Deliberately allows value :null, only a missing value should fail this test.
             (not (lib.types.isa/primary-key? column))
             (not (lib.types.isa/foreign-key? column)))
    ;; For aggregate columns, we want to introduce a new stage when applying the drill-thru.
    ;; [[lib.drill-thru.column-filter/filter-drill-adjusted-query]] handles this. (#34346)
    (let [adjusted (lib.drill-thru.column-filter/filter-drill-adjusted-query query stage-number column)]
      (merge {:lib/type   :metabase.lib.drill-thru/drill-thru
              :type       :drill-thru/quick-filter
              :operators  (operators-for (:column adjusted) value)
              :value      value}
             adjusted))))
(defmethod lib.drill-thru.common/drill-thru-info-method :drill-thru/quick-filter
  [_query _stage-number drill-thru]
  (-> (select-keys drill-thru [:type :operators :value])
      (update :operators (fn [operators]
                           (mapv :name operators)))))
(mu/defmethod lib.drill-thru.common/drill-thru-method :drill-thru/quick-filter :- ::lib.schema/query
  [_query                      :- ::lib.schema/query
   _stage-number               :- :int
   {:keys [query stage-number]
    :as drill}                 :- ::lib.schema.drill-thru/drill-thru.quick-filter
   filter-op                   :- ::lib.schema.common/non-blank-string]
  (let [quick-filter (or (m/find-first #(= (:name %) filter-op) (:operators drill))
                         (throw (ex-info (str "No matching filter for operator " filter-op)
                                         {:drill-thru   drill
                                          :operator     filter-op
                                          :query        query
                                          :stage-number stage-number})))]
    (lib.filter/filter query stage-number (:filter quick-filter))))
 

Adds an order by clause on the selected column.

Entry points:

  • Column header

Requirements:

  • Column not type/Structured

  • If the column is already sorted, allow only the opposite direction to be applied

Query transformation:

  • Add a sort clause with the selection direction

Question transformation:

  • None
(ns metabase.lib.drill-thru.sort
  (:require
   [medley.core :as m]
   [metabase.lib.drill-thru.common :as lib.drill-thru.common]
   [metabase.lib.equality :as lib.equality]
   [metabase.lib.order-by :as lib.order-by]
   [metabase.lib.ref :as lib.ref]
   [metabase.lib.remove-replace :as lib.remove-replace]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.drill-thru :as lib.schema.drill-thru]
   [metabase.lib.schema.order-by :as lib.schema.order-by]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.util.malli :as mu]))

Is column orderable? (Does it appear in [[lib.order-by/orderable-columns]]?)

(defn- orderable-column?
  [query stage-number column]
  (lib.equality/find-matching-column query
                                     stage-number
                                     (lib.ref/ref column)
                                     (lib.order-by/orderable-columns query stage-number)))
(mu/defn ^:private existing-order-by-clause :- [:maybe ::lib.schema.order-by/order-by]
  [query stage-number column]
  (m/find-first (fn [[_direction _opts expr, :as _asc-or-desc-clause]]
                  (lib.equality/find-matching-column query stage-number expr [column]))
                (lib.order-by/order-bys query stage-number)))
(mu/defn ^:private existing-order-by-direction :- [:maybe ::lib.schema.order-by/direction]
  [query stage-number column]
  (when-let [[direction _opts _expr] (existing-order-by-clause query stage-number column)]
    direction))
(mu/defn sort-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.sort]
  "Sorting on a clicked column."
  [query                                :- ::lib.schema/query
   stage-number                         :- :int
   {:keys [column value], :as _context} :- ::lib.schema.drill-thru/context]
  ;; if we have a context with a `:column`, but no `:value`...
  (when (and (lib.drill-thru.common/mbql-stage? query stage-number)
             column
             (nil? value)
             (not (lib.types.isa/structured? column)))
    ;; ...and the column is orderable, we can return a sort drill-thru.
    (when (orderable-column? query stage-number column)
      ;; check and see if there is already a sort on this column. If there is, we should only suggest flipping the
      ;; direction to the opposite of what it is now. If there is no existing sort, then return both directions as
      ;; options.
      (let [existing-direction (existing-order-by-direction query stage-number column)]
        {:lib/type        :metabase.lib.drill-thru/drill-thru
         :type            :drill-thru/sort
         :column          column
         :sort-directions (case existing-direction
                            :asc  [:desc]
                            :desc [:asc]
                            [:asc :desc])}))))
(mu/defmethod lib.drill-thru.common/drill-thru-method :drill-thru/sort
  ([query stage-number drill]
   (lib.drill-thru.common/drill-thru-method query stage-number drill :asc))
  ([query                        :- ::lib.schema/query
    stage-number                 :- :int
    {:keys [column], :as _drill} :- ::lib.schema.drill-thru/drill-thru.sort
    direction                    :- ::lib.schema.order-by/direction]
   ;; if you have an existing order by, the drill thru returned by [[sort-drill]] would only be one that would suggest
   ;; changing it to the opposite direction, so we can safely assume we want to change the direction and
   ;; use [[lib.order-by/change-direction]] here.
   (if-let [existing-clause (existing-order-by-clause query stage-number column)]
     (lib.remove-replace/replace-clause query existing-clause (lib.order-by/order-by-clause column (keyword direction)))
     (lib.order-by/order-by query stage-number column (keyword direction)))))
(defmethod lib.drill-thru.common/drill-thru-info-method :drill-thru/sort
  [_query _stage-number {directions :sort-directions}]
  {:type       :drill-thru/sort
   :directions directions})
 

Adds an aggregation clause based on the selected column. Could be either sum, avg, or distinct.

Entry points:

  • Column header

Requirements:

  • No aggregation or breakout clauses in the query

  • Return operators that are compatible with the column. For Summable columns, all 3 are supported. For other columns only distinct.

Query transformation:

  • Add an aggregation clause with the selected operator

Question transformation:

  • Set default display
(ns metabase.lib.drill-thru.summarize-column
  (:require
   [metabase.lib.aggregation :as lib.aggregation]
   [metabase.lib.breakout :as lib.breakout]
   [metabase.lib.drill-thru.common :as lib.drill-thru.common]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.drill-thru :as lib.schema.drill-thru]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.util.malli :as mu]))
(mu/defn summarize-column-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.summarize-column]
  "A set of possible aggregations that can summarize this column: distinct values, sum, average.
  Separate from [[summarize-column-by-time-drill]] which breaks out a column over time."
  [query                  :- ::lib.schema/query
   stage-number           :- :int
   {:keys [column value]} :- ::lib.schema.drill-thru/context]
  (when (and (lib.drill-thru.common/mbql-stage? query stage-number)
             column
             (nil? value)
             (not (lib.types.isa/structured? column))
             (not= (:lib/source column) :source/aggregations)
             (not (lib.breakout/breakout-column? query stage-number column)))
    ;; I'm not really super clear on how the FE is supposed to be able to display these.
    (let [aggregation-ops (concat [:distinct]
                                  (when (lib.types.isa/summable? column)
                                    [:sum :avg]))]
      {:lib/type     :metabase.lib.drill-thru/drill-thru
       :type         :drill-thru/summarize-column
       :column       column
       :aggregations aggregation-ops})))
(defmethod lib.drill-thru.common/drill-thru-info-method :drill-thru/summarize-column
  [_query _stage-number {:keys [aggregations]}]
  {:type         :drill-thru/summarize-column
   :aggregations aggregations})
(mu/defmethod lib.drill-thru.common/drill-thru-method :drill-thru/summarize-column :- ::lib.schema/query
  [query                            :- ::lib.schema/query
   stage-number                     :- :int
   {:keys [column] :as _drill-thru} :- ::lib.schema.drill-thru/drill-thru.summarize-column
   aggregation                      :- [:or
                                        ::lib.schema.drill-thru/drill-thru.summarize-column.aggregation-type
                                        ;; I guess we'll be ok with strings too for now.
                                        [:enum "distinct" "sum" "avg"]]]
  ;; TODO: The original FE code for this does `setDefaultDisplay` as well.
  (let [aggregation-fn (case (keyword aggregation)
                         :distinct lib.aggregation/distinct
                         :sum      lib.aggregation/sum
                         :avg      lib.aggregation/avg)]
    (lib.aggregation/aggregate query stage-number (aggregation-fn column))))
 

Adds a sum aggregation clause for the selected column and a breakout on the first available date column.

Entry points:

  • Column header

Requirements:

  • No aggregation or breakout clauses in the query

  • The selected column is Summable, i.e. compatible with sum operator

  • There are date columns available for the breakout clause

Query transformation:

  • Add aggregation clause for the selected column

  • Add a breakout on the first available date column. Use the default temporal unit available for this column. This unit is computed based on fingerprint https://github.com/metabase/metabase/blob/0624d8d0933f577cc70c03948f4b57f73fe13ada/frontend/src/metabase-lib/metadata/Field.ts#L397

Question transformation:

  • Set default display
(ns metabase.lib.drill-thru.summarize-column-by-time
  (:require
   [medley.core :as m]
   [metabase.lib.aggregation :as lib.aggregation]
   [metabase.lib.breakout :as lib.breakout]
   [metabase.lib.drill-thru.common :as lib.drill-thru.common]
   [metabase.lib.ref :as lib.ref]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.drill-thru :as lib.schema.drill-thru]
   [metabase.lib.schema.util :as lib.schema.util]
   [metabase.lib.temporal-bucket :as lib.temporal-bucket]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.util.malli :as mu]))
(mu/defn summarize-column-by-time-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.summarize-column-by-time]
  "A breakout summarizing a column over time.
  Separate from single-value [[summarize-column-drill]] for sum, average, and distinct value count."
  [query                  :- ::lib.schema/query
   stage-number           :- :int
   {:keys [column value]} :- ::lib.schema.drill-thru/context]
  (when (and (lib.drill-thru.common/mbql-stage? query stage-number)
             column
             (nil? value)
             (not (lib.types.isa/structured? column))
             (lib.types.isa/summable? column)
             (not= (:lib/source column) :source/aggregations))
    ;; There must be a date dimension available.
    (when-let [breakout-column (m/find-first lib.types.isa/temporal?
                                             (lib.breakout/breakoutable-columns query stage-number))]
      (when-let [bucketing-unit (m/find-first :default
                                              (lib.temporal-bucket/available-temporal-buckets query stage-number breakout-column))]
        ;; only suggest this drill thru if the breakout it would apply does not already exist.
        (let [bucketed (lib.temporal-bucket/with-temporal-bucket breakout-column bucketing-unit)]
          (when (lib.schema.util/distinct-refs? (map lib.ref/ref (cons bucketed (lib.breakout/breakouts query stage-number))))
            {:lib/type :metabase.lib.drill-thru/drill-thru
             :type     :drill-thru/summarize-column-by-time
             :column   column
             :breakout breakout-column
             :unit     (lib.temporal-bucket/raw-temporal-bucket bucketing-unit)}))))))
(defmethod lib.drill-thru.common/drill-thru-method :drill-thru/summarize-column-by-time
  [query stage-number {:keys [breakout column unit] :as _drill-thru} & _]
  (let [bucketed (lib.temporal-bucket/with-temporal-bucket breakout unit)]
    (-> query
        (lib.aggregation/aggregate stage-number (lib.aggregation/sum column))
        (lib.breakout/breakout stage-number bucketed))))
 

"View these Orders" transformation.

Entry points:

  • Cell

  • Pivot cell

  • Legend item

Requirements:

  • Not empty dimensions, i.e. at least 1 breakout in the query

Query transformation:

  • Drop all query stages where there are no aggregation clauses until the last one.

  • Remove all aggregation, breakout, sort, limit, field clauses

  • Add filters for every breakout dimensions using this logic https://github.com/metabase/metabase/blob/0624d8d0933f577cc70c03948f4b57f73fe13ada/frontend/src/metabase-lib/queries/utils/actions.js#L99

  • If there is a selected column (cell only), extract filters associated with this aggregation column. It could be built-in operators (SumIf) or Metrics with filters. Add these filters to the query.

Question transformation:

  • Set display "table"
(ns metabase.lib.drill-thru.underlying-records
  (:require
   [medley.core :as m]
   [metabase.lib.aggregation :as lib.aggregation]
   [metabase.lib.binning :as lib.binning]
   [metabase.lib.convert :as lib.convert]
   [metabase.lib.drill-thru.common :as lib.drill-thru.common]
   [metabase.lib.filter :as lib.filter]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.options :as lib.options]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.drill-thru :as lib.schema.drill-thru]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.lib.temporal-bucket :as lib.temporal-bucket]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.lib.underlying :as lib.underlying]
   [metabase.lib.util :as lib.util]
   [metabase.util.malli :as mu]))
(mu/defn underlying-records-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.underlying-records]
  "When clicking on a particular broken-out group, offer a look at the details of all the rows that went into this
  bucket. Eg. distribution of People by State, then click New York and see the table of all People filtered by
  `STATE = 'New York'`.
  There is another quite different case: clicking the legend of a chart with multiple bars or lines broken out by
  category. Then `column` is nil!"
  [query                                                      :- ::lib.schema/query
   stage-number                                               :- :int
   {:keys [column column-ref dimensions value], :as _context} :- ::lib.schema.drill-thru/context]
  ;; Clicking on breakouts is weird. Clicking on Count(People) by State: Minnesota yields a FE `clicked` with:
  ;; - column is COUNT
  ;; - row[0] has col: STATE, value: "Minnesota"
  ;; - row[1] has col: count (source: "aggregation")
  ;; - dimensions which is [{column: STATE, value: "MN"}]
  ;; - value: the aggregated value (the count, the sum, etc.)
  ;; So dimensions is exactly what we want.
  ;; It returns the table name and row count, since that's used for pluralization of the name.
  ;; Clicking on a chart legend for eg. COUNT(Orders) by Products.CATEGORY and Orders.CREATED_AT has a context like:
  ;; - column is nil
  ;; - value is nil
  ;; - dimensions holds only the legend's column, eg. Products.CATEGORY.
  (when (and (lib.drill-thru.common/mbql-stage? query stage-number)
             (not-empty dimensions)
             ;; Either we need both column and value (cell/map/data point click) or neither (chart legend click).
             (or (and column (some? value))
                 (and (nil? column) (nil? value)))
             ;; If the column exists, it must not be a structured column like JSON.
             (not (and column (lib.types.isa/structured? column))))
    {:lib/type   :metabase.lib.drill-thru/drill-thru
     :type       :drill-thru/underlying-records
     ;; TODO: This is a bit confused for non-COUNT aggregations. Perhaps it should just always be 10 or something?
     ;; Note that some languages have different plurals for exactly 2, or for 1, 2-5, and 6+.
     :row-count  (if (and (number? value)
                          (not (neg? value)))
                   value
                   2)
     :table-name (when-let [table-or-card (or (some->> query lib.util/source-table-id (lib.metadata/table query))
                                              (some->> query lib.util/source-card-id  (lib.metadata/card  query)))]
                   (lib.metadata.calculation/display-name query stage-number table-or-card))
     :dimensions dimensions
     :column-ref column-ref}))
(defmethod lib.drill-thru.common/drill-thru-info-method :drill-thru/underlying-records
  [_query _stage-number {:keys [row-count table-name]}]
  {:type       :drill-thru/underlying-records
   :row-count  row-count
   :table-name table-name})
(mu/defn ^:private drill-filter :- ::lib.schema/query
  [query        :- ::lib.schema/query
   stage-number :- :int
   column       :- ::lib.schema.metadata/column
   value        :- :any]
  (let [filter-clauses (or (when (lib.binning/binning column)
                             (let [unbinned-column (lib.binning/with-binning column nil)]
                               (if (some? value)
                                 (when-let [{:keys [min-value max-value]} (lib.binning/resolve-bin-width query column value)]
                                   [(lib.filter/>= unbinned-column min-value)
                                    (lib.filter/< unbinned-column max-value)])
                                 [(lib.filter/is-null unbinned-column)])))
                           ;; if the column was temporally bucketed in the top level, make sure the `=` filter we
                           ;; generate still has that bucket. Otherwise the filter will be something like
                           ;;
                           ;;    col = March 2023
                           ;;
                           ;; instead of
                           ;;
                           ;;    month(col) = March 2023
                           (let [column (if-let [temporal-unit (::lib.underlying/temporal-unit column)]
                                          (lib.temporal-bucket/with-temporal-bucket column temporal-unit)
                                          column)]
                             [(lib.filter/= column value)]))]
    (reduce
     (fn [query filter-clause]
       (lib.filter/filter query stage-number filter-clause))
     query
     filter-clauses)))

Drops aggregations, breakouts, orders, limits and field, then applies a filter for each of the dimensions (including for metrics, and aggregations that imply a filter like :sum-where).

Extracted to a helper since it's reused by automatic-insights drill.

(defn drill-underlying-records
  [query {:keys [column-ref dimensions] :as _context}]
  (let [;; Drop all aggregations, breakouts, sort orders, etc. to get the underlying records.
        ;; Note that all operations are performed on the final stage of input query.
        base-query  (lib.util/update-query-stage query -1 dissoc :aggregation :breakout :order-by :limit :fields)
        ;; Turn any non-aggregation dimensions into filters.
        ;; eg. if we drilled into a temporal bucket, add a filter for the [:= breakout-column that-month].
        filtered    (reduce (fn [q {:keys [column value]}]
                              (drill-filter q -1 column value))
                            base-query
                            (for [dimension dimensions
                                  :when (-> dimension :column :lib/source (not= :source/aggregations))]
                              dimension))
        ;; The column-ref should be an aggregation ref - look up the full aggregation.
        aggregation (when-let [agg-uuid (last column-ref)]
                      (m/find-first #(= (lib.options/uuid %) agg-uuid)
                                    (lib.aggregation/aggregations query -1)))]
    ;; Apply the filters derived from the aggregation.
    (reduce #(lib.filter/filter %1 -1 %2)
            filtered
            ;; If we found an aggregation, check if it implies further filtering.
            ;; Simple aggregations like :sum don't add more filters; metrics or fancy aggregations like :sum-where do.
            (when aggregation
              (case (first aggregation)
                ;; Fancy aggregations that filter the input - the filter is the last part of the aggregation.
                (:sum-where :count-where :share)
                [(last aggregation)]
                ;; Metrics are standard filter + aggregation units; if the column is a metric get its filters.
                :metric
                (-> (lib.metadata/metric query (last aggregation))
                    :definition
                    lib.convert/js-legacy-inner-query->pMBQL
                    (assoc :database (:database query))
                    (lib.filter/filters -1))
                ;; Default: no filters to add.
                nil)))))
(defmethod lib.drill-thru.common/drill-thru-method :drill-thru/underlying-records
  [query _stage-number context & _]
  ;; Note that the input _stage-number is deliberately ignored. The top-level query may have fewer stages than the
  ;; input query; all operations are performed on the final stage of the top-level query.
  (drill-underlying-records (lib.underlying/top-level-query query)
                            (update context :dimensions
                                    (fn [dims]
                                      (for [dim dims]
                                        (update dim :column #(lib.underlying/top-level-column query %)))))))
 

Object details drill for PK columns when there is a single PK column available.

Entry points:

  • Cell

Requirements:

  • There is only on PK column available in returned columns

  • Selected column is not a FK

  • Selected column is either a FK OR the query has no aggregations (in this case the PK column should be used instead of the selected column)

  • The value for the PK column (which can be different to selected column) in the data row is not null.

Query transformation:

  • None/identity

Question transformation:

  • None

A :zoom drill is a 'View details' drill when you click on the value of a PK column in a Table that has EXACTLY ONE PK column. In MLv2, it is a no-op; in the frontend it changes the URL to take you to the 'object details' view for the row in question. For Tables with multiple PK columns, a [[metabase.lib.drill-thru.pk]] drill is returned instead.

We will only possibly return one of the 'object details' drills ([[metabase.lib.drill-thru.pk]], [[metabase.lib.drill-thru.fk-details]], or [[metabase.lib.drill-thru.zoom]]); see [[metabase.lib.drill-thru.object-details]] for the high-level logic that calls out to the individual implementations.

(ns metabase.lib.drill-thru.zoom
  (:require
   [medley.core :as m]
   [metabase.lib.drill-thru.common :as lib.drill-thru.common]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.drill-thru :as lib.schema.drill-thru]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.util.malli :as mu]))
(defn- zoom-drill* [column value]
  {:lib/type  :metabase.lib.drill-thru/drill-thru
   :type      :drill-thru/zoom
   :column    column
   :object-id value
   :many-pks? false})
(mu/defn zoom-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.zoom]
  "Return a `:zoom` drill when clicking on the value of a PK column in a Table that has only one PK column."
  [query                                   :- ::lib.schema/query
   _stage-number                           :- :int
   {:keys [column value row] :as _context} :- ::lib.schema.drill-thru/context]
  (when (and
         ;; ignore clicks on headers (value = nil rather than :null)
         (some? value)
         ;; if this table has more than one PK we should be returning a [[metabase.lib.drill-thru.pk]] instead.
         (not (lib.drill-thru.common/many-pks? query)))
    (if (lib.types.isa/primary-key? column)
      ;; PK column was clicked. Ignore NULL values.
      (when-not (= value :null)
        (zoom-drill* column value))
      ;; some other column was clicked. Find the PK column and create a filter for its value.
      (let [[pk-column] (lib.metadata.calculation/primary-keys query)]
        (when-let [pk-value (->> row
                                 (m/find-first #(-> % :column :name (= (:name pk-column))))
                                 :value)]
          (zoom-drill* pk-column pk-value))))))
(defmethod lib.drill-thru.common/drill-thru-info-method :drill-thru/zoom
  [_query _stage-number drill-thru]
  (select-keys drill-thru [:many-pks? :object-id :type]))
(mu/defmethod lib.drill-thru.common/drill-thru-method :drill-thru/zoom :- ::lib.schema/query
  [query         :- ::lib.schema/query
   _stage-number :- :int
   _drill        :- ::lib.schema.drill-thru/drill-thru.zoom]
  ;; this is just an identity transformation, see
  ;; https://metaboat.slack.com/archives/C04CYTEL9N2/p1693965932617369
  query)
 

"Zoom" transform for numeric (including location) columns.

Entry points:

  • Cell

  • Pivot cell

  • Legend item

Requirements:

  • dimensions have a numeric column with a binning strategy applied. It can be the default one ("Auto"). Only the first matching column would be used in query transformation.

Query transformation:

  • Remove breakouts for dimensions. Please note that with regular cells and pivot cells it would mean removing all breakouts; but with legend item clicks it would remove the breakout for the legend item column only.

  • Add a filter based on columns and values from dimensions. Take temporal units and binning strategies into account https://github.com/metabase/metabase/blob/0624d8d0933f577cc70c03948f4b57f73fe13ada/frontend/src/metabase-lib/queries/utils/actions.js#L99

  • Add a breakout based on the numeric column (from requirements). For location columns, use the binning strategy that is 10x more granular (e.g. Every 1 degree -> Every 0.1 degrees). For numeric columns, use the default binning strategy ("Auto").

Question transformation:

  • Set default display

This covers two types of 'zoom in' drills:

  1. If we have a query with a breakout with binning using the :num-bins strategy, return a drill that when applied adds a filter for the selected bin ('zooms in') and changes the binning strategy to default. E.g.

    ORDERS + count aggregation + breakout on TOTAL (10 bins)

    =>

    Click the 40-60 bin in the results (returned by the QP as 40) and choose 'Zoom In'

    =>

    ORDERS + count aggregation + filter TOTAL >= 40 and < 60 + breakout on TOTAL (auto bin)

    Note that we need to look at the fingerprint info in the column metadata to determine how big each bin is (e.g. to determine each bin was 20 wide) -- this uses [[lib.binning.util/nicer-bin-width]], which is what the QP uses.

    In other words, this bin adds a filter for the selected bin and the replaces the breakout binning with a :default binning strategy.

  2. Breakout with binning with :bin-width:

    PEOPLE + count aggregation + breakout on LATITUDE (bin width: 1°)

    =>

    Click on the 41°-42° bin in the results (returned by the QP as 41) and choose 'Zoom In'

    =>

    PEOPLE + count aggregation + filter LATITUDE >= 41 and < 42 + breakout on LATITUDE (bin width: 0.1°)

    In other words, this bin adds a filter for the selected bin and then divides the bin width in the breakout binning options by 10.

(ns metabase.lib.drill-thru.zoom-in-bins
  (:require
   [metabase.lib.binning :as lib.binning]
   [metabase.lib.breakout :as lib.breakout]
   [metabase.lib.drill-thru.common :as lib.drill-thru.common]
   [metabase.lib.filter :as lib.filter]
   [metabase.lib.remove-replace :as lib.remove-replace]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.binning :as lib.schema.binning]
   [metabase.lib.schema.drill-thru :as lib.schema.drill-thru]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.util.malli :as mu]))

available-drill-thrus

(mu/defn zoom-in-binning-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.zoom-in.binning]
  "Return a drill thru that 'zooms in' on a breakout that uses `:binning` if applicable.
  See [[metabase.lib.drill-thru.zoom-in-bins]] docstring for more information."
  [query                                :- ::lib.schema/query
   stage-number                         :- :int
   {:keys [column value], :as _context} :- ::lib.schema.drill-thru/context]
  (when (and column value)
    (when-let [existing-breakout (first (lib.breakout/existing-breakouts query stage-number column))]
      (when-let [binning (lib.binning/binning existing-breakout)]
        (when-let [{:keys [min-value max-value bin-width]} (lib.binning/resolve-bin-width query column value)]
          (case (:strategy binning)
            (:num-bins :default)
            {:lib/type    :metabase.lib.drill-thru/drill-thru
             :type        :drill-thru/zoom-in.binning
             :column      column
             :min-value   value
             :max-value   (+ value bin-width)
             :new-binning {:strategy :default}}
            :bin-width
            {:lib/type    :metabase.lib.drill-thru/drill-thru
             :type        :drill-thru/zoom-in.binning
             :column      column
             :min-value   min-value
             :max-value   max-value
             :new-binning (update binning :bin-width #(double (/ % 10.0)))}))))))

application

(mu/defn ^:private update-breakout :- ::lib.schema/query
  [query        :- ::lib.schema/query
   stage-number :- :int
   column       :- ::lib.schema.metadata/column
   new-binning  :- ::lib.schema.binning/binning]
  (if-let [existing-breakout (first (lib.breakout/existing-breakouts query stage-number column))]
    (lib.remove-replace/replace-clause query stage-number existing-breakout (lib.binning/with-binning column new-binning))
    (lib.breakout/breakout query stage-number (lib.binning/with-binning column new-binning))))
(mu/defmethod lib.drill-thru.common/drill-thru-method :drill-thru/zoom-in.binning :- ::lib.schema/query
  [query                                        :- ::lib.schema/query
   stage-number                                 :- :int
   {:keys [column min-value max-value new-binning]} :- ::lib.schema.drill-thru/drill-thru.zoom-in.binning]
  (-> query
      (lib.filter/filter stage-number (lib.filter/>= column min-value))
      (lib.filter/filter stage-number (lib.filter/< column max-value))
      (update-breakout stage-number column new-binning)))
 

"Zoom" transform for different geo semantic types.

Entry points:

  • Cell

  • Pivot cell

  • Legend item

Possible transformations:

  • Country -> State

  • Country -> LatLon(10)

  • State -> LatLon(1)

  • City -> LatLon(0.1)

  • LatLon -> LatLon

Query transformation follows rules from other zoom-in transforms, however new breakout columns are handled differently for each type.

  • Country -> State. If a column with type/State semantic type exists, add a filter based on the selected country and breakout by State.

  • Country -> LatLon(10). If there is no type/State column available but there are type/Latitude and type/Longitude columns, add a filter based on the selected country and 2 breakouts (latitude and longitude) using "Every 10 degrees" binning strategy.

  • State -> LatLon(1). Add a filter based on the selected state and 2 breakouts (latitude and longitude) using "Every 1 degree" binning strategy.

  • City -> LatLon(0.1). Add a filter based on the selected city and 2 breakouts (latitude and longitude) using "Every 0.1 degrees" binning strategy.

  • LatLon -> LatLon. If the binning strategy is more greater than every 20 degrees, change it to 10 degrees. Otherwise divide the value by 10 and use it as the new binning strategy.

Question transformation:

  • Set default display

All geographic zooms require both a :type/Latitude and a :type/Longitude column in [[metabase.lib.metadata.calculation/visible-columns]], not necessarily in the query's [[metabase.lib.metadata.calculation/returned-columns]]. E.g. 'count broken out by state' query should still get presented this drill.

These drills are only for 'cell' context for specific values.

Geographic zooms are of the following flavors:

  1. Country, State, or City => Binned LatLon

    1a. If we are breaking out by a :type/Country column: remove breakout on country column, and add/replace breakouts on Latitude/Longitude with binning :bin-width of 10°, and add = filter for the clicked country value.

    1b. If we have a :type/State column, remove breakout on state column, add/replace breakouts on Latitude/Longitude with binning :bin-width of 1°, and add = filter for the clicked state value.

    1c. If we have a :type/City column, remove breakout on city column, add/replace breakouts on Latitude/Longitude with binning :bin-width of 0.1°, and add = filter for the clicked city value.

  2. Binned LatLon => Binned LatLon

    If we have binned breakouts on latitude and longitude:

    2a. With binning :bin-width >= 20°, replace them with :bin-width of 10° and add :>=/:< filters for the clicked latitude/longitude values.

    2b. Otherwise if :bin-width is < 20°, replace them with the current :bin-width divided by 10, and add :>=/:< filters for the clicked latitude/longitude values.

(ns metabase.lib.drill-thru.zoom-in-geographic
  (:require
   [medley.core :as m]
   [metabase.lib.binning :as lib.binning]
   [metabase.lib.breakout :as lib.breakout]
   [metabase.lib.drill-thru.common :as lib.drill-thru.common]
   [metabase.lib.filter :as lib.filter]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.remove-replace :as lib.remove-replace]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.binning :as lib.schema.binning]
   [metabase.lib.schema.drill-thru :as lib.schema.drill-thru]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.lib.util :as lib.util]
   [metabase.util.malli :as mu]))
(def ^:private ContextWithLatLon
  [:merge
   ::lib.schema.drill-thru/context
   [:map
    [:lat-column ::lib.schema.metadata/column]
    [:lon-column ::lib.schema.metadata/column]
    [:lat-value  [:maybe number?]]
    [:lon-value  [:maybe number?]]]])
(mu/defn ^:private context-with-lat-lon :- [:maybe ContextWithLatLon]
  [query                      :- ::lib.schema/query
   stage-number               :- :int
   {:keys [row], :as context} :- ::lib.schema.drill-thru/context]
  (let [columns (lib.metadata.calculation/visible-columns query stage-number (lib.util/query-stage query stage-number))]
    (when-let [lat-column (m/find-first lib.types.isa/latitude? columns)]
      (when-let [lon-column (m/find-first lib.types.isa/longitude? columns)]
        (letfn [(same-column? [col-x col-y]
                  (if (:id col-x)
                    (= (:id col-x) (:id col-y))
                    (= (:lib/desired-column-alias col-x) (:lib/desired-column-alias col-y))))
                (column-value [column]
                  (some
                   (fn [row-value]
                     (when (same-column? column (:column row-value))
                       (:value row-value)))
                   row))]
          (assoc context
                 :lat-column lat-column
                 :lon-column lon-column
                 :lat-value (column-value lat-column)
                 :lon-value (column-value lon-column)))))))

available-drill-thrus

(mu/defn ^:private country-state-city->binned-lat-lon-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.zoom-in.geographic.country-state-city->binned-lat-lon]
  [{:keys [column value lat-column lon-column], :as _context} :- ContextWithLatLon
   lat-lon-bin-width                                          :- ::lib.schema.binning/bin-width]
  (when value
    {:lib/type  :metabase.lib.drill-thru/drill-thru
     :type      :drill-thru/zoom-in.geographic
     :subtype   :drill-thru.zoom-in.geographic/country-state-city->binned-lat-lon
     :column    column
     :value     value
     :latitude  {:column    lat-column
                 :bin-width lat-lon-bin-width}
     :longitude {:column    lon-column
                 :bin-width lat-lon-bin-width}}))
(mu/defn ^:private country->binned-lat-lon-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.zoom-in.geographic.country-state-city->binned-lat-lon]
  [{:keys [column], :as context} :- ContextWithLatLon]
  (when (some-> column lib.types.isa/country?)
    (country-state-city->binned-lat-lon-drill context 10)))
(mu/defn ^:private state->binned-lat-lon-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.zoom-in.geographic.country-state-city->binned-lat-lon]
  [{:keys [column], :as context} :- ContextWithLatLon]
  (when (some-> column lib.types.isa/state?)
    (country-state-city->binned-lat-lon-drill context 1)))
(mu/defn ^:private city->binned-lat-lon-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.zoom-in.geographic.country-state-city->binned-lat-lon]
  [{:keys [column], :as context} :- ContextWithLatLon]
  (when (some-> column lib.types.isa/city?)
    (country-state-city->binned-lat-lon-drill context 0.1)))
(mu/defn ^:private binned-lat-lon->binned-lat-lon-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.zoom-in.geographic.binned-lat-lon->binned-lat-lon]
  [metadata-providerable                                             :- ::lib.schema.metadata/metadata-providerable
   {:keys [lat-column lon-column lat-value lon-value], :as _context} :- ContextWithLatLon]
  (when (and lat-value
             lon-value)
    (when-let [{lat-bin-width :bin-width} (lib.binning/resolve-bin-width metadata-providerable lat-column lat-value)]
      (when-let [{lon-bin-width :bin-width} (lib.binning/resolve-bin-width metadata-providerable lon-column lon-value)]
        (let [[new-lat-bin-width new-lon-bin-width] (if (and (>= lat-bin-width 20)
                                                             (>= lon-bin-width 20))
                                                      [10 10]
                                                      [(/ lat-bin-width 10.0)
                                                       (/ lon-bin-width 10.0)])]
          {:lib/type  :metabase.lib.drill-thru/drill-thru
           :type      :drill-thru/zoom-in.geographic
           :subtype   :drill-thru.zoom-in.geographic/binned-lat-lon->binned-lat-lon
           :latitude  {:column    lat-column
                       :bin-width new-lat-bin-width
                       :min       lat-value
                       :max       (+ lat-value lat-bin-width)}
           :longitude {:column    lon-column
                       :bin-width new-lon-bin-width
                       :min       lon-value
                       :max       (+ lon-value lon-bin-width)}})))))
(mu/defn zoom-in-geographic-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.zoom-in.geographic]
  "Return a `:drill-thru/zoom-in.geographic` drill if appropriate. See docstring
  for [[metabase.lib.drill-thru.zoom-in-geographic]] for more information on what circumstances this is returned in
  and what it means to apply this drill."
  [query                        :- ::lib.schema/query
   stage-number                 :- :int
   {:keys [value], :as context} :- ::lib.schema.drill-thru/context]
  (when value
    (when-let [context (context-with-lat-lon query stage-number context)]
      (some (fn [f]
              (f context))
            [country->binned-lat-lon-drill
             state->binned-lat-lon-drill
             city->binned-lat-lon-drill
             (partial binned-lat-lon->binned-lat-lon-drill query)]))))

Application

(mu/defn ^:private add-or-update-binning :- ::lib.schema/query
  [query        :- ::lib.schema/query
   stage-number :- :int
   column       :- ::lib.schema.metadata/column
   bin-width    :- pos?]
  (let [binning {:strategy  :bin-width
                 :bin-width bin-width}]
    (if-let [existing-breakout (first (lib.breakout/existing-breakouts query stage-number column))]
      (let [new-breakout (lib.binning/with-binning existing-breakout binning)]
        (lib.remove-replace/replace-clause query stage-number existing-breakout new-breakout))
      (lib.breakout/breakout query stage-number (lib.binning/with-binning column binning)))))
(mu/defn ^:private add-or-update-lat-lon-binning :- ::lib.schema/query
  [query                                                :- ::lib.schema/query
   stage-number                                         :- :int
   {{lat :column, lat-bin-width :bin-width} :latitude
    {lon :column, lon-bin-width :bin-width} :longitude} :- ::lib.schema.drill-thru/drill-thru.zoom-in.geographic]
  (-> query
      (add-or-update-binning stage-number lat lat-bin-width)
      (add-or-update-binning stage-number lon lon-bin-width)))
(mu/defn ^:private apply-country-state-city->binned-lat-lon-drill :- ::lib.schema/query
  [query                             :- ::lib.schema/query
   stage-number                      :- :int
   {:keys [column value], :as drill} :- ::lib.schema.drill-thru/drill-thru.zoom-in.geographic.country-state-city->binned-lat-lon]
  (-> query
      (lib.breakout/remove-existing-breakouts-for-column stage-number column)
      ;; TODO -- remove/update existing filter?
      (lib.filter/filter stage-number (lib.filter/= column value))
      (add-or-update-lat-lon-binning stage-number drill)))
(mu/defn ^:private apply-binned-lat-lon->binned-lat-lon-drill :- ::lib.schema/query
  [query        :- ::lib.schema/query
   stage-number :- :int
   {{lat :column, lat-min :min, lat-max :max} :latitude
    {lon :column, lon-min :min, lon-max :max} :longitude
    :as drill} :- ::lib.schema.drill-thru/drill-thru.zoom-in.geographic.binned-lat-lon->binned-lat-lon]
  (-> query
      ;; TODO -- remove/update existing filters on these columns?
      (lib.filter/filter stage-number (lib.filter/>= lat lat-min))
      (lib.filter/filter stage-number (lib.filter/<  lat lat-max))
      (lib.filter/filter stage-number (lib.filter/>= lon lon-min))
      (lib.filter/filter stage-number (lib.filter/<  lon lon-max))
      (add-or-update-lat-lon-binning stage-number drill)))
(mu/defmethod lib.drill-thru.common/drill-thru-method :drill-thru/zoom-in.geographic :- ::lib.schema/query
  [query                        :- ::lib.schema/query
   stage-number                 :- :int
   {:keys [subtype], :as drill} :- ::lib.schema.drill-thru/drill-thru.zoom-in.geographic]
  (case subtype
    :drill-thru.zoom-in.geographic/country-state-city->binned-lat-lon
    (apply-country-state-city->binned-lat-lon-drill query stage-number drill)
    :drill-thru.zoom-in.geographic/binned-lat-lon->binned-lat-lon
    (apply-binned-lat-lon->binned-lat-lon-drill query stage-number drill)))
 

"See this month by weeks" type of transform.

Entry points:

  • Cell

  • Pivot cell

  • Legend item

Requirements:

  • dimensions have a date column with year, quarter, month, week, day, hour temporal unit. For other units, or when there is no temporal bucketing this drill cannot be applied. Changing hour to minute ends the sequence. Only the first matching column would be used in query transformation.

  • displayInfo returns displayName with See this {0} by {1} string using the current and the next available temporal unit.

Query transformation:

  • Remove breakouts for dimensions. Please note that with regular cells and pivot cells it would mean removing all breakouts; but with legend item clicks it would remove the breakout for the legend item column only.

  • Add a filter based on columns and values from dimensions. Take temporal units and binning strategies into account https://github.com/metabase/metabase/blob/0624d8d0933f577cc70c03948f4b57f73fe13ada/frontend/src/metabase-lib/queries/utils/actions.js#L99

  • Add a breakout based on the date column (from requirements), using the next (more granular) temporal unit.

Question transformation:

  • Set default display
(ns metabase.lib.drill-thru.zoom-in-timeseries
  (:require
   [metabase.lib.breakout :as lib.breakout]
   [metabase.lib.drill-thru.common :as lib.drill-thru.common]
   [metabase.lib.equality :as lib.equality]
   [metabase.lib.filter :as lib.filter]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.remove-replace :as lib.remove-replace]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.drill-thru :as lib.schema.drill-thru]
   [metabase.lib.schema.temporal-bucketing
    :as lib.schema.temporal-bucketing]
   [metabase.lib.temporal-bucket :as lib.temporal-bucket]
   [metabase.lib.util :as lib.util]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util.malli :as mu]))

TODO -- we shouldn't include hour and minute for :type/Date columns.

(def ^:private valid-current-units
  [:year :quarter :month :week :day :hour :minute])
(def ^:private unit->next-unit
  (zipmap (drop-last valid-current-units)
          (drop 1 valid-current-units)))
(mu/defn ^:private matching-breakout-dimension :- [:maybe ::lib.schema.drill-thru/context.row.value]
  [query        :- ::lib.schema/query
   stage-number :- :int
   dimensions   :- [:sequential ::lib.schema.drill-thru/context.row.value]]
  (first (for [breakout (lib.breakout/breakouts query stage-number)
               :when (and (lib.util/clause-of-type? breakout :field)
                          (lib.temporal-bucket/temporal-bucket breakout))
               {:keys [column] :as dimension} dimensions
               :when (and (lib.equality/find-matching-column breakout [column])
                          (= (lib.temporal-bucket/temporal-bucket breakout)
                             (lib.temporal-bucket/temporal-bucket column)))]
           (assoc dimension :column-ref breakout))))
(mu/defn ^:private next-breakout-unit :- [:maybe ::lib.schema.temporal-bucketing/unit.date-time.truncate]
  [column :- lib.metadata/ColumnMetadata]
  (when-let [current-unit (lib.temporal-bucket/raw-temporal-bucket column)]
    (when (contains? (set valid-current-units) current-unit)
      (unit->next-unit current-unit))))
(mu/defn ^:private describe-next-unit :- ::lib.schema.common/non-blank-string
  [unit :- ::lib.schema.drill-thru/drill-thru.zoom-in.timeseries.next-unit]
  (case unit
    :quarter (i18n/tru "See this year by quarter")
    :month   (i18n/tru "See this quarter by month")
    :week    (i18n/tru "See this month by week")
    :day     (i18n/tru "See this week by day")
    :hour    (i18n/tru "See this day by hour")
    :minute  (i18n/tru "See this hour by minute")))
(mu/defn zoom-in-timeseries-drill :- [:maybe ::lib.schema.drill-thru/drill-thru.zoom-in.timeseries]
  "Zooms in on some window, showing it in finer detail.
  For example: The month of a year, days or weeks of a quarter, smaller lat/long regions, etc.
  This is different from the `:drill-thru/zoom` type, which is for showing the details of a single object."
  [query                              :- ::lib.schema/query
   stage-number                       :- :int
   {:keys [dimensions], :as _context} :- ::lib.schema.drill-thru/context]
  (when (and (lib.drill-thru.common/mbql-stage? query stage-number)
             (not-empty dimensions))
    (when-let [{:keys [value], :as dimension} (matching-breakout-dimension query stage-number dimensions)]
      (when value
        (when-let [next-unit (next-breakout-unit (:column dimension))]
          {:lib/type     :metabase.lib.drill-thru/drill-thru
           :display-name (describe-next-unit next-unit)
           :type         :drill-thru/zoom-in.timeseries
           :dimension    dimension
           :next-unit    next-unit})))))
(mu/defmethod lib.drill-thru.common/drill-thru-method :drill-thru/zoom-in.timeseries
  [query                         :- ::lib.schema/query
   stage-number                  :- :int
   {:keys [dimension next-unit]} :- ::lib.schema.drill-thru/drill-thru.zoom-in.timeseries]
  (let [{:keys [column value]} dimension
        old-breakout           (:column-ref dimension)
        new-breakout           (lib.temporal-bucket/with-temporal-bucket old-breakout next-unit)]
    (-> query
        (lib.filter/filter stage-number (lib.filter/= column value))
        (lib.remove-replace/replace-clause stage-number old-breakout new-breakout))))
 
(ns metabase.lib.expression
  (:refer-clojure
   :exclude
   [+ - * / case coalesce abs time concat replace])
  (:require
   [clojure.string :as str]
   [malli.core :as mc]
   [medley.core :as m]
   [metabase.lib.common :as lib.common]
   [metabase.lib.hierarchy :as lib.hierarchy]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.options :as lib.options]
   [metabase.lib.ref :as lib.ref]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.expression :as lib.schema.expression]
   [metabase.lib.schema.temporal-bucketing
    :as lib.schema.temporal-bucketing]
   [metabase.lib.temporal-bucket :as lib.temporal-bucket]
   [metabase.lib.util :as lib.util]
   [metabase.shared.util.i18n :as i18n]
   [metabase.types :as types]
   [metabase.util :as u]
   [metabase.util.malli :as mu]))
(mu/defn column-metadata->expression-ref :- :mbql.clause/expression
  "Given `:metadata/column` column metadata for an expression, construct an `:expression` reference."
  [metadata :- lib.metadata/ColumnMetadata]
  (let [options {:lib/uuid       (str (random-uuid))
                 :base-type      (:base-type metadata)
                 :effective-type ((some-fn :effective-type :base-type) metadata)}]
    [:expression options ((some-fn :lib/expression-name :name) metadata)]))
(mu/defn resolve-expression :- ::lib.schema.expression/expression
  "Find the expression with `expression-name` in a given stage of a `query`, or throw an Exception if it doesn't
  exist."
  ([query expression-name]
   (resolve-expression query -1 expression-name))
  ([query           :- ::lib.schema/query
    stage-number    :- :int
    expression-name :- ::lib.schema.common/non-blank-string]
   (let [stage (lib.util/query-stage query stage-number)]
     (or (m/find-first (comp #{expression-name} lib.util/expression-name)
                       (:expressions stage))
         (throw (ex-info (i18n/tru "No expression named {0}" (pr-str expression-name))
                         {:expression-name expression-name
                          :query           query
                          :stage-number    stage-number}))))))
(defmethod lib.metadata.calculation/type-of-method :expression
  [query stage-number [_expression _opts expression-name, :as _expression-ref]]
  (let [expression (resolve-expression query stage-number expression-name)]
    (lib.metadata.calculation/type-of query stage-number expression)))
(defmethod lib.metadata.calculation/metadata-method :expression
  [query stage-number [_expression opts expression-name, :as expression-ref-clause]]
  {:lib/type            :metadata/column
   :lib/source-uuid     (:lib/uuid opts)
   :name                expression-name
   :lib/expression-name expression-name
   :display-name        (lib.metadata.calculation/display-name query stage-number expression-ref-clause)
   :base-type           (lib.metadata.calculation/type-of query stage-number expression-ref-clause)
   :lib/source          :source/expressions})
(defmethod lib.metadata.calculation/display-name-method :dispatch-type/integer
  [_query _stage-number n _style]
  (str n))
(defmethod lib.metadata.calculation/display-name-method :dispatch-type/number
  [_query _stage-number n _style]
  (str n))
(defmethod lib.metadata.calculation/display-name-method :dispatch-type/string
  [_query _stage-number s _style]
  (str \" s \"))
(defmethod lib.metadata.calculation/display-name-method :dispatch-type/boolean
  [_query _stage-number s _style]
  (str s))
(defmethod lib.metadata.calculation/display-name-method :expression
  [_query _stage-number [_expression _opts expression-name] _style]
  expression-name)
(defmethod lib.metadata.calculation/column-name-method :expression
  [_query _stage-number [_expression _opts expression-name]]
  expression-name)

Whether the display name we are generated is recursively nested inside another display name. For infix math operators we'll wrap the results in parentheses to make the display name more obvious.

(def ^:private ^:dynamic *nested*
  false)
(defn- wrap-str-in-parens-if-nested [s]
  (if *nested*
    (str \( s \))
    s))

Generate a infix-style display name for an arithmetic expression like :+, e.g. x + y.

(defn- infix-display-name
  [query stage-number operator args]
  (wrap-str-in-parens-if-nested
   (binding [*nested* true]
     (str/join (str \space (name operator) \space)
               (map (partial lib.metadata.calculation/display-name query stage-number)
                    args)))))
(def ^:private infix-operator-display-name
  {:+ "+"
   :- "-"
   :* "×"
   :/ "÷"})
(doseq [tag [:+ :- :/ :*]]
  (lib.hierarchy/derive tag ::infix-operator))
(defmethod lib.metadata.calculation/display-name-method ::infix-operator
  [query stage-number [tag _opts & args] _style]
  (infix-display-name query stage-number (get infix-operator-display-name tag) args))
(defmethod lib.metadata.calculation/column-name-method ::infix-operator
  [_query _stage-number _expr]
  "expression")

:+, :-, and :* all have the same logic; also used for [[metabase.lib.schema.expression/type-of]].

:lib.type-of/type-is-type-of-arithmetic-args is defined in [[metabase.lib.schema.expression.arithmetic]]

(defmethod lib.metadata.calculation/type-of-method :lib.type-of/type-is-type-of-arithmetic-args
  [query stage-number [_tag _opts & args]]
  ;; Okay to use reduce without an init value here since we know we have >= 2 args
  #_{:clj-kondo/ignore [:reduce-without-init]}
  (reduce
   types/most-specific-common-ancestor
   (for [arg args]
     (lib.metadata.calculation/type-of query stage-number arg))))

TODO -- this stuff should probably be moved into [[metabase.lib.temporal-bucket]]

(defn- interval-unit-str [amount unit]
  ;; this uses [[clojure.string/lower-case]] so its in the user's locale in the browser rather than always using
  ;; English lower-casing rules.
  #_{:clj-kondo/ignore [:discouraged-var]}
  (str/lower-case (lib.temporal-bucket/describe-temporal-unit amount unit)))
(mu/defn ^:private interval-display-name  :- ::lib.schema.common/non-blank-string
  "e.g. something like \"- 2 days\
  [amount :- :int
   unit   :- ::lib.schema.temporal-bucketing/unit.date-time.interval]
  ;; TODO -- sorta duplicated with [[metabase.shared.parameters.parameters/translated-interval]], but not exactly
  (let [unit-str (interval-unit-str amount unit)]
    (wrap-str-in-parens-if-nested
     (if (pos? amount)
       (lib.util/format "+ %d %s" amount                    unit-str)
       (lib.util/format "- %d %s" (clojure.core/abs amount) unit-str)))))
(mu/defn ^:private interval-column-name  :- ::lib.schema.common/non-blank-string
  "e.g. something like `minus_2_days`"
  [amount :- :int
   unit   :- ::lib.schema.temporal-bucketing/unit.date-time.interval]
  ;; TODO -- sorta duplicated with [[metabase.shared.parameters.parameters/translated-interval]], but not exactly
  (let [unit-str (interval-unit-str amount unit)]
    (if (pos? amount)
      (lib.util/format "plus_%s_%s"  amount                    unit-str)
      (lib.util/format "minus_%d_%s" (clojure.core/abs amount) unit-str))))
(defmethod lib.metadata.calculation/display-name-method :datetime-add
  [query stage-number [_datetime-add _opts x amount unit] style]
  (str (lib.metadata.calculation/display-name query stage-number x style)
       \space
       (interval-display-name amount unit)))
(defmethod lib.metadata.calculation/column-name-method :datetime-add
  [query stage-number [_datetime-add _opts x amount unit]]
  (str (lib.metadata.calculation/column-name query stage-number x)
       \_
       (interval-column-name amount unit)))

for now we'll just pretend :coalesce isn't a present and just use the display name for the expr it wraps.

(defmethod lib.metadata.calculation/display-name-method :coalesce
  [query stage-number [_coalesce _opts expr _null-expr] style]
  (lib.metadata.calculation/display-name query stage-number expr style))
(defmethod lib.metadata.calculation/column-name-method :coalesce
  [query stage-number [_coalesce _opts expr _null-expr]]
  (lib.metadata.calculation/column-name query stage-number expr))
(defn- conflicting-name? [query stage-number expression-name]
  (let [stage     (lib.util/query-stage query stage-number)
        cols      (lib.metadata.calculation/visible-columns query stage-number stage)
        expr-name (u/lower-case-en expression-name)]
    (some #(-> % :name u/lower-case-en (= expr-name)) cols)))
(defn- add-expression-to-stage
  [stage expression]
  (cond-> (update stage :expressions (fnil conj []) expression)
    ;; if there are explicit fields selected, add the expression to them
    (vector? (:fields stage))
    (update :fields conj (lib.options/ensure-uuid [:expression {} (lib.util/expression-name expression)]))))
(mu/defn expression :- ::lib.schema/query
  "Adds an expression to query."
  ([query expression-name expressionable]
   (expression query -1 expression-name expressionable))
  ([query                :- ::lib.schema/query
    stage-number         :- [:maybe :int]
    expression-name      :- ::lib.schema.common/non-blank-string
    expressionable]
   (let [stage-number (or stage-number -1)]
     (when (conflicting-name? query stage-number expression-name)
       (throw (ex-info "Expression name conflicts with a column in the same query stage"
                       {:expression-name expression-name})))
     (lib.util/update-query-stage
      query stage-number
      add-expression-to-stage
      (-> (lib.common/->op-arg expressionable)
          (lib.util/top-level-expression-clause expression-name))))))
(lib.common/defop + [x y & more])
(lib.common/defop - [x y & more])
(lib.common/defop * [x y & more])

Kondo gets confused

#_{:clj-kondo/ignore [:unresolved-namespace]}
(lib.common/defop / [x y & more])
(lib.common/defop case [x y & more])
(lib.common/defop coalesce [x y & more])
(lib.common/defop abs [x])
(lib.common/defop log [x])
(lib.common/defop exp [x])
(lib.common/defop sqrt [x])
(lib.common/defop ceil [x])
(lib.common/defop floor [x])
(lib.common/defop round [x])
(lib.common/defop power [n expo])
(lib.common/defop interval [n unit])
(lib.common/defop relative-datetime [t unit])
(lib.common/defop time [t unit])
(lib.common/defop absolute-datetime [t unit])
(lib.common/defop now [])
(lib.common/defop convert-timezone [t source dest])
(lib.common/defop get-week [t mode])
(lib.common/defop get-year [t])
(lib.common/defop get-month [t])
(lib.common/defop get-day [t])
(lib.common/defop get-hour [t])
(lib.common/defop get-minute [t])
(lib.common/defop get-second [t])
(lib.common/defop get-quarter [t])
(lib.common/defop datetime-add [t i unit])
(lib.common/defop datetime-subtract [t i unit])
(lib.common/defop concat [s1 s2 & more])
(lib.common/defop substring [s start end])
(lib.common/defop replace [s search replacement])
(lib.common/defop regexextract [s regex])
(lib.common/defop length [s])
(lib.common/defop trim [s])
(lib.common/defop ltrim [s])
(lib.common/defop rtrim [s])
(lib.common/defop upper [s])
(lib.common/defop lower [s])
(mu/defn ^:private expression-metadata :- lib.metadata/ColumnMetadata
  [query                 :- ::lib.schema/query
   stage-number          :- :int
   expression-definition :- ::lib.schema.expression/expression]
  (let [expression-name (lib.util/expression-name expression-definition)]
    (-> (lib.metadata.calculation/metadata query stage-number expression-definition)
        (assoc :lib/source   :source/expressions
               :name         expression-name
               :display-name expression-name))))
(mu/defn expressions-metadata :- [:maybe [:sequential lib.metadata/ColumnMetadata]]
  "Get metadata about the expressions in a given stage of a `query`."
  ([query]
   (expressions-metadata query -1))
  ([query        :- ::lib.schema/query
    stage-number :- :int]
   (some->> (not-empty (:expressions (lib.util/query-stage query stage-number)))
            (mapv (partial expression-metadata query stage-number)))))
(mu/defn expressions :- [:maybe ::lib.schema.expression/expressions]
  "Get the expressions map from a given stage of a `query`."
  ([query]
   (expressions query -1))
  ([query        :- ::lib.schema/query
    stage-number :- :int]
   (not-empty (:expressions (lib.util/query-stage query stage-number)))))
(defmethod lib.ref/ref-method :expression
  [expression-clause]
  expression-clause)
(mu/defn expressionable-columns :- [:sequential lib.metadata/ColumnMetadata]
  "Get column metadata for all the columns that can be used expressions in
  the stage number `stage-number` of the query `query` and in expression index `expression-position`
  If `stage-number` is omitted, the last stage is used.
  Pass nil to `expression-position` for new expressions.
  The rules for determining which columns can be broken out by are as follows:
  1. custom `:expressions` in this stage of the query, that come before the `expression-position`
  2. Fields 'exported' by the previous stage of the query, if there is one;
     otherwise Fields from the current `:source-table`
  3. Fields exported by explicit joins
  4. Fields in Tables that are implicitly joinable."
  ([query :- ::lib.schema/query
    expression-position :- [:maybe ::lib.schema.common/int-greater-than-or-equal-to-zero]]
   (expressionable-columns query -1 expression-position))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    expression-position :- [:maybe ::lib.schema.common/int-greater-than-or-equal-to-zero]]
   (let [indexed-expressions (into {} (map-indexed (fn [idx expr]
                                                     [(lib.util/expression-name expr) idx])
                                                   (expressions query stage-number)))
         unavailable-expressions (fn [column]
                                   (or (not expression-position)
                                       (not= (:lib/source column) :source/expressions)
                                       (< (get indexed-expressions (:name column)) expression-position)))
         stage (lib.util/query-stage query stage-number)
         columns (lib.metadata.calculation/visible-columns query stage-number stage)]
     (->> columns
          (filterv unavailable-expressions)
          not-empty))))
(mu/defn expression-ref :- :mbql.clause/expression
  "Find the expression with `expression-name` using [[resolve-expression]], then create a ref for it. Intended for use
  when creating queries using threading macros e.g.
    (-> (lib/query ...)
        (lib/expression \"My Expression\" ...)
        (as-> <> (lib/aggregate <> (lib/avg (lib/expression-ref <> \"My Expression\")))))"
  ([query expression-name]
   (expression-ref query -1 expression-name))
  ([query           :- ::lib.schema/query
    stage-number    :- :int
    expression-name :- ::lib.schema.common/non-blank-string]
   (->> expression-name
        (resolve-expression query stage-number)
        (expression-metadata query stage-number)
        lib.ref/ref)))
(def ^:private expression-validator
  (mc/validator ::lib.schema.expression/expression))

Returns true if expression-clause is indeed an expression clause, false otherwise.

(defn expression-clause?
  [expression-clause]
  (expression-validator expression-clause))
(mu/defn with-expression-name :- ::lib.schema.expression/expression
  "Return a new expression clause like `an-expression-clause` but with name `new-name`.
  For expressions from the :expressions clause of a pMBQL query this sets the :lib/expression-name option,
  for other expressions (for example named aggregation expressions) the :display-name option is set.
  Note that always setting :lib/expression-name would lead to confusion, because that option is used
  to decide what kind of reference is to be created. For example, expression are referenced by name,
  aggregations are referenced by position."
  [an-expression-clause :- ::lib.schema.expression/expression
   new-name :- :string]
  (lib.options/update-options
   (if (lib.util/clause? an-expression-clause)
     an-expression-clause
     [:value {:effective-type (lib.schema.expression/type-of an-expression-clause)}
      an-expression-clause])
   (fn [opts]
     (let [opts (assoc opts :lib/uuid (str (random-uuid)))]
       (if (:lib/expression-name opts)
         (-> opts
             (dissoc :display-name :name)
             (assoc :lib/expression-name new-name))
         (assoc opts :name new-name :display-name new-name))))))
 
(ns metabase.lib.fe-util
  (:require
   [metabase.lib.common :as lib.common]
   [metabase.lib.field :as lib.field]
   [metabase.lib.filter :as lib.filter]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.options :as lib.options]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.expression :as lib.schema.expression]
   [metabase.lib.schema.temporal-bucketing :as lib.schema.temporal-bucketing]
   [metabase.lib.temporal-bucket :as lib.temporal-bucket]
   [metabase.lib.util :as lib.util]
   [metabase.mbql.util :as mbql.u]
   [metabase.shared.util.i18n :as i18n]
   [metabase.shared.util.time :as shared.ut]
   [metabase.util :as u]
   [metabase.util.malli :as mu]))
(def ^:private ExpressionParts
  [:map
   [:lib/type [:= :mbql/expression-parts]]
   [:operator [:or :keyword :string]]
   [:options ::lib.schema.common/options]
   [:args [:sequential :any]]])
(mu/defn expression-parts :- ExpressionParts
  "Return the parts of the filter clause `expression-clause` in query `query` at stage `stage-number`."
  ([query expression-clause]
   (expression-parts query -1 expression-clause))
  ([query :- ::lib.schema/query
    stage-number :- :int
    expression-clause :- ::lib.schema.expression/expression]
   (let [[op options & args] expression-clause
         ->maybe-col #(when (lib.util/ref-clause? %)
                        (lib.filter/add-column-operators
                          (lib.field/extend-column-metadata-from-ref
                            query stage-number
                            (lib.metadata.calculation/metadata query stage-number %)
                            %)))]
     {:lib/type :mbql/expression-parts
      :operator op
      :options  options
      :args     (mapv (fn [arg]
                        (if (lib.util/clause? arg)
                          (if-let [col (->maybe-col arg)]
                            col
                            (expression-parts query stage-number arg))
                          arg))
                      args)})))
(defmethod lib.common/->op-arg :mbql/expression-parts
  [{:keys [operator options args] :or {options {}}}]
  (lib.common/->op-arg (lib.options/ensure-uuid (into [(keyword operator) options]
                                                      (map lib.common/->op-arg)
                                                      args))))
(mu/defn expression-clause :- ::lib.schema.expression/expression
  "Returns a standalone clause for an `operator`, `options`, and arguments."
  [operator :- :keyword
   args     :- [:sequential :any]
   options  :- [:maybe :map]]
  (lib.options/ensure-uuid (into [operator options] (map lib.common/->op-arg) args)))
(mu/defn filter-args-display-name :- :string
  "Provides a reasonable display name for the `filter-clause` excluding the column-name.
   Can be expanded as needed but only currently defined for a narrow set of date filters.
   Falls back to the full filter display-name"
  [query stage-number filter-clause]
  (let [->temporal-name #(shared.ut/format-unit % nil)
        temporal? #(lib.util/original-isa? % :type/Temporal)
        unit-is (fn [unit-or-units]
                  (let [units (set (u/one-or-many unit-or-units))]
                    (fn [maybe-clause]
                      (clojure.core/and
                        (temporal? maybe-clause)
                        (lib.util/clause? maybe-clause)
                        (clojure.core/contains? units (:temporal-unit (second maybe-clause)))))))]
    (mbql.u/match-one filter-clause
      [:= _ (x :guard (unit-is lib.schema.temporal-bucketing/datetime-truncation-units)) (y :guard string?)]
      (shared.ut/format-relative-date-range y 0 (:temporal-unit (second x)) nil nil {:include-current true})
      [:= _ (x :guard temporal?) (y :guard (some-fn int? string?))]
      (lib.temporal-bucket/describe-temporal-pair x y)
      [:!= _ (x :guard temporal?) (y :guard (some-fn int? string?))]
      (i18n/tru "Excludes {0}" (lib.temporal-bucket/describe-temporal-pair x y))
      [:< _ (x :guard temporal?) (y :guard string?)]
      (i18n/tru "Before {0}" (->temporal-name y))
      [:> _ (x :guard temporal?) (y :guard string?)]
      (i18n/tru "After {0}" (->temporal-name y))
      [:between _ (x :guard temporal?) (y :guard string?) (z :guard string?)]
      (shared.ut/format-diff y z)
      [:is-null & _]
      (i18n/tru "Is Empty")
      [:not-null & _]
      (i18n/tru "Is Not Empty")
      [:time-interval _ (x :guard temporal?) n unit]
      (lib.temporal-bucket/describe-temporal-interval n unit)
      _
      (lib.metadata.calculation/display-name query stage-number filter-clause))))
 
(ns metabase.lib.field
  (:require
   [clojure.string :as str]
   [medley.core :as m]
   [metabase.lib.aggregation :as lib.aggregation]
   [metabase.lib.binning :as lib.binning]
   [metabase.lib.card :as lib.card]
   [metabase.lib.convert :as lib.convert]
   [metabase.lib.dispatch :as lib.dispatch]
   [metabase.lib.equality :as lib.equality]
   [metabase.lib.expression :as lib.expression]
   [metabase.lib.join :as lib.join]
   [metabase.lib.join.util :as lib.join.util]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.normalize :as lib.normalize]
   [metabase.lib.options :as lib.options]
   [metabase.lib.ref :as lib.ref]
   [metabase.lib.remove-replace :as lib.remove-replace]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.lib.schema.temporal-bucketing
    :as lib.schema.temporal-bucketing]
   [metabase.lib.temporal-bucket :as lib.temporal-bucket]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.lib.util :as lib.util]
   [metabase.shared.util.i18n :as i18n]
   [metabase.shared.util.time :as shared.ut]
   [metabase.util :as u]
   [metabase.util.humanization :as u.humanization]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.registry :as mr]))
(defn- normalize-binning-options [opts]
  (lib.normalize/normalize-map
   opts
   keyword
   {:strategy keyword}))
(defn- normalize-field-options [opts]
  (lib.normalize/normalize-map
   opts
   keyword
   {:temporal-unit keyword
    :binning       normalize-binning-options}))
(defmethod lib.normalize/normalize :field
  [[tag opts id-or-name]]
  [(keyword tag) (normalize-field-options opts) id-or-name])
(mu/defn resolve-column-name-in-metadata :- [:maybe ::lib.schema.metadata/column]
  "Find the column with `column-name` in a sequence of `column-metadatas`."
  [column-name      :- ::lib.schema.common/non-blank-string
   column-metadatas :- [:sequential ::lib.schema.metadata/column]]
  (or (some (fn [k]
              (m/find-first #(= (get % k) column-name)
                            column-metadatas))
            [:lib/desired-column-alias :name])
      (do
        (log/warn (i18n/tru "Invalid :field clause: column {0} does not exist. Found: {1}"
                            (pr-str column-name)
                            (pr-str (mapv :lib/desired-column-alias column-metadatas))))
        nil)))

Whether we're in a recursive call to [[resolve-column-name]] or not. Prevent infinite recursion (#32063)

(def ^:private ^:dynamic *recursive-column-resolution-by-name*
  false)
(mu/defn ^:private resolve-column-name :- [:maybe ::lib.schema.metadata/column]
  "String column name: get metadata from the previous stage, if it exists, otherwise if this is the first stage and we
  have a native query or a Saved Question source query or whatever get it from our results metadata."
  [query        :- ::lib.schema/query
   stage-number :- :int
   column-name  :- ::lib.schema.common/non-blank-string]
  (when-not *recursive-column-resolution-by-name*
    (binding [*recursive-column-resolution-by-name* true]
      (let [previous-stage-number (lib.util/previous-stage-number query stage-number)
            stage                 (if previous-stage-number
                                    (lib.util/query-stage query previous-stage-number)
                                    (lib.util/query-stage query stage-number))
            ;; TODO -- it seems a little icky that the existence of `:metabase.lib.stage/cached-metadata` is leaking
            ;; here, we should look in to fixing this if we can.
            stage-columns         (or (:metabase.lib.stage/cached-metadata stage)
                                      (get-in stage [:lib/stage-metadata :columns])
                                      (when (or (:source-card  stage)
                                                (:source-table stage)
                                                (:expressions  stage)
                                                (:fields       stage))
                                        (lib.metadata.calculation/visible-columns query stage-number stage))
                                      (log/warn (i18n/tru "Cannot resolve column {0}: stage has no metadata"
                                                          (pr-str column-name))))]
        (when-let [column (and (seq stage-columns)
                               (resolve-column-name-in-metadata column-name stage-columns))]
          (cond-> column
            previous-stage-number (-> (dissoc :id :table-id
                                              ::binning ::temporal-unit)
                                      (lib.join/with-join-alias nil)
                                      (assoc :name (or (:lib/desired-column-alias column) (:name column)))
                                      (assoc :lib/source :source/previous-stage))))))))
(mu/defn ^:private resolve-field-metadata :- ::lib.schema.metadata/column
  "Resolve metadata for a `:field` ref. This is part of the implementation
  for [[lib.metadata.calculation/metadata-method]] a `:field` clause."
  [query                                                                 :- ::lib.schema/query
   stage-number                                                          :- :int
   [_field {:keys [join-alias], :as opts} id-or-name, :as _field-clause] :- :mbql.clause/field]
  (let [metadata (merge
                  (when-let [base-type (:base-type opts)]
                    {:base-type base-type})
                  (when-let [effective-type ((some-fn :effective-type :base-type) opts)]
                    {:effective-type effective-type})
                  ;; TODO -- some of the other stuff in `opts` probably ought to be merged in here as well. Also, if
                  ;; the Field is temporally bucketed, the base-type/effective-type would probably be affected, right?
                  ;; We should probably be taking that into consideration?
                  (when-let [binning (:binning opts)]
                    {::binning binning})
                  (when-let [unit (:temporal-unit opts)]
                    {::temporal-unit unit})
                  (cond
                    (integer? id-or-name) (or (lib.equality/resolve-field-id query stage-number id-or-name)
                                              {:lib/type :metadata/column, :name (str id-or-name)})
                    join-alias            {:lib/type :metadata/column, :name (str id-or-name)}
                    :else                 (or (resolve-column-name query stage-number id-or-name)
                                              {:lib/type :metadata/column, :name (str id-or-name)})))]
    (cond-> metadata
      join-alias (lib.join/with-join-alias join-alias))))

If this is a nested column, add metadata about the parent column.

(mu/defn ^:private add-parent-column-metadata
  [query    :- ::lib.schema/query
   metadata :- ::lib.schema.metadata/column]
  (let [parent-metadata     (lib.metadata/field query (:parent-id metadata))
        {parent-name :name} (cond->> parent-metadata
                              (:parent-id parent-metadata) (add-parent-column-metadata query))]
    (update metadata :name (fn [field-name]
                             (str parent-name \. field-name)))))

Effective type of a column when taking the ::temporal-unit into account. If we have a temporal extraction like :month-of-year, then this actually returns an integer rather than the 'originaleffective type of:type/Date` or whatever.

(defn- column-metadata-effective-type
  [{::keys [temporal-unit], :as column-metadata}]
  (if (and temporal-unit
           (contains? lib.schema.temporal-bucketing/datetime-extraction-units temporal-unit))
    :type/Integer
    ((some-fn :effective-type :base-type) column-metadata)))
(defmethod lib.metadata.calculation/type-of-method :metadata/column
  [_query _stage-number column-metadata]
  (column-metadata-effective-type column-metadata))
(defmethod lib.metadata.calculation/type-of-method :field
  [query stage-number [_tag {:keys [temporal-unit], :as _opts} _id-or-name :as field-ref]]
  (let [metadata (cond-> (resolve-field-metadata query stage-number field-ref)
                   temporal-unit (assoc ::temporal-unit temporal-unit))]
    (lib.metadata.calculation/type-of query stage-number metadata)))
(defmethod lib.metadata.calculation/metadata-method :metadata/column
  [_query _stage-number {field-name :name, :as field-metadata}]
  (assoc field-metadata :name field-name))

Extend column metadata metadata with information specific to field-ref in query at stage stage-number. metadata should be the metadata of a resolved field or a visible column matching field-ref.

(defn extend-column-metadata-from-ref
  [query
   stage-number
   metadata
   [_tag {source-uuid :lib/uuid :keys [base-type binning effective-type join-alias source-field temporal-unit], :as opts} :as field-ref]]
  (let [metadata (merge
                  {:lib/type        :metadata/column
                   :lib/source-uuid source-uuid}
                  metadata
                  {:display-name (or (:display-name opts)
                                     (lib.metadata.calculation/display-name query stage-number field-ref))})]
    (cond-> metadata
      effective-type (assoc :effective-type effective-type)
      base-type      (assoc :base-type base-type)
      temporal-unit  (assoc ::temporal-unit temporal-unit)
      binning        (assoc ::binning binning)
      source-field   (assoc :fk-field-id source-field)
      join-alias     (lib.join/with-join-alias join-alias))))

TODO -- effective type should be affected by temporal-unit, right?

(defmethod lib.metadata.calculation/metadata-method :field
  [query stage-number field-ref]
  (let [field-metadata (resolve-field-metadata query stage-number field-ref)
        metadata       (extend-column-metadata-from-ref query stage-number field-metadata field-ref)]
    (cond->> metadata
      (:parent-id metadata) (add-parent-column-metadata query))))

this lives here as opposed to [[metabase.lib.metadata]] because that namespace is more of an interface namespace and moving this there would cause circular references.

(defmethod lib.metadata.calculation/display-name-method :metadata/column
  [query stage-number {field-display-name :display-name
                       field-name         :name
                       temporal-unit      :unit
                       binning            ::binning
                       join-alias         :source-alias
                       fk-field-id        :fk-field-id
                       table-id           :table-id
                       :as                field-metadata} style]
  (let [field-display-name (or field-display-name
                               (if (string? field-name)
                                 (u.humanization/name->human-readable-name :simple field-name)
                                 (str field-name)))
        join-display-name  (when (and (= style :long)
                                      ;; don't prepend a join display name if `:display-name` already contains one!
                                      ;; Legacy result metadata might include it for joined Fields, don't want to add
                                      ;; it twice. Otherwise we'll end up with display names like
                                      ;;
                                      ;;    Products → Products → Category
                                      (not (str/includes? field-display-name " → ")))
                             (or
                              (when fk-field-id
                                 ;; Implicitly joined column pickers don't use the target table's name, they use the FK field's name with
                                 ;; "ID" dropped instead.
                                 ;; This is very intentional: one table might have several FKs to one foreign table, each with different
                                 ;; meaning (eg. ORDERS.customer_id vs. ORDERS.supplier_id both linking to a PEOPLE table).
                                 ;; See #30109 for more details.
                                (if-let [field (lib.metadata/field query fk-field-id)]
                                  (-> (lib.metadata.calculation/display-info query stage-number field)
                                      :display-name
                                      lib.util/strip-id)
                                  (let [table (lib.metadata/table-or-card query table-id)]
                                    (lib.metadata.calculation/display-name query stage-number table style))))
                              (or join-alias (lib.join.util/current-join-alias field-metadata))))
        display-name       (if join-display-name
                             (str join-display-name " → " field-display-name)
                             field-display-name)]
    (cond
      temporal-unit (lib.util/format "%s: %s" display-name (-> (name temporal-unit)
                                                               (str/replace \- \space)
                                                               u/capitalize-en))
      binning       (lib.util/format "%s: %s" display-name (lib.binning/binning-display-name binning field-metadata))
      :else         display-name)))
(defmethod lib.metadata.calculation/display-name-method :field
  [query
   stage-number
   [_tag {:keys [binning join-alias temporal-unit source-field], :as _opts} _id-or-name, :as field-clause]
   style]
  (if-let [field-metadata (cond-> (resolve-field-metadata query stage-number field-clause)
                            join-alias    (assoc :source-alias join-alias)
                            temporal-unit (assoc :unit temporal-unit)
                            binning       (assoc ::binning binning)
                            source-field  (assoc :fk-field-id source-field))]
    (lib.metadata.calculation/display-name query stage-number field-metadata style)
    ;; mostly for the benefit of JS, which does not enforce the Malli schemas.
    (i18n/tru "[Unknown Field]")))
(defmethod lib.metadata.calculation/column-name-method :metadata/column
  [_query _stage-number {field-name :name}]
  field-name)
(defmethod lib.metadata.calculation/column-name-method :field
  [query stage-number [_tag _id-or-name, :as field-clause]]
  (if-let [field-metadata (resolve-field-metadata query stage-number field-clause)]
    (lib.metadata.calculation/column-name query stage-number field-metadata)
    ;; mostly for the benefit of JS, which does not enforce the Malli schemas.
    "unknown_field"))
(defmethod lib.metadata.calculation/display-info-method :metadata/column
  [query stage-number field-metadata]
  (merge
   ((get-method lib.metadata.calculation/display-info-method :default) query stage-number field-metadata)
   ;; if this column comes from a source Card (Saved Question/Model/etc.) use the name of the Card as the 'table' name
   ;; rather than the ACTUAL table name.
   (when (= (:lib/source field-metadata) :source/card)
     (when-let [card-id (:lib/card-id field-metadata)]
       (when-let [card (lib.metadata/card query card-id)]
         {:table {:name (:name card), :display-name (:name card)}})))))

---------------------------------- Temporal Bucketing ----------------------------------------

TODO -- it's a little silly to make this a multimethod I think since there are exactly two implementations of it, right? Or can expression and aggregation references potentially be temporally bucketed as well? Think about whether just making this a plain function like we did for [[metabase.lib.join/with-join-alias]] makes sense or not.

(defmethod lib.temporal-bucket/temporal-bucket-method :field
  [[_tag opts _id-or-name]]
  (:temporal-unit opts))
(defmethod lib.temporal-bucket/temporal-bucket-method :metadata/column
  [metadata]
  (::temporal-unit metadata))
(defmethod lib.temporal-bucket/with-temporal-bucket-method :field
  [[_tag options id-or-name] unit]
  ;; if `unit` is an extraction unit like `:month-of-year`, then the `:effective-type` of the ref changes to
  ;; `:type/Integer` (month of year returns an int). We need to record the ORIGINAL effective type somewhere in case
  ;; we need to refer back to it, e.g. to see what temporal buckets are available if we want to change the unit, or if
  ;; we want to remove it later. We will record this with the key `::original-effective-type`. Note that changing the
  ;; unit multiple times should keep the original first value of `::original-effective-type`.
  (if unit
    (let [extraction-unit?        (contains? lib.schema.temporal-bucketing/datetime-extraction-units unit)
          original-effective-type ((some-fn ::original-effective-type :effective-type :base-type) options)
          new-effective-type      (if extraction-unit?
                                    :type/Integer
                                    original-effective-type)
          options                 (assoc options
                                         :temporal-unit unit
                                         :effective-type new-effective-type
                                         ::original-effective-type original-effective-type)]
      [:field options id-or-name])
    ;; `unit` is `nil`: remove the temporal bucket.
    (let [options (if-let [original-effective-type (::original-effective-type options)]
                    (-> options
                        (assoc :effective-type original-effective-type)
                        (dissoc ::original-effective-type))
                    options)
          options (dissoc options :temporal-unit)]
      [:field options id-or-name])))
(defmethod lib.temporal-bucket/with-temporal-bucket-method :metadata/column
  [metadata unit]
  (if unit
    (assoc metadata
           ::temporal-unit unit
           ::original-effective-type ((some-fn ::original-effective-type :effective-type :base-type) metadata))
    (dissoc metadata ::temporal-unit ::original-effective-type)))
(defmethod lib.temporal-bucket/available-temporal-buckets-method :field
  [query stage-number field-ref]
  (lib.temporal-bucket/available-temporal-buckets query stage-number (resolve-field-metadata query stage-number field-ref)))
(defn- fingerprint-based-default-unit [fingerprint]
  (u/ignore-exceptions
    (when-let [{:keys [earliest latest]} (-> fingerprint :type :type/DateTime)]
      (let [days (shared.ut/day-diff (shared.ut/coerce-to-timestamp earliest)
                                     (shared.ut/coerce-to-timestamp latest))]
        (when-not (NaN? days)
          (condp > days
            1 :minute
            31 :day
            365 :week
            :month))))))
(defn- mark-unit [options option-key unit]
  (cond->> options
    (some #(= (:unit %) unit) options)
    (mapv (fn [option]
            (cond-> option
              (contains? option option-key) (dissoc option option-key)
              (= (:unit option) unit)       (assoc option-key true))))))
(defmethod lib.temporal-bucket/available-temporal-buckets-method :metadata/column
  [_query _stage-number field-metadata]
  (if (not= (:lib/source field-metadata) :source/expressions)
    (let [effective-type ((some-fn :effective-type :base-type) field-metadata)
          fingerprint-default (some-> field-metadata :fingerprint fingerprint-based-default-unit)]
      (cond-> (cond
                (isa? effective-type :type/DateTime) lib.temporal-bucket/datetime-bucket-options
                (isa? effective-type :type/Date)     lib.temporal-bucket/date-bucket-options
                (isa? effective-type :type/Time)     lib.temporal-bucket/time-bucket-options
                :else                                [])
        fingerprint-default              (mark-unit :default fingerprint-default)
        (::temporal-unit field-metadata) (mark-unit :selected (::temporal-unit field-metadata))))
    []))

---------------------------------------- Binning ---------------------------------------------

(defmethod lib.binning/binning-method :field
  [field-clause]
  (some-> field-clause
          lib.options/options
          :binning
          (assoc :lib/type    ::lib.binning/binning
                 :metadata-fn (fn [query stage-number]
                                (resolve-field-metadata query stage-number field-clause)))))
(defmethod lib.binning/binning-method :metadata/column
  [metadata]
  (some-> metadata
          ::binning
          (assoc :lib/type    ::lib.binning/binning
                 :metadata-fn (constantly metadata))))
(defmethod lib.binning/with-binning-method :field
  [field-clause binning]
  (lib.options/update-options field-clause u/assoc-dissoc :binning binning))
(defmethod lib.binning/with-binning-method :metadata/column
  [metadata binning]
  (u/assoc-dissoc metadata ::binning binning))
(defmethod lib.binning/available-binning-strategies-method :field
  [query stage-number field-ref]
  (lib.binning/available-binning-strategies query stage-number (resolve-field-metadata query stage-number field-ref)))
(defmethod lib.binning/available-binning-strategies-method :metadata/column
  [query _stage-number {:keys [effective-type fingerprint semantic-type] :as field-metadata}]
  (if (not= (:lib/source field-metadata) :source/expressions)
    (let [binning?    (some-> query lib.metadata/database :features (contains? :binning))
          fingerprint (get-in fingerprint [:type :type/Number])
          existing    (lib.binning/binning field-metadata)
          strategies  (cond
                        ;; Abort if the database doesn't support binning, or this column does not have a defined range.
                        (not (and binning?
                                  (:min fingerprint)
                                  (:max fingerprint)))               nil
                        (isa? semantic-type :type/Coordinate)        (lib.binning/coordinate-binning-strategies)
                        (and (isa? effective-type :type/Number)
                             (not (isa? semantic-type :Relation/*))) (lib.binning/numeric-binning-strategies))]
      ;; TODO: Include the time and date binning strategies too; see metabase.api.table/assoc-field-dimension-options.
      (for [strat strategies]
        (cond-> strat
          (lib.binning/strategy= strat existing) (assoc :selected true))))
    []))
(defmethod lib.ref/ref-method :field
  [field-clause]
  field-clause)
(defn- column-metadata->field-ref
  [metadata]
  (let [inherited-column? (when-not (::lib.card/force-broken-id-refs metadata)
                            (#{:source/card :source/native :source/previous-stage} (:lib/source metadata)))
        options           (merge {:lib/uuid       (str (random-uuid))
                                  :base-type      (:base-type metadata)
                                  :effective-type (column-metadata-effective-type metadata)}
                                 (when-let [join-alias (lib.join.util/current-join-alias metadata)]
                                   {:join-alias join-alias})
                                 (when-let [temporal-unit (::temporal-unit metadata)]
                                   {:temporal-unit temporal-unit})
                                 (when-let [original-effective-type (::original-effective-type metadata)]
                                   {::original-effective-type original-effective-type})
                                 (when-let [binning (::binning metadata)]
                                   {:binning binning})
                                 (when-let [source-field-id (:fk-field-id metadata)]
                                   {:source-field source-field-id}))
        id-or-name        ((if inherited-column?
                             (some-fn :lib/desired-column-alias :name)
                             (some-fn :id :name))
                           metadata)]
    [:field options id-or-name]))
(defmethod lib.ref/ref-method :metadata/column
  [{source :lib/source, :as metadata}]
  (case source
    :source/aggregations (lib.aggregation/column-metadata->aggregation-ref metadata)
    :source/expressions  (lib.expression/column-metadata->expression-ref metadata)
    ;; `:source/fields`/`:source/breakouts` can hide the true origin of the column. Since it's impossible to break out
    ;; by aggregation references at the current stage, we only have to check if we break out by an expression
    ;; reference. `:lib/expression-name` is only set for expression references, so if it's set, we have to generate an
    ;; expression ref, otherwise we generate a normal field ref.
    (:source/fields :source/breakouts)
    (if (:lib/expression-name metadata)
      (lib.expression/column-metadata->expression-ref metadata)
      (column-metadata->field-ref metadata))

    #_else
    (column-metadata->field-ref metadata)))

Return the [[::lib.schema.metadata/column]] for all the expressions in a stage of a query.

(defn- expression-columns
  [query stage-number]
  (filter #(= (:lib/source %) :source/expressions)
          (lib.metadata.calculation/visible-columns
           query
           stage-number
           (lib.util/query-stage query stage-number)
           {:include-joined?              false
            :include-expressions?         true
            :include-implicitly-joinable? false})))
(mu/defn with-fields :- ::lib.schema/query
  "Specify the `:fields` for a query. Pass `nil` or an empty sequence to remove `:fields`."
  ([xs]
   (fn [query stage-number]
     (with-fields query stage-number xs)))
  ([query xs]
   (with-fields query -1 xs))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    xs]
   (let [xs        (not-empty (mapv lib.ref/ref xs))
         ;; If any fields are specified, include all expressions not yet included.
         expr-cols (expression-columns query stage-number)
         ;; Set of expr-cols which are *already* included.
         included  (into #{}
                         (keep #(lib.equality/find-matching-column query stage-number % expr-cols))
                         (or xs []))
         ;; Those expr-refs which must still be included.
         to-add    (remove included expr-cols)
         xs        (when xs (into xs (map lib.ref/ref) to-add))]
     (lib.util/update-query-stage query stage-number u/assoc-dissoc :fields xs))))
(mu/defn fields :- [:maybe [:ref ::lib.schema/fields]]
  "Fetches the `:fields` for a query. Returns `nil` if there are no `:fields`. `:fields` should never be empty; this is
  enforced by the Malli schema."
  ([query]
   (fields query -1))
  ([query        :- ::lib.schema/query
    stage-number :- :int]
   (:fields (lib.util/query-stage query stage-number))))
(mu/defn fieldable-columns :- [:sequential ::lib.schema.metadata/column]
  "Return a sequence of column metadatas for columns that you can specify in the `:fields` of a query. This is
  basically just the columns returned by the source Table/Saved Question/Model or previous query stage.
  Includes a `:selected?` key letting you know this column is already in `:fields` or not; if `:fields` is
  unspecified, all these columns are returned by default, so `:selected?` is true for all columns (this is a little
  strange but it matches the behavior of the QB UI)."
  ([query]
   (fieldable-columns query -1))
  ([query :- ::lib.schema/query
    stage-number :- :int]
   (let [visible-columns (lib.metadata.calculation/visible-columns query
                                                                   stage-number
                                                                   (lib.util/query-stage query stage-number)
                                                                   {:include-joined?              false
                                                                    :include-expressions?         false
                                                                    :include-implicitly-joinable? false})
         selected-fields (fields query stage-number)]
     (if (empty? selected-fields)
       (mapv (fn [col]
               (assoc col :selected? true))
             visible-columns)
       (lib.equality/mark-selected-columns query stage-number visible-columns selected-fields)))))
(mu/defn field-id :- [:maybe ::lib.schema.common/int-greater-than-or-equal-to-zero]
  "Find the field id for something or nil."
  [field-metadata :- ::lib.schema.metadata/column]
  (:id field-metadata))
(mu/defn legacy-card-or-table-id :- [:maybe [:or :string ::lib.schema.common/int-greater-than-or-equal-to-zero]]
  "Find the legacy card id or table id for a given ColumnMetadata or nil.
   Returns a either `\"card__<id>\"` or integer table id."
  [{card-id :lib/card-id table-id :table-id} :- ::lib.schema.metadata/column]
  (cond
    card-id (str "card__" card-id)
    table-id table-id))

Given a query and stage, sets the :fields list to be the fields which would be selected by default. This is exactly [[lib.metadata.calculation/returned-columns]] filtered by the :lib/source. Fields from explicit joins are listed on the join itself and should not be listed in :fields.

(defn- populate-fields-for-stage
  [query stage-number]
  (let [defaults (lib.metadata.calculation/default-columns-for-stage query stage-number)]
    (lib.util/update-query-stage query stage-number assoc :fields (mapv lib.ref/ref defaults))))

If the given stage already has a :fields clause, do nothing. If it doesn't, populate the :fields clause with the full set of returned-columns. (See [[populate-fields-for-stage]] for the details.)

(defn- query-with-fields
  [query stage-number]
  (cond-> query
    (not (:fields (lib.util/query-stage query stage-number))) (populate-fields-for-stage stage-number)))
(defn- include-field [query stage-number column]
  (let [populated  (query-with-fields query stage-number)
        field-refs (fields populated stage-number)
        match-ref  (lib.equality/find-matching-ref column field-refs)
        column-ref (lib.ref/ref column)]
    (if (and match-ref
             (or (string? (last column-ref))
                 (integer? (last match-ref))))
      ;; If the column is already found, do nothing and return the original query.
      query
      (lib.util/update-query-stage populated stage-number update :fields conj column-ref))))
(defn- add-field-to-join [query stage-number column]
  (let [column-ref   (lib.ref/ref column)
        [join field] (first (for [join  (lib.join/joins query stage-number)
                                  :let [joinables (lib.join/joinable-columns query stage-number join)
                                        field     (lib.equality/find-matching-column
                                                   query stage-number column-ref joinables)]
                                  :when field]
                              [join field]))
        join-fields  (lib.join/join-fields join)]
    ;; Nothing to do if it's already selected, or if this join already has :fields :all.
    ;; Otherwise, append it to the list of fields.
    (if (or (= join-fields :all)
            (and field
                 (not= join-fields :none)
                 (lib.equality/find-matching-ref field join-fields)))
      query
      (lib.remove-replace/replace-join query stage-number join
                                       (lib.join/with-join-fields join
                                         (if (= join-fields :none)
                                           [column]
                                           (conj join-fields column)))))))
(defn- native-query-fields-edit-error []
  (i18n/tru "Fields cannot be adjusted on native queries. Either edit the native query, or save this question and edit the fields in a GUI question based on this one."))
(mu/defn add-field :- ::lib.schema/query
  "Adds a given field (`ColumnMetadata`, as returned from eg. [[visible-columns]]) to the fields returned by the query.
  Exactly what this means depends on the source of the field:
  - Source table/card, previous stage of the query, custom expression, aggregation or breakout:
      - Add it to the `:fields` list
      - If `:fields` is missing, it's implicitly `:all`, so do nothing.
  - Implicit join: add it to the `:fields` list; query processor will do the right thing with it.
  - Explicit join: add it to that join's `:fields` list."
  [query        :- ::lib.schema/query
   stage-number :- :int
   column       :- lib.metadata.calculation/ColumnMetadataWithSource]
  (let [stage  (lib.util/query-stage query stage-number)
        source (:lib/source column)]
    (-> (case source
          (:source/table-defaults
            :source/fields
            :source/card
            :source/previous-stage
            :source/expressions
            :source/aggregations
            :source/breakouts)         (cond-> query
                                         (contains? stage :fields) (include-field stage-number column))
          :source/joins               (add-field-to-join query stage-number column)
          :source/implicitly-joinable (include-field query stage-number column)
          :source/native              (throw (ex-info (native-query-fields-edit-error) {:query query :stage stage-number}))
          ;; Default case - do nothing if we don't know about the incoming value.
          ;; Generates a warning, as we should aim to capture all the :source/* values here.
          (do
            (log/warn (i18n/tru "Cannot add-field with unknown source {0}" (pr-str source)))
            query))
        ;; Then drop any redundant :fields clauses.
        lib.remove-replace/normalize-fields-clauses)))
(defn- remove-matching-ref [column refs]
  (let [match (lib.equality/find-matching-ref column refs)]
     (remove #(= % match) refs)))

This is called only for fields that plausibly need removing. If the stage has no :fields, this will populate it. It shouldn't happen that we can't find the target field, but if that does happen, this will return the original query unchanged. (In particular, if :fields did not exist before it will still be omitted.)

(defn- exclude-field
  [query stage-number column]
  (let [old-fields (-> (query-with-fields query stage-number)
                       (lib.util/query-stage stage-number)
                       :fields)
        new-fields (remove-matching-ref column old-fields)]
    (cond-> query
      ;; If we couldn't find the field, return the original query unchanged.
      (< (count new-fields) (count old-fields)) (lib.util/update-query-stage stage-number assoc :fields new-fields))))
(defn- remove-field-from-join [query stage-number column]
  (let [join        (lib.join/resolve-join query stage-number (::lib.join/join-alias column))
        join-fields (lib.join/join-fields join)]
    (if (or (nil? join-fields)
            (= join-fields :none))
      ;; Nothing to do if there's already no join fields.
      query
      (let [resolved-join-fields (if (= join-fields :all)
                                   (map lib.ref/ref (lib.metadata.calculation/returned-columns query stage-number join))
                                   join-fields)
            removed              (remove-matching-ref column resolved-join-fields)]
        (cond-> query
          ;; If we actually removed a field, replace the join. Otherwise return the query unchanged.
          (< (count removed) (count resolved-join-fields))
          (lib.remove-replace/replace-join stage-number join (lib.join/with-join-fields join removed)))))))
(mu/defn remove-field :- ::lib.schema/query
  "Removes the field (a `ColumnMetadata`, as returned from eg. [[visible-columns]]) from those fields returned by the
  query. Exactly what this means depends on the source of the field:
  - Source table/card, previous stage, custom expression, aggregations or breakouts:
      - If `:fields` is missing, it's implicitly `:all` - populate it with all the columns except the removed one.
      - Remove the target column from the `:fields` list
  - Implicit join: remove it from the `:fields` list; do nothing if it's not there.
      - (An implicit join only exists in the `:fields` clause, so if it's not there then it's not anywhere.)
  - Explicit join: remove it from that join's `:fields` list (handle `:fields :all` like for source tables)."
  [query      :- ::lib.schema/query
   stage-number :- :int
   column       :- lib.metadata.calculation/ColumnMetadataWithSource]
  (let [source (:lib/source column)]
    (-> (case source
          (:source/table-defaults
            :source/fields
            :source/breakouts
            :source/aggregations
            :source/expressions
            :source/card
            :source/previous-stage
            :source/implicitly-joinable) (exclude-field query stage-number column)
          :source/joins                 (remove-field-from-join query stage-number column)
          :source/native                (throw (ex-info (native-query-fields-edit-error)
                                                        {:query query :stage stage-number}))
          ;; Default case: do nothing and return the query unchaged.
          ;; Generate a warning - we should aim to capture every `:source/*` value above.
          (do
            (log/warn (i18n/tru "Cannot remove-field with unknown source {0}" (pr-str source)))
            query))
        ;; Then drop any redundant :fields clauses.
        lib.remove-replace/normalize-fields-clauses)))

TODO: Refactor this away? The special handling for aggregations is strange.

(mu/defn find-visible-column-for-ref :- [:maybe ::lib.schema.metadata/column]
  "Return the visible column in `query` at `stage-number` referenced by `field-ref`. If `stage-number` is omitted, the
  last stage is used. This is currently only meant for use with `:field` clauses."
  ([query field-ref]
   (find-visible-column-for-ref query -1 field-ref))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    field-ref    :- some?]
   (let [stage   (lib.util/query-stage query stage-number)
         ;; not 100% sure why, but [[lib.metadata.calculation/visible-columns]] doesn't seem to return aggregations,
         ;; so we have to use [[lib.metadata.calculation/returned-columns]] instead.
         columns ((if (= (lib.dispatch/dispatch-value field-ref) :aggregation)
                    lib.metadata.calculation/returned-columns
                    lib.metadata.calculation/visible-columns)
                  query stage-number stage)]
     (lib.equality/find-matching-column query stage-number field-ref columns))))

TODO: Refactor this away - handle legacy refs in lib.js and using lib.equality directly from there.

(mu/defn find-visible-column-for-legacy-ref :- [:maybe ::lib.schema.metadata/column]
  "Like [[find-visible-column-for-ref]], but takes a legacy MBQL reference instead of a pMBQL one. This is currently
  only meant for use with `:field` clauses."
  ([query legacy-ref]
   (find-visible-column-for-legacy-ref query -1 legacy-ref))
  ([query       :- ::lib.schema/query
    stage-index :- :int
    legacy-ref  :- some?]
   (let [a-ref (lib.convert/legacy-ref->pMBQL query stage-index legacy-ref)]
     (find-visible-column-for-ref query stage-index a-ref))))

Return true if field is a JSON field, false if not.

(defn json-field?
  [field]
  (some? (:nfc-path field)))

yes, this is intentionally different from the version in :metabase.lib.schema.metadata/column.has-field-values. The FE isn't supposed to need to worry about the distinction between :auto-list and :list for filter purposes. See [[infer-has-field-values]] for more info.

(mr/def ::field-values-search-info.has-field-values
  [:enum :list :search :none])
(mr/def ::field-values-search-info
  [:map
   [:field-id         [:maybe [:ref ::lib.schema.id/field]]]
   [:search-field-id  [:maybe [:ref ::lib.schema.id/field]]]
   [:has-field-values [:ref ::field-values-search-info.has-field-values]]])
(mu/defn infer-has-field-values :- ::field-values-search-info.has-field-values
  "Determine the value of `:has-field-values` we should return for column metadata for frontend consumption to power
  filter search widgets, either when returned by the the REST API or in MLv2 with [[field-values-search-info]].
  Note that this value is not necessarily the same as the value of `has_field_values` in the application database.
  `has_field_values` may be unset, in which case we will try to infer it. `:auto-list` is not currently understood by
  the FE filter stuff, so we will instead return `:list`; the distinction is not important to it anyway."
  [{:keys [has-field-values], :as field} :- [:map
                                             ;; this doesn't use `::lib.schema.metadata/column` because it's stricter
                                             ;; than we need and the REST API calls this function with optimized Field
                                             ;; maps that don't include some keys like `:name`
                                             [:base-type        {:optional true} [:maybe ::lib.schema.common/base-type]]
                                             [:effective-type   {:optional true} [:maybe ::lib.schema.common/base-type]]
                                             [:has-field-values {:optional true} [:maybe ::lib.schema.metadata/column.has-field-values]]]]
  (cond
    ;; if `has_field_values` is set in the DB, use that value; but if it's `auto-list`, return the value as `list` to
    ;; avoid confusing FE code, which can remain blissfully unaware that `auto-list` is a thing
    (= has-field-values :auto-list)   :list
    has-field-values                  has-field-values
    ;; otherwise if it does not have value set in DB we will infer it
    (lib.types.isa/searchable? field) :search
    :else                             :none))
(mu/defn ^:private remapped-field :- [:maybe ::lib.schema.metadata/column]
  [metadata-providerable :- ::lib.schema.metadata/metadata-providerable
   column                :- ::lib.schema.metadata/column]
  (when-let [remap-field-id (get-in column [:lib/external-remap :field-id])]
    (lib.metadata/field metadata-providerable remap-field-id)))
(mu/defn ^:private search-field :- [:maybe ::lib.schema.metadata/column]
  [metadata-providerable :- ::lib.schema.metadata/metadata-providerable
   column                :- ::lib.schema.metadata/column]
  ;; ignore remappings for PK columns.
  (let [col (or (when (lib.types.isa/primary-key? column)
                  column)
                (remapped-field metadata-providerable column)
                column)]
    (when (lib.types.isa/searchable? col)
      col)))
(mu/defn field-values-search-info :- ::field-values-search-info
  "Info about whether the column in question has FieldValues associated with it for purposes of powering a search
  widget in the QB filter modals."
  [metadata-providerable :- ::lib.schema.metadata/metadata-providerable
   column                :- ::lib.schema.metadata/column]
  (when column
    (let [column-field-id (:id column)
          search-field-id (:id (search-field metadata-providerable column))]
      {:field-id (when (int? column-field-id) column-field-id)
       :search-field-id (when (int? search-field-id) search-field-id)
       :has-field-values (if column
                           (infer-has-field-values column)
                           :none)})))
 
(ns metabase.lib.filter
  (:refer-clojure
   :exclude
   [filter and or not = < <= > >= not-empty case])
  (:require
   [inflections.core :as inflections]
   [medley.core :as m]
   [metabase.lib.common :as lib.common]
   [metabase.lib.convert :as lib.convert]
   [metabase.lib.dispatch :as lib.dispatch]
   [metabase.lib.equality :as lib.equality]
   [metabase.lib.filter.operator :as lib.filter.operator]
   [metabase.lib.hierarchy :as lib.hierarchy]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.options :as lib.options]
   [metabase.lib.ref :as lib.ref]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.expression :as lib.schema.expression]
   [metabase.lib.schema.filter :as lib.schema.filter]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.lib.schema.temporal-bucketing :as lib.schema.temporal-bucketing]
   [metabase.lib.temporal-bucket :as lib.temporal-bucket]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.lib.util :as lib.util]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.util :as mbql.u]
   [metabase.shared.util.i18n :as i18n]
   [metabase.shared.util.time :as shared.ut]
   [metabase.util :as u]
   [metabase.util.malli :as mu]))
(doseq [tag [:and :or]]
  (lib.hierarchy/derive tag ::compound))
(doseq [tag [:= :!=]]
  (lib.hierarchy/derive tag ::varargs))
(doseq [tag [:< :<= :> :>= :starts-with :ends-with :contains :does-not-contain]]
  (lib.hierarchy/derive tag ::binary))
(doseq [tag [:is-null :not-null :is-empty :not-empty :not]]
  (lib.hierarchy/derive tag ::unary))
(defmethod lib.metadata.calculation/describe-top-level-key-method :filters
  [query stage-number _key]
  (when-let [filters (clojure.core/not-empty (:filters (lib.util/query-stage query stage-number)))]
    (i18n/tru "Filtered by {0}"
              (lib.util/join-strings-with-conjunction
                (i18n/tru "and")
                (for [filter filters]
                  (lib.metadata.calculation/display-name query stage-number filter :long))))))

Display names for filter clauses are only really used in generating descriptions for :case aggregations or for generating the suggested name for a query.

(defmethod lib.metadata.calculation/display-name-method ::compound
  [query stage-number [tag _opts & subclauses] style]
  (lib.util/join-strings-with-conjunction
   (clojure.core/case tag
     :and (i18n/tru "and")
     :or  (i18n/tru "or"))
   (for [clause subclauses]
     (lib.metadata.calculation/display-name query stage-number clause style))))
(defmethod lib.metadata.calculation/display-name-method ::varargs
  [query stage-number expr style]
  (let [->display-name #(lib.metadata.calculation/display-name query stage-number % style)
        ->temporal-name lib.temporal-bucket/describe-temporal-pair
        numeric? #(clojure.core/and (lib.util/original-isa? % :type/Number)
                    (lib.util/clause? %)
                    (-> (lib.metadata.calculation/metadata query stage-number %)
                        lib.types.isa/id?
                        clojure.core/not))
        temporal? #(lib.util/original-isa? % :type/Temporal)
        unit-is (fn [unit-or-units]
                  (let [units (set (u/one-or-many unit-or-units))]
                    (fn [a]
                      (clojure.core/and
                        (temporal? a)
                        (lib.util/clause? a)
                        (clojure.core/contains? units (:temporal-unit (second a)))))))
        ->unbucketed-display-name #(-> %
                                       (update 1 dissoc :temporal-unit)
                                       ->display-name)
        ->bucket-name #(-> %
                           second
                           :temporal-unit
                           lib.temporal-bucket/describe-temporal-unit
                           u/lower-case-en)]
    (mbql.u/match-one expr
      [:= _ (a :guard numeric?) b]
      (i18n/tru "{0} is equal to {1}" (->display-name a) (->display-name b))

      [:= _ (a :guard (unit-is lib.schema.temporal-bucketing/datetime-truncation-units)) (b :guard string?)]
      (i18n/tru "{0} is {1}" (->unbucketed-display-name a) (shared.ut/format-relative-date-range b 0 (:temporal-unit (second a)) nil nil {:include-current true}))

      [:= _ (a :guard temporal?) (b :guard (some-fn int? string?))]
      (i18n/tru "{0} is on {1}" (->display-name a) (->temporal-name a b))

      [:!= _ (a :guard numeric?) b]
      (i18n/tru "{0} is not equal to {1}" (->display-name a) (->display-name b))

      [:!= _ (a :guard (unit-is :day-of-week)) (b :guard (some-fn int? string?))]
      (i18n/tru "{0} excludes {1}" (->unbucketed-display-name a) (inflections/plural (->temporal-name a b)))

      [:!= _ (a :guard (unit-is :month-of-year)) (b :guard (some-fn int? string?))]
      (i18n/tru "{0} excludes each {1}" (->unbucketed-display-name a) (->temporal-name a b))

      [:!= _ (a :guard (unit-is :quarter-of-year)) (b :guard (some-fn int? string?))]
      (i18n/tru "{0} excludes {1} each year" (->unbucketed-display-name a) (->temporal-name a b))

      [:!= _ (a :guard (unit-is :hour-of-day)) (b :guard (some-fn int? string?))]
      (i18n/tru "{0} excludes the hour of {1}" (->unbucketed-display-name a) (->temporal-name a b))

      [:!= _ (a :guard temporal?) (b :guard (some-fn int? string?))]
      (i18n/tru "{0} excludes {1}" (->display-name a) (->temporal-name a b))

      [:= _ a (b :guard string?)]
      (i18n/tru "{0} is {1}" (->display-name a) b)

      [:= _ a b]
      (i18n/tru "{0} is {1}" (->display-name a) (->display-name b))

      [:!= _ a (b :guard string?)]
      (i18n/tru "{0} is not {1}" (->display-name a) b)

      [:!= _ a b]
      (i18n/tru "{0} is not {1}" (->display-name a) (->display-name b))

      [:= _ (a :guard numeric?) & args]
      (i18n/tru "{0} is equal to {1} selections" (->display-name a) (count args))

      [:!= _ (a :guard numeric?) & args]
      (i18n/tru "{0} is not equal to {1} selections" (->display-name a) (count args))

      [:!= _ (a :guard temporal?) & args]
      (i18n/tru "{0} excludes {1} {2} selections" (->unbucketed-display-name a) (count args) (->bucket-name a))

      [:= _ a & args]
      (i18n/tru "{0} is {1} selections" (->display-name a) (count args))

      [:!= _ a & args]
      (i18n/tru "{0} is not {1} selections" (->display-name a) (count args)))))
(defmethod lib.metadata.calculation/display-name-method ::binary
  [query stage-number expr style]
  (let [->display-name #(lib.metadata.calculation/display-name query stage-number % style)
        ->temporal-name #(shared.ut/format-unit % nil)
        temporal? #(lib.util/original-isa? % :type/Temporal)]
    (mbql.u/match-one expr
      [:< _ (x :guard temporal?) (y :guard string?)]
      (i18n/tru "{0} is before {1}"                   (->display-name x) (->temporal-name y))

      [:< _ x y]
      (i18n/tru "{0} is less than {1}"                (->display-name x) (->display-name y))

      [:<= _ x y]
      (i18n/tru "{0} is less than or equal to {1}"    (->display-name x) (->display-name y))

      [:> _ (x :guard temporal?) (y :guard string?)]
      (i18n/tru "{0} is after {1}"                    (->display-name x) (->temporal-name y))

      [:> _ x y]
      (i18n/tru "{0} is greater than {1}"             (->display-name x) (->display-name y))

      [:>= _ x y]
      (i18n/tru "{0} is greater than or equal to {1}" (->display-name x) (->display-name y))

      [:starts-with _ x (y :guard string?)]
      (i18n/tru "{0} starts with {1}"                 (->display-name x) y)

      [:starts-with _ x y]
      (i18n/tru "{0} starts with {1}"                 (->display-name x) (->display-name y))

      [:ends-with _ x (y :guard string?)]
      (i18n/tru "{0} ends with {1}"                   (->display-name x) y)

      [:ends-with _ x y]
      (i18n/tru "{0} ends with {1}"                   (->display-name x) (->display-name y))

      [:contains _ x (y :guard string?)]
      (i18n/tru "{0} contains {1}"                    (->display-name x) y)

      [:contains _ x y]
      (i18n/tru "{0} contains {1}"                    (->display-name x) (->display-name y))

      [:does-not-contain _ x (y :guard string?)]
      (i18n/tru "{0} does not contain {1}"            (->display-name x) y)

      [:does-not-contain _ x y]
      (i18n/tru "{0} does not contain {1}"            (->display-name x) (->display-name y)))))
(defmethod lib.metadata.calculation/display-name-method :between
  [query stage-number expr style]
  (let [->display-name #(lib.metadata.calculation/display-name query stage-number % style)
        ->unbucketed-display-name #(-> %
                                       (update 1 dissoc :temporal-unit)
                                       ->display-name)
        temporal? #(lib.util/original-isa? % :type/Temporal)]
    (mbql.u/match-one expr
      [:between _ (x :guard temporal?) (y :guard string?) (z :guard string?)]
      (i18n/tru "{0} is {1}"
                (->unbucketed-display-name x)
                (shared.ut/format-diff y z))

      [:between _
       [:+ _ (x :guard temporal?) [:interval _ n unit]]
       [:relative-datetime _ n2 unit2]
       [:relative-datetime _ 0 _]]
      (i18n/tru "{0} is in the {1}, starting {2} ago"
                (->display-name x)
                (u/lower-case-en (lib.temporal-bucket/describe-temporal-interval n2 unit2))
                (inflections/pluralize n (name unit)))

      [:between _
       [:+ _ (x :guard temporal?) [:interval _ n unit]]
       [:relative-datetime _ 0 _]
       [:relative-datetime _ n2 unit2]]
      (i18n/tru "{0} is in the {1}, starting {2} from now"
                (->display-name x)
                (u/lower-case-en (lib.temporal-bucket/describe-temporal-interval n2 unit2))
                (inflections/pluralize (abs n) (name unit)))

      [:between _ x y z]
      (i18n/tru "{0} is between {1} and {2}"
                (->display-name x)
                (->display-name y)
                (->display-name z)))))
(defmethod lib.metadata.calculation/display-name-method :inside
  [query stage-number [_tag opts lat-expr lon-expr lat-max lon-min lat-min lon-max] style]
  (lib.metadata.calculation/display-name query stage-number
                                         [:and opts
                                          [:between opts lat-expr lat-min lat-max]
                                          [:between opts lon-expr lon-min lon-max]]
                                         style))
(defmethod lib.metadata.calculation/display-name-method ::unary
  [query stage-number [tag _opts expr] style]
  (let [expr (lib.metadata.calculation/display-name query stage-number expr style)]
    ;; for whatever reason the descriptions of for `:is-null` and `:not-null` is "is empty" and "is not empty".
    (clojure.core/case tag
      :is-null   (i18n/tru "{0} is empty"     expr)
      :not-null  (i18n/tru "{0} is not empty" expr)
      :is-empty  (i18n/tru "{0} is empty"     expr)
      :not-empty (i18n/tru "{0} is not empty" expr)
      ;; TODO -- This description is sorta wack, we should use [[metabase.mbql.util/negate-filter-clause]] to negate
      ;; `expr` and then generate a description. That would require porting that stuff to pMBQL tho.
      :not       (i18n/tru "not {0}" expr))))
(defmethod lib.metadata.calculation/display-name-method :time-interval
  [query stage-number [_tag _opts expr n unit] style]
  (if (clojure.core/or
        (clojure.core/= n :current)
        (clojure.core/and
          (clojure.core/= (abs n) 1)
          (clojure.core/= unit :day)))
    (i18n/tru "{0} is {1}"
              (lib.metadata.calculation/display-name query stage-number expr style)
              (u/lower-case-en (lib.temporal-bucket/describe-temporal-interval n unit)))
    (i18n/tru "{0} is in the {1}"
              (lib.metadata.calculation/display-name query stage-number expr style)
              (u/lower-case-en (lib.temporal-bucket/describe-temporal-interval n unit)))))
(defmethod lib.metadata.calculation/display-name-method :relative-datetime
  [_query _stage-number [_tag _opts n unit] _style]
  (i18n/tru "{0}" (lib.temporal-bucket/describe-temporal-interval n unit)))
(defmethod lib.metadata.calculation/display-name-method :interval
  [_query _stage-number [_tag _opts n unit] _style]
  (i18n/tru "{0}" (lib.temporal-bucket/describe-temporal-interval n unit)))
(lib.common/defop and [x y & more])
(lib.common/defop or [x y & more])
(lib.common/defop not [x])
(lib.common/defop = [x y & more])
(lib.common/defop != [x y & more])
(lib.common/defop < [x y])
(lib.common/defop <= [x y])
(lib.common/defop > [x y])
(lib.common/defop >= [x y])
(lib.common/defop between [x lower upper])
(lib.common/defop inside [lat lon lat-max lon-min lat-min lon-max])
(lib.common/defop is-null [x])
(lib.common/defop not-null [x])
(lib.common/defop is-empty [x])
(lib.common/defop not-empty [x])
(lib.common/defop starts-with [whole part])
(lib.common/defop ends-with [whole part])
(lib.common/defop contains [whole part])
(lib.common/defop does-not-contain [whole part])
(lib.common/defop time-interval [x amount unit])
(lib.common/defop segment [segment-id])
(mu/defn filter :- :metabase.lib.schema/query
  "Sets `boolean-expression` as a filter on `query`."
  ([query :- :metabase.lib.schema/query
    boolean-expression]
   (metabase.lib.filter/filter query nil boolean-expression))
  ([query :- :metabase.lib.schema/query
    stage-number :- [:maybe :int]
    boolean-expression]
   ;; if this is a Segment metadata, convert it to `:segment` MBQL clause before adding
   (if (clojure.core/= (lib.dispatch/dispatch-value boolean-expression) :metadata/segment)
     (recur query stage-number (lib.ref/ref boolean-expression))
     (let [stage-number (clojure.core/or stage-number -1)
           new-filter (lib.common/->op-arg boolean-expression)]
       (lib.util/update-query-stage query stage-number update :filters (fnil conj []) new-filter)))))
(mu/defn filters :- [:maybe [:ref ::lib.schema/filters]]
  "Returns the current filters in stage with `stage-number` of `query`.
  If `stage-number` is omitted, the last stage is used. Logicaly, the
  filter attached to the query is the conjunction of the expressions
  in the returned list. If the returned list is empty, then there is no
  filter attached to the query.
  See also [[metabase.lib.util/query-stage]]."
  ([query :- :metabase.lib.schema/query] (filters query nil))
  ([query :- :metabase.lib.schema/query
    stage-number :- [:maybe :int]]
   (clojure.core/not-empty (:filters (lib.util/query-stage query (clojure.core/or stage-number -1))))))

Malli schema for ColumnMetadata extended with the list of applicable operators.

(def ColumnWithOperators
  [:merge
   [:ref ::lib.schema.metadata/column]
   [:map
    [:operators {:optional true} [:sequential [:ref ::lib.schema.filter/operator]]]]])
(mu/defn filterable-column-operators :- [:maybe [:sequential ::lib.schema.filter/operator]]
  "Returns the operators for which `filterable-column` is applicable."
  [filterable-column :- ColumnWithOperators]
  (:operators filterable-column))
(mu/defn add-column-operators :- ColumnWithOperators
  "Extend the column metadata with the available operators if any."
  [column :- ::lib.schema.metadata/column]
  (let [operators (lib.filter.operator/filter-operators column)]
    (m/assoc-some column :operators (clojure.core/not-empty operators))))

Returns the first argument of a-filter if it is a reference clause, nil otherwise.

(defn- leading-ref
  [a-filter]
  (when-let [leading-arg (clojure.core/and (lib.util/clause? a-filter)
                                           (get a-filter 2))]
    (when (lib.util/ref-clause? leading-arg)
      leading-arg)))
(mu/defn filterable-columns :- [:sequential ColumnWithOperators]
  "Get column metadata for all the columns that can be filtered in
  the stage number `stage-number` of the query `query`
  If `stage-number` is omitted, the last stage is used.
  The rules for determining which columns can be broken out by are as follows:
  1. custom `:expressions` in this stage of the query
  2. Fields 'exported' by the previous stage of the query, if there is one;
     otherwise Fields from the current `:source-table`
  3. Fields exported by explicit joins
  4. Fields in Tables that are implicitly joinable."
  ([query :- ::lib.schema/query]
   (filterable-columns query -1))
  ([query        :- ::lib.schema/query
    stage-number :- :int]
   (let [stage (lib.util/query-stage query stage-number)
         columns (sequence
                  (comp (map add-column-operators)
                        (clojure.core/filter :operators))
                  (lib.metadata.calculation/visible-columns query stage-number stage))
         existing-filters (filters query stage-number)]
     (cond
       (empty? columns)
       nil
       (empty? existing-filters)
       (vec columns)
       :else
       (let [matching (group-by
                       (fn [filter-pos]
                         (when-let [a-ref (leading-ref (get existing-filters filter-pos))]
                           (lib.equality/find-matching-column query stage-number a-ref columns)))
                       (range (count existing-filters)))]
         (mapv #(let [positions (matching %)]
                  (cond-> %
                    positions (assoc :filter-positions positions)))
               columns))))))
(mu/defn filter-clause :- ::lib.schema.expression/boolean
  "Returns a standalone filter clause for a `filter-operator`,
  a `column`, and arguments."
  [filter-operator :- [:or ::lib.schema.filter/operator :keyword :string]
   column          :- ::lib.schema.metadata/column
   & args]
  (let [tag (if (map? filter-operator)
              (:short filter-operator)
              (keyword filter-operator))]
    (lib.options/ensure-uuid (into [tag {} (lib.common/->op-arg column)]
                                   (map lib.common/->op-arg args)))))
(mu/defn filter-operator :- ::lib.schema.filter/operator
  "Return the filter operator of the boolean expression `filter-clause`
  at `stage-number` in `query`.
  If `stage-number` is omitted, the last stage is used."
  ([query a-filter-clause]
   (filter-operator query -1 a-filter-clause))
  ([query :- ::lib.schema/query
    stage-number :- :int
    a-filter-clause :- ::lib.schema.expression/boolean]
   (let [[op _ first-arg] a-filter-clause
         stage   (lib.util/query-stage query stage-number)
         columns (lib.metadata.calculation/visible-columns query stage-number stage)
         col     (lib.equality/find-matching-column query stage-number first-arg columns)]
     (clojure.core/or (m/find-first #(clojure.core/= (:short %) op)
                                    (lib.filter.operator/filter-operators col))
                      (lib.filter.operator/operator-def op)))))
(mu/defn find-filter-for-legacy-filter :- [:maybe ::lib.schema.expression/boolean]
  "Return the filter clause in `query` at stage `stage-number` matching the legacy
  filter clause `legacy-filter`, if any."
  ([query :- ::lib.schema/query
    legacy-filter]
   (find-filter-for-legacy-filter query -1 legacy-filter))
  ([query         :- ::lib.schema/query
    stage-number  :- :int
    legacy-filter :- some?]
   (let [legacy-filter    (mbql.normalize/normalize-fragment [:query :filter] legacy-filter)
         query-filters    (vec (filters query stage-number))
         matching-filters (clojure.core/filter #(clojure.core/= (mbql.normalize/normalize-fragment
                                                                 [:query :filter]
                                                                 (lib.convert/->legacy-MBQL %))
                                                                legacy-filter)
                                               query-filters)]
     (when (seq matching-filters)
       (if (next matching-filters)
         (throw (ex-info "Multiple matching filters found" {:legacy-filter    legacy-filter
                                                            :query-filters    query-filters
                                                            :matching-filters matching-filters}))
         (first matching-filters))))))

TODO: Refactor this away - handle legacy refs in lib.js and call lib.equality from there.

(mu/defn find-filterable-column-for-legacy-ref :- [:maybe ColumnWithOperators]
  "Given a legacy `:field` reference, return the filterable [[ColumnWithOperators]] that best fits it."
  ([query legacy-ref]
   (find-filterable-column-for-legacy-ref query -1 legacy-ref))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    legacy-ref   :- some?]
   (let [a-ref   (lib.convert/legacy-ref->pMBQL query stage-number legacy-ref)
         columns (filterable-columns query stage-number)]
     (lib.equality/find-matching-column a-ref columns))))
(def ^:private FilterParts
  [:map
   [:lib/type [:= :mbql/filter-parts]]
   [:operator ::lib.schema.filter/operator]
   [:options ::lib.schema.common/options]
   [:column [:maybe ColumnWithOperators]]
   [:args [:sequential :any]]])
(mu/defn filter-parts :- FilterParts
  "Return the parts of the filter clause `a-filter-clause` in query `query` at stage `stage-number`.
  Might obsolate [[filter-operator]]."
  ([query a-filter-clause]
   (filter-parts query -1 a-filter-clause))
  ([query :- ::lib.schema/query
    stage-number :- :int
    a-filter-clause :- ::lib.schema.expression/boolean]
   (let [[op options first-arg & rest-args] a-filter-clause
         stage   (lib.util/query-stage query stage-number)
         columns (lib.metadata.calculation/visible-columns query stage-number stage)
         col     (lib.equality/find-matching-column query stage-number first-arg columns)]
     {:lib/type :mbql/filter-parts
      :operator (clojure.core/or (m/find-first #(clojure.core/= (:short %) op)
                                               (lib.filter.operator/filter-operators col))
                                 (lib.filter.operator/operator-def op))
      :options  options
      :column   (some-> col add-column-operators)
      :args     (vec rest-args)})))
 
(ns metabase.lib.filter.operator
  (:require
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.filter :as lib.schema.filter]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util :as u]
   [metabase.util.malli :as mu]))
(mu/defn operator-def :- ::lib.schema.filter/operator
  "Get a filter operator definition for the MBQL filter with `tag`, e.g. `:=`. In some cases various tags have alternate
  display names used for different situations e.g. for numbers vs temporal values; pass in the
  `display-name-style` to choose a non-default display-name."
  ([tag]
   (operator-def tag :default))
  ([tag display-name-style]
   {:lib/type             :operator/filter
    :short                tag
    :display-name-variant display-name-style}))
(def ^:private key-operators
  [(operator-def :=)
   (operator-def :!=)
   (operator-def :>)
   (operator-def :<)
   (operator-def :between)
   (operator-def :>=)
   (operator-def :<=)
   (operator-def :is-null :is-empty)
   (operator-def :not-null :not-empty)])
(def ^:private location-operators
  [(operator-def :=)
   (operator-def :!=)
   (operator-def :is-empty)
   (operator-def :not-empty)
   (operator-def :contains)
   (operator-def :does-not-contain)
   (operator-def :starts-with)
   (operator-def :ends-with)])
(def ^:private temporal-operators
  [(operator-def :!= :excludes)
   (operator-def :=)
   (operator-def :< :before)
   (operator-def :> :after)
   (operator-def :between)
   (operator-def :is-null :is-empty)
   (operator-def :not-null :not-empty)])
(def ^:private coordinate-operators
  [(operator-def :=)
   (operator-def :!=)
   (operator-def :inside)
   (operator-def :>)
   (operator-def :<)
   (operator-def :between)
   (operator-def :>=)
   (operator-def :<=)])
(def ^:private number-operators
  [(operator-def := :equal-to)
   (operator-def :!= :not-equal-to)
   (operator-def :>)
   (operator-def :<)
   (operator-def :between)
   (operator-def :>=)
   (operator-def :<=)
   (operator-def :is-null :is-empty)
   (operator-def :not-null :not-empty)])
(def ^:private text-operators
  [(operator-def :=)
   (operator-def :!=)
   (operator-def :contains)
   (operator-def :does-not-contain)
   (operator-def :is-null)
   (operator-def :not-null)
   (operator-def :is-empty)
   (operator-def :not-empty)
   (operator-def :starts-with)
   (operator-def :ends-with)])
(def ^:private text-like-operators
  [(operator-def :=)
   (operator-def :!=)
   (operator-def :is-null)
   (operator-def :not-null)
   (operator-def :is-empty)
   (operator-def :not-empty)])
(def ^:private boolean-operators
  [(operator-def :=)
   (operator-def :is-null :is-empty)
   (operator-def :not-null :not-empty)])
(def ^:private default-operators
  [(operator-def :=)
   (operator-def :!=)
   (operator-def :is-null)
   (operator-def :not-null)])

Operators that should be listed as options in join conditions.

(def join-operators
  [(assoc (operator-def :=) :default true)
   (operator-def :>)
   (operator-def :<)
   (operator-def :>=)
   (operator-def :<=)
   (operator-def :!=)])
(mu/defn filter-operators :- [:sequential ::lib.schema.filter/operator]
  "The list of available filter operators.
   The order of operators is relevant for the front end.
   There are slight differences between names and ordering for the different base types."
  [column :- lib.metadata/ColumnMetadata]
  ;; The order of these clauses is important since we want to match the most relevant type
  ;; the order is different than `lib.types.isa/field-type` as filters need to operate
  ;; on the effective-type rather than the semantic-type, eg boolean and number cannot become
  ;; string if semantic type is type/Category
  (condp lib.types.isa/field-type? column
    :metabase.lib.types.constants/primary_key key-operators
    :metabase.lib.types.constants/foreign_key key-operators
    :metabase.lib.types.constants/location    location-operators
    :metabase.lib.types.constants/temporal    temporal-operators
    :metabase.lib.types.constants/coordinate  coordinate-operators
    :metabase.lib.types.constants/number      number-operators
    :metabase.lib.types.constants/boolean     boolean-operators
    :metabase.lib.types.constants/string      text-operators
    :metabase.lib.types.constants/string_like text-like-operators
    ;; default
    default-operators))
(mu/defn ^:private filter-operator-long-display-name :- ::lib.schema.common/non-blank-string
  [tag                  :- :keyword
   display-name-variant :- :keyword]
  (case tag
    :=                (case display-name-variant
                        :equal-to (i18n/tru "Equal to")
                        :default  (i18n/tru "Is"))
    :!=               (case display-name-variant
                        :not-equal-to (i18n/tru "Not equal to")
                        :excludes     (i18n/tru "Excludes")
                        :default      (i18n/tru "Is not"))
    :>                (case display-name-variant
                        :after   (i18n/tru "After")
                        :default (i18n/tru "Greater than"))
    :<                (case display-name-variant
                        :before  (i18n/tru "Before")
                        :default (i18n/tru "Less than"))
    :>=               (case display-name-variant
                        :default (i18n/tru "Greater than or equal to"))
    :<=               (case display-name-variant
                        :default (i18n/tru "Less than or equal to"))
    :between          (case display-name-variant
                        :default (i18n/tru "Between"))
    :is-null          (case display-name-variant
                        :is-empty (i18n/tru "Is empty")
                        :default  (i18n/tru "Is null"))
    :not-null         (case display-name-variant
                        :not-empty (i18n/tru "Not empty")
                        :default   (i18n/tru "Not null"))
    :is-empty         (case display-name-variant
                        :default (i18n/tru "Is empty"))
    :not-empty        (case display-name-variant
                        :default (i18n/tru "Not empty"))
    :contains         (case display-name-variant
                        :default (i18n/tru "Contains"))
    :does-not-contain (case display-name-variant
                        :default (i18n/tru "Does not contain"))
    :starts-with      (case display-name-variant
                        :default (i18n/tru "Starts with"))
    :ends-with        (case display-name-variant
                        :default (i18n/tru "Ends with"))
    :inside           (case display-name-variant
                        :default (i18n/tru "Inside"))))
(mu/defn ^:private filter-operator-display-name :- ::lib.schema.common/non-blank-string
  [tag                  :- :keyword
   display-name-variant :- :keyword]
  (case tag
    :=  "="
    :!= "≠"
    :>  ">"
    :<  "<"
    :>= "≥"
    :<= "≤"
    (filter-operator-long-display-name tag display-name-variant)))
(defmethod lib.metadata.calculation/display-name-method :operator/filter
  [_query _stage-number {short-name :short, :keys [display-name-variant]} display-name-style]
  (case display-name-style
    :default (filter-operator-display-name short-name display-name-variant)
    :long    (filter-operator-long-display-name short-name display-name-variant)))
(defmethod lib.metadata.calculation/display-info-method :operator/filter
  [_query _stage-number {short-name :short, :keys [display-name-variant default]}]
  (cond-> {:short-name        (u/qualified-name short-name)
           :display-name      (filter-operator-display-name short-name display-name-variant)
           :long-display-name (filter-operator-long-display-name short-name display-name-variant)}
    default (assoc :default true)))
 

Conveniences for adding or updating certain types of filters, used to power the drag-and-drop 'brush' zoom-in filtering in the frontend. For example the user might drag the mouse between two points on a timeseries visualization, and we use these functions to update the query accordingly and add a filter between the start and end points.

There are three types of brush filters:

  • [[update-temporal-filter]], which works on a single temporal column (e.g. zooming in on certain range in a timeseries visualization)

  • [[update-numeric-filter]], which works on a single numeric column

  • [[update-lat-lon-filter]], which works on a latitude and longitude column pair. This is used with map visualizations -- draw a box between two points to zoom in to that part of the map.

If there is no existing filter on the column(s), these add a new filter. Existing filters are replaced.

(ns metabase.lib.filter.update
  (:require
   [metabase.lib.breakout :as lib.breakout]
   [metabase.lib.equality :as lib.equality]
   [metabase.lib.filter :as lib.filter]
   [metabase.lib.ref :as lib.ref]
   [metabase.lib.remove-replace :as lib.remove-replace]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.literal :as lib.schema.literal]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.lib.schema.temporal-bucketing :as lib.schema.temporal-bucketing]
   [metabase.lib.temporal-bucket :as lib.temporal-bucket]
   [metabase.lib.util :as lib.util]
   [metabase.shared.util.time :as shared.ut]
   [metabase.util.malli :as mu]
   [metabase.util.malli.registry :as mr]))
(defn- is-ref-for-column? [expr column]
  (and (lib.util/clause-of-type? expr :field)
       (lib.equality/find-matching-column expr [column])))
(mu/defn ^:private remove-existing-filters-against-column :- ::lib.schema/query
  "Remove any existing filters clauses that use `column` as the first arg in a stage of a `query`."
  [query        :- ::lib.schema/query
   stage-number :- :int
   column       :- ::lib.schema.metadata/column]
  (reduce
   (fn [query [_tag _opts expr :as filter-clause]]
     (if (is-ref-for-column? expr column)
       (lib.remove-replace/remove-clause query stage-number filter-clause)
       query))
   query
   (lib.filter/filters query stage-number)))
(mu/defn update-numeric-filter :- ::lib.schema/query
  "Add or update a filter against `numeric-column`. Adapted from
  https://github.com/metabase/metabase/blob/98bcd7fc3102bd7c07e8b68878c3738f3cb8727b/frontend/src/metabase-lib/queries/utils/actions.js#L151-L154"
  ([query numeric-column start end]
   (update-numeric-filter query -1 numeric-column start end))
  ([query          :- ::lib.schema/query
    stage-number   :- :int
    numeric-column :- ::lib.schema.metadata/column
    start          :- number?
    end            :- number?]
   (let [[start end] (sort [start end])]
     (-> query
         (remove-existing-filters-against-column stage-number numeric-column)
         (lib.filter/filter stage-number (lib.filter/between numeric-column start end))))))

Minimum number of points an updated query should return; if it will return less than this, switch to the [[unit->next-unit]]. E.g. if we zoom in on a query using unit is :day and the zoomed in query would only return 2 points, switch the unit to :minute.

points in this case correspond to the number of rows returned by a query if there are no gaps. E.g. if we have a query like

orders, count aggregation, broken out by month(created_at) between 2024-01 and 2024-03 (inclusive)

we would have at most 3 rows returned -- the value for 2024-01, the value for 2024-02, and the value for 2024-03. If no rows have a created_at in that month, then those rows may not get returned. However, the FE should interpolate the missing values and still include points with values of zero; that's what we mean when we say "points" below.

(def ^:private temporal-filter-min-num-points
  4)

E.g. the next unit after :hour is :minute.

(def ^:private unit->next-unit
  (let [units [:minute :hour :day :week :month :quarter :year]]
    (zipmap units (cons nil units))))
(mu/defn ^:private temporal-filter-find-best-breakout-unit :- ::lib.schema.temporal-bucketing/unit.date-time.truncate
  "If the current breakout `unit` will not return at least [[temporal-filter-min-num-points]], find the largest unit
  that will."
  [unit  :- ::lib.schema.temporal-bucketing/unit.date-time.truncate
   start :- ::lib.schema.literal/temporal
   end   :- ::lib.schema.literal/temporal]
  (loop [unit unit]
    (let [num-points      (shared.ut/unit-diff unit start end)
          too-few-points? (< num-points temporal-filter-min-num-points)]
      (if-let [next-largest-unit (when too-few-points?
                                   (unit->next-unit unit))]
        (recur next-largest-unit)
        unit))))
(mu/defn ^:private temporal-filter-update-breakouts :- ::lib.schema/query
  "Update the first breakout against `column` so it uses `new-unit` rather than the original unit (if any); remove all
  other breakouts against that column."
  [query        :- ::lib.schema/query
   stage-number :- :int
   column       :- ::lib.schema.metadata/column
   new-unit     :- ::lib.schema.temporal-bucketing/unit.date-time.truncate]
  (transduce
   identity
   (fn
     ([{:keys [query]}]
      query)
     ([{:keys [query has-seen-column?], :as m} breakout]
      (if (is-ref-for-column? breakout column)
        (let [query' (if has-seen-column?
                       ;; already seen a breakout for this column: remove other breakouts.
                       (lib.remove-replace/remove-clause query stage-number breakout)
                       ;; this is the first breakout we've seen for this column: replace it with one that uses
                       ;; `new-unit`.
                       (let [col-ref (lib.ref/ref (lib.temporal-bucket/with-temporal-bucket column new-unit))]
                         (lib.remove-replace/replace-clause query stage-number breakout col-ref)))]
          {:query query', :has-seen-column? true})
        ;; not a breakout against `column`: ignore it
        m)))
   {:query query, :has-seen-column? false}
   (lib.breakout/breakouts query stage-number)))
(mu/defn update-temporal-filter :- ::lib.schema/query
  "Add or update a filter against `temporal-column`. Modify the temporal unit for any breakouts. For use powering the
  brush zoom-in in timeseries visualizations.
  This is adapted from old MLv1 code here
  https://github.com/metabase/metabase/blob/98bcd7fc3102bd7c07e8b68878c3738f3cb8727b/frontend/src/metabase-lib/queries/utils/actions.js#L75-L132"
  ([query temporal-column start end]
   (update-temporal-filter query -1 temporal-column start end))
  ([query           :- ::lib.schema/query
    stage-number    :- :int
    temporal-column :- ::lib.schema.metadata/column
    start           :- ::lib.schema.literal/temporal
    end             :- ::lib.schema.literal/temporal]
   (let [query (remove-existing-filters-against-column query stage-number temporal-column)
         unit  (lib.temporal-bucket/raw-temporal-bucket temporal-column)]
     (if-not unit
       ;; Temporal column is not bucketed: we don't need to update any temporal units here. Add/update a `:between`
       ;; filter.
       (lib.filter/filter query stage-number (lib.filter/between temporal-column start end))
       ;; temporal-column IS bucketed: need to update the breakout(s) against this column.
       (let [;; clamp range to unit to ensure we select exactly what's represented by the dots/bars. E.g. if I draw my
             ;; filter from `2024-01-02` to `2024-03-05` and the unit is `:month`, we should only show the months
             ;; between those two values, i.e. only `2024-02` and `2024-03`.
             start         (shared.ut/truncate (shared.ut/add start unit 1) unit)
             end           (shared.ut/truncate end unit)
             ;; update the breakout unit if appropriate.
             breakout-unit (temporal-filter-find-best-breakout-unit unit start end)
             query         (if (= unit breakout-unit)
                             query
                             (temporal-filter-update-breakouts query stage-number temporal-column breakout-unit))]
         (if (= (str start) (str end))
           ;; is the start and end are the same (in whatever the original unit was) then just do an "="
           (lib.filter/filter query stage-number (lib.filter/= temporal-column start))
           ;; otherwise do a between (which is inclusive)
           (lib.filter/filter query stage-number (lib.filter/between temporal-column start end))))))))
(mr/def ::lat-lon.bounds
  [:map
   [:north number?]
   [:east  number?]
   [:south number?]
   [:west  number?]])
(mu/defn update-lat-lon-filter :- ::lib.schema/query
  "For use powering the brush zoom-in behavior in map visualizations. Adapted from
  https://github.com/metabase/metabase/blob/98bcd7fc3102bd7c07e8b68878c3738f3cb8727b/frontend/src/metabase-lib/queries/utils/actions.js#L134-L149"
  ([query latitude-column longitude-column bounds]
   (update-lat-lon-filter query -1 latitude-column longitude-column bounds))
  ([query                                        :- ::lib.schema/query
    stage-number                                 :- :int
    latitude-column                              :- ::lib.schema.metadata/column
    longitude-column                             :- :some
    {:keys [north east south west], :as _bounds} :- [:ref ::lat-lon.bounds]]
   (-> query
       (remove-existing-filters-against-column stage-number latitude-column)
       (remove-existing-filters-against-column stage-number longitude-column)
       (lib.filter/filter stage-number (let [[lat-min lat-max] (sort [north south])
                                             [lon-min lon-max] (sort [east west])]
                                         (lib.filter/inside latitude-column longitude-column lat-max lon-min lat-min lon-max))))))
 
(ns metabase.lib.hierarchy
  (:refer-clojure :exclude [derive isa?]))

Keyword hierarchy for MLv2 stuff.

(defonce  hierarchy
  (atom (make-hierarchy)))

Like [[clojure.core/derive]], but affects [[hierarchy]] rather than the global hierarchy.

(defn derive
  [tag parent]
  (swap! hierarchy clojure.core/derive tag parent)
  ;; for REPL convenience so we don't dump a lot of garbage
  nil)

Like [[clojure.core/isa?]], but uses [[hierarchy]].

(defn isa?
  [tag parent]
  (clojure.core/isa? @hierarchy tag parent))
 

Functions related to manipulating EXPLICIT joins in MBQL.

(ns metabase.lib.join
  (:require
   [clojure.string :as str]
   [inflections.core :as inflections]
   [medley.core :as m]
   [metabase.lib.card :as lib.card]
   [metabase.lib.common :as lib.common]
   [metabase.lib.dispatch :as lib.dispatch]
   [metabase.lib.equality :as lib.equality]
   [metabase.lib.filter :as lib.filter]
   [metabase.lib.filter.operator :as lib.filter.operator]
   [metabase.lib.hierarchy :as lib.hierarchy]
   [metabase.lib.join.util :as lib.join.util]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.options :as lib.options]
   [metabase.lib.query :as lib.query]
   [metabase.lib.ref :as lib.ref]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.expression :as lib.schema.expression]
   [metabase.lib.schema.filter :as lib.schema.filter]
   [metabase.lib.schema.join :as lib.schema.join]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.lib.schema.temporal-bucketing :as lib.schema.temporal-bucketing]
   [metabase.lib.temporal-bucket :as lib.temporal-bucket]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.lib.util :as lib.util]
   [metabase.mbql.util.match :as mbql.u.match]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]))
(defn- join? [x]
  (= (lib.dispatch/dispatch-value x) :mbql/join))
(def ^:private Joinable
  [:or lib.metadata/TableMetadata lib.metadata/CardMetadata])
(def ^:private JoinOrJoinable
  [:or
   [:ref ::lib.schema.join/join]
   Joinable])
(declare with-join-alias)

Impl for [[with-join-alias]] for a join: recursively update the :join-alias for the :field refs inside :fields as needed.

(defn- with-join-alias-update-join-fields
  [join new-alias]
  (cond-> join
    (:fields join) (update :fields (fn [fields]
                                     (if-not (sequential? fields)
                                       fields
                                       (mapv (fn [field-ref]
                                               (with-join-alias field-ref new-alias))
                                             fields))))))
(mu/defn ^:private standard-join-condition? :- :boolean
  "Whether this join condition is a binary condition with two `:field` references (a LHS and a RHS), as you'd produce
  in the frontend using functions like [[join-condition-operators]], [[join-condition-lhs-columns]],
  and [[join-condition-rhs-columns]]."
  [condition  :- [:maybe ::lib.schema.expression/boolean]]
  (when condition
    (mbql.u.match/match-one condition
      [(_operator :guard keyword?)
       _opts
       [:field _lhs-opts _lhs-id-or-name]
       [:field _rhs-opts _rhs-id-or-name]]
      true
      _
      false)))

If condition is a [[standard-join-condition?]], return the LHS.

(defn- standard-join-condition-lhs
  [condition]
  (when (standard-join-condition? condition)
    (let [[_operator _opts lhs _rhs] condition]
      lhs)))

If condition is a [[standard-join-condition?]], return the RHS.

(defn- standard-join-condition-rhs
  [condition]
  (when (standard-join-condition? condition)
    (let [[_operator _opts _lhs rhs] condition]
      rhs)))

If condition is a [[standard-join-condition?]], update the RHS with f like

(apply f rhs args)

(defn- standard-join-condition-update-rhs
  [condition f & args]
  (if-not (standard-join-condition? condition)
    condition
    (let [[operator opts lhs rhs] condition]
      [operator opts lhs (apply f rhs args)])))
(mu/defn ^:private with-join-alias-update-join-conditions :- lib.join.util/PartialJoin
  "Impl for [[with-join-alias]] for a join: recursively update the `:join-alias` for inside the `:conditions` of the
  join.
  If `old-alias` is specified, uses [[metabase.mbql.util.match]] to update all the `:field` references using the old
  alias.
  If `old-alias` is `nil`, updates the RHS of all 'standard' conditions (binary filter clauses with two `:field` refs as
  args, e.g. the kind you'd get if you were using [[join-condition-operators]] and the like to create them). This
  currently doesn't handle more complex filter clauses that were created without the 'normal' MLv2 functions used by
  the frontend; we can add this in the future if we need it."
  [join      :- lib.join.util/PartialJoin
   old-alias :- [:maybe ::lib.schema.common/non-blank-string]
   new-alias :- [:maybe ::lib.schema.common/non-blank-string]]
  (cond
    (empty? (:conditions join))
    join
    ;; if we've specified `old-alias`, then update ANY `:field` clause using it to `new-alias` instead.
    old-alias
    (mbql.u.match/replace-in join [:conditions]
      [:field {:join-alias old-alias} _id-or-name]
      (with-join-alias &match new-alias))
    ;; otherwise if `old-alias` is `nil`, then add (or remove!) `new-alias` to the RHS of any binary
    ;; filter clauses that don't already have a `:join-alias`.
    :else
    (update join :conditions (fn [conditions]
                               (mapv (fn [condition]
                                       (standard-join-condition-update-rhs condition with-join-alias new-alias))
                                     conditions)))))

Impl for [[with-join-alias]] for a join.

(defn- with-join-alias-update-join
  [join new-alias]
  (let [old-alias (lib.join.util/current-join-alias join)]
    (-> join
        (u/assoc-dissoc :alias new-alias)
        (with-join-alias-update-join-fields new-alias)
        (with-join-alias-update-join-conditions old-alias new-alias))))
(mu/defn with-join-alias :- lib.join.util/FieldOrPartialJoin
  "Add OR REMOVE a specific `join-alias` to `field-or-join`, which is either a `:field`/Field metadata, or a join map.
  Does not recursively update other references (yet; we can add this in the future)."
  {:style/indent [:form]}
  [field-or-join :- lib.join.util/FieldOrPartialJoin
   join-alias    :- [:maybe ::lib.schema.common/non-blank-string]]
  (case (lib.dispatch/dispatch-value field-or-join)
    :field
    (lib.options/update-options field-or-join u/assoc-dissoc :join-alias join-alias)
    :metadata/column
    (u/assoc-dissoc field-or-join ::join-alias join-alias)
    :mbql/join
    (with-join-alias-update-join field-or-join join-alias)
    ;; this should not happen (and cannot happen in CLJ land)
    ;; but it does seem to happen in JS land with broken MLv1 queries
    (do (log/error "with-join-value should not be called with" (pr-str field-or-join))
        field-or-join)))
(mu/defn resolve-join :- ::lib.schema.join/join
  "Resolve a join with a specific `join-alias`."
  [query        :- ::lib.schema/query
   stage-number :- :int
   join-alias   :- ::lib.schema.common/non-blank-string]
  (let [{:keys [joins]} (lib.util/query-stage query stage-number)]
    (or (m/find-first #(= (:alias %) join-alias)
                      joins)
        (throw (ex-info (i18n/tru "No join named {0}, found: {1}"
                                  (pr-str join-alias)
                                  (pr-str (mapv :alias joins)))
                        {:join-alias   join-alias
                         :query        query
                         :stage-number stage-number})))))
(defmethod lib.metadata.calculation/display-name-method :mbql/join
  [query _stage-number {[{:keys [source-table source-card], :as _first-stage}] :stages, :as _join} _style]
  (or
   (when source-table
     (:display-name (lib.metadata/table query source-table)))
   (when source-card
     (if-let [card-metadata (lib.metadata/card query source-card)]
       (lib.metadata.calculation/display-name query 0 card-metadata)
       (lib.card/fallback-display-name source-card)))
   (i18n/tru "Native Query")))
(defmethod lib.metadata.calculation/display-info-method :mbql/join
  [query stage-number join]
  (let [display-name (lib.metadata.calculation/display-name query stage-number join)]
    {:name (or (:alias join) display-name), :display-name display-name}))
(defmethod lib.metadata.calculation/metadata-method :mbql/join
  [_query _stage-number _query]
  ;; not i18n'ed because this shouldn't be developer-facing.
  (throw (ex-info "You can't calculate a metadata map for a join! Use lib.metadata.calculation/returned-columns-method instead."
                  {})))
(mu/defn ^:private column-from-join-fields :- lib.metadata.calculation/ColumnMetadataWithSource
  "For a column that comes from a join `:fields` list, add or update metadata as needed, e.g. include join name in the
  display name."
  [query           :- ::lib.schema/query
   stage-number    :- :int
   column-metadata :- ::lib.schema.metadata/column
   join-alias      :- ::lib.schema.common/non-blank-string]
  (let [column-metadata (assoc column-metadata :source-alias join-alias)
        col             (-> (assoc column-metadata
                                   :display-name (lib.metadata.calculation/display-name query stage-number column-metadata)
                                   :lib/source   :source/joins)
                            (with-join-alias join-alias))]
    (assert (= (lib.join.util/current-join-alias col) join-alias))
    col))
(defmethod lib.metadata.calculation/display-name-method :option/join.strategy
  [_query _stage-number {:keys [strategy]} _style]
  (case strategy
    :left-join  (i18n/tru "Left outer join")
    :right-join (i18n/tru "Right outer join")
    :inner-join (i18n/tru "Inner join")
    :full-join  (i18n/tru "Full outer join")))
(defmethod lib.metadata.calculation/display-info-method :option/join.strategy
  [query stage-number {:keys [strategy default], :as option}]
  (cond-> {:short-name   (u/qualified-name strategy)
           :display-name (lib.metadata.calculation/display-name query stage-number option)}
    default (assoc :default true)))
(mu/defn ^:private add-source-and-desired-aliases :- :map
  [join           :- [:map
                      [:alias
                       {:error/message "Join must have an alias to determine column aliases!"}
                       ::lib.schema.common/non-blank-string]]
   unique-name-fn :- fn?
   col            :- :map]
  (assoc col
         :lib/source-column-alias  ((some-fn :lib/source-column-alias :name) col)
         :lib/desired-column-alias (unique-name-fn (lib.join.util/joined-field-desired-alias
                                                    (:alias join)
                                                    ((some-fn :lib/source-column-alias :name) col)))))
(defmethod lib.metadata.calculation/returned-columns-method :mbql/join
  [query
   stage-number
   {:keys [fields stages], join-alias :alias, :or {fields :none}, :as join}
   {:keys [unique-name-fn], :as options}]
  (when-not (= fields :none)
    (let [ensure-previous-stages-have-metadata (resolve 'metabase.lib.stage/ensure-previous-stages-have-metadata)
          join-query (cond-> (assoc query :stages stages)
                       ensure-previous-stages-have-metadata
                       (ensure-previous-stages-have-metadata -1))
          field-metadatas (if (= fields :all)
                            (lib.metadata.calculation/returned-columns join-query -1 (peek stages) options)
                            (for [field-ref fields
                                  :let [join-field (lib.options/update-options field-ref dissoc :join-alias)]]
                              (lib.metadata.calculation/metadata join-query -1 join-field)))]
      (mapv (fn [field-metadata]
              (->> (column-from-join-fields query stage-number field-metadata join-alias)
                   (add-source-and-desired-aliases join unique-name-fn)))
            field-metadatas))))
(defmethod lib.metadata.calculation/visible-columns-method :mbql/join
  [query stage-number join options]
  (lib.metadata.calculation/returned-columns query stage-number (assoc join :fields :all) options))
(mu/defn all-joins-visible-columns :- lib.metadata.calculation/ColumnsWithUniqueAliases
  "Convenience for calling [[lib.metadata.calculation/visible-columns]] on all of the joins in a query stage."
  [query          :- ::lib.schema/query
   stage-number   :- :int
   unique-name-fn :- fn?]
  (into []
        (mapcat (fn [join]
                  (lib.metadata.calculation/visible-columns query
                                                            stage-number
                                                            join
                                                            {:unique-name-fn               unique-name-fn
                                                             :include-implicitly-joinable? false})))
        (:joins (lib.util/query-stage query stage-number))))
(mu/defn all-joins-expected-columns :- lib.metadata.calculation/ColumnsWithUniqueAliases
  "Convenience for calling [[lib.metadata.calculation/returned-columns-method]] on all the joins in a query stage."
  [query        :- ::lib.schema/query
   stage-number :- :int
   options      :- lib.metadata.calculation/ReturnedColumnsOptions]
  (into []
        (mapcat (fn [join]
                  (lib.metadata.calculation/returned-columns query stage-number join options)))
        (:joins (lib.util/query-stage query stage-number))))

Convert something to a join clause.

(defmulti ^:private join-clause-method
  {:arglists '([joinable])}
  lib.dispatch/dispatch-value
  :hierarchy lib.hierarchy/hierarchy)

TODO -- should the default implementation call [[metabase.lib.query/query]]? That way if we implement a method to create an MBQL query from a Table, then we'd also get [[join]] support for free?

(defmethod join-clause-method :mbql/join
  [a-join-clause]
  a-join-clause)

TODO -- this probably ought to live in [[metabase.lib.query]]

(defmethod join-clause-method :mbql/query
  [another-query]
  (-> {:lib/type :mbql/join
       :stages   (:stages (lib.util/pipeline another-query))}
      lib.options/ensure-uuid))

TODO -- this probably ought to live in [[metabase.lib.stage]]

(defmethod join-clause-method :mbql.stage/mbql
  [mbql-stage]
  (-> {:lib/type :mbql/join
       :stages   [mbql-stage]}
      lib.options/ensure-uuid))
(defmethod join-clause-method :metadata/card
  [card]
  (-> {:lib/type :mbql/join
       :stages [{:source-card (:id card)
                 :lib/type :mbql.stage/mbql}]}
      lib.options/ensure-uuid))
(declare with-join-fields)
(defmethod join-clause-method :metadata/table
  [{::keys [join-alias join-fields], :as table-metadata}]
  (cond-> (join-clause-method {:lib/type     :mbql.stage/mbql
                               :lib/options  {:lib/uuid (str (random-uuid))}
                               :source-table (:id table-metadata)})
    join-alias  (with-join-alias join-alias)
    join-fields (with-join-fields join-fields)))

Add join-alias to the RHS of all [[standard-join-condition?]] conditions that don't already have a :join-alias. If an RHS already has a :join-alias, don't second guess what was already explicitly specified.

(defn- with-join-conditions-add-alias-to-rhses
  [conditions join-alias]
  (if-not join-alias
    conditions
    (mapv (fn [condition]
            (or (when-let [rhs (standard-join-condition-rhs condition)]
                  (when-not (lib.join.util/current-join-alias rhs)
                    (standard-join-condition-update-rhs condition with-join-alias join-alias)))
                condition))
          conditions)))
(mu/defn with-join-conditions :- lib.join.util/PartialJoin
  "Update the `:conditions` (filters) for a Join clause."
  {:style/indent [:form]}
  [a-join     :- lib.join.util/PartialJoin
   conditions :- [:maybe [:sequential [:or ::lib.schema.expression/boolean ::lib.schema.common/external-op]]]]
  (let [conditions (-> (mapv lib.common/->op-arg conditions)
                       (with-join-conditions-add-alias-to-rhses (lib.join.util/current-join-alias a-join)))]
    (u/assoc-dissoc a-join :conditions (not-empty conditions))))
(mu/defn join-clause :- lib.join.util/PartialJoin
  "Create an MBQL join map from something that can conceptually be joined against. A `Table`? An MBQL or native query? A
  Saved Question? You should be able to join anything, and this should return a sensible MBQL join map."
  ([joinable]
   (-> (join-clause-method joinable)
       (u/assoc-default :fields :all)))
  ([joinable conditions]
   (-> (join-clause joinable)
       (with-join-conditions conditions))))
(mu/defn with-join-fields :- lib.join.util/PartialJoin
  "Update a join (or a function that will return a join) to include `:fields`, either `:all`, `:none`, or a sequence of
  references."
  [joinable :- lib.join.util/PartialJoin
   fields   :- [:maybe [:or [:enum :all :none] [:sequential some?]]]]
  (let [fields (cond
                 (keyword? fields) fields
                 (= fields [])     :none
                 :else             (not-empty
                                    (into []
                                          (comp (map lib.ref/ref)
                                                (if-let [current-alias (lib.join.util/current-join-alias joinable)]
                                                  (map #(with-join-alias % current-alias))
                                                  identity))
                                          fields)))]
    (u/assoc-dissoc joinable :fields fields)))
(defn- select-home-column
  [home-cols cond-fields]
  (let [cond-home-cols (keep #(lib.equality/find-matching-column % home-cols) cond-fields)]
    ;; first choice: the leftmost FK or PK in the condition referring to a home column
    (or (m/find-first (some-fn lib.types.isa/foreign-key? lib.types.isa/primary-key?) cond-home-cols)
        ;; otherwise the leftmost home column in the condition
        (first cond-home-cols)
        ;; otherwise the first FK home column
        (m/find-first lib.types.isa/foreign-key? home-cols)
        ;; otherwise the first PK home column
        (m/find-first lib.types.isa/primary-key? home-cols)
        ;; otherwise the first home column
        (first home-cols))))
(defn- strip-id [s]
  (when (string? s)
    (str/trim (str/replace s #"(?i) id$" ))))

Checks if name0 and name1 are similar. Two names are considered similar if they are the same, one is the plural of the other, or their plurals are equal. This is used to avoid repeating ourselves in situations like when we have a table called PRODUCTS and a field (presumably referring to that table) called PRODUCT.

(defn- similar-names?
  [name0 name1]
  (and (string? name0) (string? name1)
       (let [plural1 (delay (inflections/plural name1))
             plural0 (delay (inflections/plural name0))]
         (or (= name0 name1)
             (= name0 @plural1)
             (= @plural0 name1)
             (= @plural0 @plural1)))))
(defn- calculate-join-alias [query joined home-col]
  (let [joined-name (lib.metadata.calculation/display-name
                     (if (= (:lib/type joined) :mbql/query) joined query)
                     joined)
        home-name   (when home-col (strip-id (lib.metadata.calculation/display-name query home-col)))
        similar     (similar-names? joined-name home-name)
        join-alias  (or (and joined-name
                             home-name
                             (not (re-matches #"(?i)id" home-name))
                             (not similar)
                             (str joined-name " - " home-name))
                        joined-name
                        home-name
                        "source")]
    join-alias))
(defn- add-alias-to-join-refs [query stage-number form join-alias join-cols]
  (mbql.u.match/replace form
    (field :guard (fn [field-clause]
                    (and (lib.util/field-clause? field-clause)
                         (boolean (lib.equality/find-matching-column query stage-number field-clause join-cols)))))
    (with-join-alias field join-alias)))
(defn- add-alias-to-condition
  [query stage-number condition join-alias home-cols join-cols]
  (let [condition (add-alias-to-join-refs query stage-number condition join-alias join-cols)]
    ;; Sometimes conditions have field references which cannot be unambigously
    ;; assigned to one of the sides. The following code tries to deal with
    ;; these cases, but only for conditions that look like the ones generated
    ;; generated by the FE. These have the form home-field op join-field,
    ;; so we break ties by looking at the poisition of the field reference.
    (mbql.u.match/replace condition
      [op op-opts (lhs :guard lib.util/field-clause?) (rhs :guard lib.util/field-clause?)]
      (let [lhs-alias (lib.join.util/current-join-alias lhs)
            rhs-alias (lib.join.util/current-join-alias rhs)]
        (cond
          ;; no sides obviously belong to joined
          (not (or lhs-alias rhs-alias))
          (if (lib.equality/find-matching-column query stage-number rhs home-cols)
            [op op-opts (with-join-alias lhs join-alias) rhs]
            [op op-opts lhs (with-join-alias rhs join-alias)])
          ;; both sides seem to belong to joined assuming this resulted from
          ;; overly fuzzy matching, we remove the join alias from the LHS
          ;; unless the RHS seems to belong to home too while the LHS doesn't
          (and (= lhs-alias join-alias) (= rhs-alias join-alias))
          (let [bare-lhs (lib.options/update-options lhs dissoc :join-alias)
                bare-rhs (lib.options/update-options rhs dissoc :join-alias)]
            (if (and (nil? (lib.equality/find-matching-column query stage-number bare-lhs home-cols))
                     (lib.equality/find-matching-column query stage-number bare-rhs home-cols))
              [op op-opts lhs bare-rhs]
              [op op-opts bare-lhs rhs]))
          ;; we leave alone the condition otherwise
          :else &match)))))
(defn- generate-unique-name [base-name taken-names]
  (let [generator (lib.util/unique-name-generator)]
    (run! generator taken-names)
    (generator base-name)))
(mu/defn add-default-alias :- ::lib.schema.join/join
  "Add a default generated `:alias` to a join clause that does not already have one."
  [query        :- ::lib.schema/query
   stage-number :- :int
   a-join       :- lib.join.util/JoinWithOptionalAlias]
  (if (contains? a-join :alias)
    ;; if the join clause comes with an alias, keep it and assume that the
    ;; condition fields have the right join-aliases too
    a-join
    (let [stage       (lib.util/query-stage query stage-number)
          home-cols   (lib.metadata.calculation/visible-columns query stage-number stage)
          cond-fields (mbql.u.match/match (:conditions a-join) :field)
          home-col    (select-home-column home-cols cond-fields)
          join-alias  (-> (calculate-join-alias query a-join home-col)
                          (generate-unique-name (keep :alias (:joins stage))))
          join-cols   (lib.metadata.calculation/returned-columns
                       (lib.query/query-with-stages query (:stages a-join)))]
      (-> a-join
          (update :conditions
                  (fn [conditions]
                    (mapv #(add-alias-to-condition query stage-number % join-alias home-cols join-cols)
                          conditions)))
          (with-join-alias join-alias)))))
(declare join-conditions
         joined-thing
         suggested-join-conditions)
(mu/defn join :- ::lib.schema/query
  "Add a join clause to a `query`."
  ([query a-join]
   (join query -1 a-join))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    a-join       :- [:or lib.join.util/PartialJoin Joinable]]
   (let [a-join              (join-clause a-join)
         suggested-conditions (when (empty? (join-conditions a-join))
                                (suggested-join-conditions query stage-number (joined-thing query a-join)))
         a-join              (cond-> a-join
                               (seq suggested-conditions) (with-join-conditions suggested-conditions))
         a-join              (add-default-alias query stage-number a-join)]
     (lib.util/update-query-stage query stage-number update :joins (fn [existing-joins]
                                                                     (conj (vec existing-joins) a-join))))))
(mu/defn joins :- [:maybe ::lib.schema.join/joins]
  "Get all joins in a specific `stage` of a `query`. If `stage` is unspecified, returns joins in the final stage of the
  query."
  ([query]
   (joins query -1))
  ([query        :- ::lib.schema/query
    stage-number :- :int]
   (not-empty (get (lib.util/query-stage query stage-number) :joins))))
(mu/defn join-conditions :- [:maybe ::lib.schema.join/conditions]
  "Get all join conditions for the given join"
  [a-join :- lib.join.util/PartialJoin]
  (:conditions a-join))
(mu/defn join-fields :- [:maybe ::lib.schema.join/fields]
  "Get all join conditions for the given join"
  [a-join :- lib.join.util/PartialJoin]
  (:fields a-join))
(defn- raw-join-strategy->strategy-option [raw-strategy]
  (merge
   {:lib/type :option/join.strategy
    :strategy raw-strategy}
   (when (= raw-strategy :left-join)
     {:default true})))
(mu/defn raw-join-strategy :- ::lib.schema.join/strategy
  "Get the raw keyword strategy (type) of a given join, e.g. `:left-join` or `:right-join`. This is either the value
  of the optional `:strategy` key or the default, `:left-join`, if `:strategy` is not specified."
  [a-join :- lib.join.util/PartialJoin]
  (get a-join :strategy :left-join))
(mu/defn join-strategy :- ::lib.schema.join/strategy.option
  "Get the strategy (type) of a given join, as a `:option/join.strategy` map. If `:stategy` is unspecified, returns
  the default, left join."
  [a-join :- lib.join.util/PartialJoin]
  (raw-join-strategy->strategy-option (raw-join-strategy a-join)))
(mu/defn with-join-strategy :- lib.join.util/PartialJoin
  "Return a copy of `a-join` with its `:strategy` set to `strategy`."
  [a-join   :- lib.join.util/PartialJoin
   strategy :- [:or ::lib.schema.join/strategy ::lib.schema.join/strategy.option]]
  ;; unwrap the strategy to a raw keyword if needed.
  (assoc a-join :strategy (cond-> strategy
                            (= (lib.dispatch/dispatch-value strategy) :option/join.strategy)
                            :strategy)))
(mu/defn available-join-strategies :- [:sequential ::lib.schema.join/strategy.option]
  "Get available join strategies for the current Database (based on the Database's
  supported [[metabase.driver/driver-features]]) as raw keywords like `:left-join`."
  ([query]
   (available-join-strategies query -1))
  ;; stage number is not currently used, but it is taken as a parameter for consistency with the rest of MLv2
  ([query         :- ::lib.schema/query
    _stage-number :- :int]
   (let [database (lib.metadata/database query)
         features (:features database)]
     (into []
           (comp (filter (partial contains? features))
                 (map raw-join-strategy->strategy-option))
           [:left-join :right-join :inner-join :full-join]))))
(mu/defn joined-thing :- [:maybe Joinable]
  "Return metadata about the origin of `a-join` using `metadata-providerable` as the source of information."
  [metadata-providerable :- lib.metadata/MetadataProviderable
   a-join                :- lib.join.util/PartialJoin]
  (let [origin (-> a-join :stages first)]
    (cond
      (:source-card origin)  (lib.metadata/card metadata-providerable (:source-card origin))
      (:source-table origin) (lib.metadata/table metadata-providerable (:source-table origin)))))

Building join conditions:

The QB GUI needs to build a join condition before the join itself is attached to the query. There are three parts to a join condition. Suppose we're building a query like

SELECT * FROM order JOIN user ON order.user_id = user.id

The condition is

order.user_id = user.id ^^^^^^^^^^^^^ ^ ^^^^^^^ 1 2 3

and the three parts are:

  1. LHS/source column: the column in the left-hand side of the condition, e.g. the order.user_id in the example above. Either comes from the source Table, or a previous stage of the query, or a previously-joined Table/Model/Saved Question. order.user_id presumably is an FK to user.id, and while this is typical, is not required.

  2. The operator: = in the example above. Corresponds to an := MBQL clause. = is selected by default.

  3. RHS/destination/target column: the column in the right-hand side of the condition e.g. user.id in the example above. user.id is a column in the Table/Model/Saved Question we are joining against.

The Query Builder allows selecting any of these three parts in any order. The functions below return possible options for each respective part. At the time of this writing, selecting one does not filter out incompatible options for the other parts, but hopefully we can implement this in the future -- see #31174

(mu/defn ^:private sort-join-condition-columns :- [:sequential ::lib.schema.metadata/column]
  "Sort potential join condition columns as returned by [[join-condition-lhs-columns]]
  or [[join-condition-rhs-columns]]. PK columns are returned first, followed by FK columns, followed by other columns.
  Otherwise original order is maintained."
  [columns :- [:sequential ::lib.schema.metadata/column]]
  (let [{:keys [pk fk other]} (group-by (fn [column]
                                          (cond
                                            (lib.types.isa/primary-key? column) :pk
                                            (lib.types.isa/foreign-key? column) :fk
                                            :else                               :other))
                                        columns)]
    (concat pk fk other)))
(defn- mark-selected-column [query stage-number existing-column-or-nil columns]
  (if-not existing-column-or-nil
    columns
    (mapv (fn [column]
            (if (:selected? column)
              (lib.temporal-bucket/with-temporal-bucket
                column
                (lib.temporal-bucket/temporal-bucket existing-column-or-nil))
              column))
          (lib.equality/mark-selected-columns query stage-number columns [existing-column-or-nil]))))
(mu/defn join-condition-lhs-columns :- [:sequential ::lib.schema.metadata/column]
  "Get a sequence of columns that can be used as the left-hand-side (source column) in a join condition. This column
  is the one that comes from the source Table/Card/previous stage of the query or a previous join.
  If you are changing the LHS of a condition for an existing join, pass in that existing join as `join-or-joinable` so
  we can filter out the columns added by it (it doesn't make sense to present the columns added by a join as options
  for its own LHS) or added by later joins (joins can only depend on things from previous joins). Otherwise you can
  either pass in `nil` or the [[Joinable]] (Table or Card metadata) we're joining against when building a new
  join. (Things other than joins are ignored, but this argument is flexible for consistency with the signature
  of [[join-condition-rhs-columns]].) See #32005 for more info.
  If the left-hand-side column has already been chosen and we're UPDATING it, pass in `lhs-column-or-nil` so we can
  mark the current column as `:selected` in the metadata/display info.
  If the right-hand-side column has already been chosen (they can be chosen in any order in the Query Builder UI),
  pass in the chosen RHS column. In the future, this may be used to restrict results to compatible columns. (See #31174)
  Results will be returned in a 'somewhat smart' order with PKs and FKs returned before other columns.
  Unlike most other things that return columns, implicitly-joinable columns ARE NOT returned here."
  ([query joinable lhs-column-or-nil rhs-column-or-nil]
   (join-condition-lhs-columns query -1 joinable lhs-column-or-nil rhs-column-or-nil))
  ([query              :- ::lib.schema/query
    stage-number       :- :int
    join-or-joinable   :- [:maybe JoinOrJoinable]
    lhs-column-or-nil  :- [:maybe lib.join.util/Field]
    ;; not yet used, hopefully we will use in the future when present for filtering incompatible columns out.
    _rhs-column-or-nil :- [:maybe lib.join.util/Field]]
   ;; calculate all the visible columns including the existing join; then filter out any columns that come from the
   ;; existing join and any subsequent joins. The reason for doing things this way rather than removing the joins
   ;; before calculating visible columns is that we don't want to either create possibly-invalid queries, or have to
   ;; rely on the logic in [[metabase.lib.remove-replace/remove-join]] which would cause circular references; this is
   ;; simpler as well.
   ;;
   ;; e.g. if we have joins [J1 J2 J3 J4] and current join = J2, then we want to ignore the visible columns from J2,
   ;; J3, and J4.
   (let [existing-join-alias    (when (join? join-or-joinable)
                                  (lib.join.util/current-join-alias join-or-joinable))
         join-aliases-to-ignore (into #{}
                                      (comp (map lib.join.util/current-join-alias)
                                            (drop-while #(not= % existing-join-alias)))
                                      (joins query stage-number))
         lhs-column-or-nil      (or lhs-column-or-nil
                                    (when (join? join-or-joinable)
                                      (standard-join-condition-lhs (first (join-conditions join-or-joinable)))))]
     (->> (lib.metadata.calculation/visible-columns query stage-number
                                                    (lib.util/query-stage query stage-number)
                                                    {:include-implicitly-joinable? false})
          (remove (fn [col]
                    (when-let [col-join-alias (lib.join.util/current-join-alias col)]
                      (contains? join-aliases-to-ignore col-join-alias))))
          (mark-selected-column query stage-number lhs-column-or-nil)
          sort-join-condition-columns))))
(mu/defn join-condition-rhs-columns :- [:sequential ::lib.schema.metadata/column]
  "Get a sequence of columns that can be used as the right-hand-side (target column) in a join condition. This column
  is the one that belongs to the thing being joined, `join-or-joinable`, which can be something like a
  Table ([[metabase.lib.metadata/TableMetadata]]), Saved Question/Model ([[metabase.lib.metadata/CardMetadata]]),
  another query, etc. -- anything you can pass to [[join-clause]]. You can also pass in an existing join.
  If the left-hand-side column has already been chosen (they can be chosen in any order in the Query Builder UI),
  pass in the chosen LHS column. In the future, this may be used to restrict results to compatible columns. (See #31174)
  If the right-hand-side column has already been chosen and we're UPDATING it, pass in `rhs-column-or-nil` so we can
  mark the current column as `:selected` in the metadata/display info.
  Results will be returned in a 'somewhat smart' order with PKs and FKs returned before other columns."
  ([query joinable lhs-column-or-nil rhs-column-or-nil]
   (join-condition-rhs-columns query -1 joinable lhs-column-or-nil rhs-column-or-nil))
  ([query              :- ::lib.schema/query
    stage-number       :- :int
    join-or-joinable   :- JoinOrJoinable
    ;; not yet used, hopefully we will use in the future when present for filtering incompatible columns out.
    _lhs-column-or-nil :- [:maybe lib.join.util/Field]
    rhs-column-or-nil  :- [:maybe lib.join.util/Field]]
   ;; I was on the fence about whether these should get `:lib/source :source/joins` or not -- it seems like based on
   ;; the QB UI they shouldn't. See screenshots in #31174
   (let [joinable          (if (join? join-or-joinable)
                             (joined-thing query join-or-joinable)
                             join-or-joinable)
         join-alias        (when (join? join-or-joinable)
                             (lib.join.util/current-join-alias join-or-joinable))
         rhs-column-or-nil (or rhs-column-or-nil
                               (when (join? join-or-joinable)
                                 (standard-join-condition-rhs (first (join-conditions join-or-joinable)))))
         rhs-column-or-nil (when rhs-column-or-nil
                             (cond-> rhs-column-or-nil
                               ;; Drop the :join-alias from the RHS if the joinable doesn't have one either.
                               (not join-alias) (lib.options/update-options dissoc :join-alias)))]
     (->> (lib.metadata.calculation/visible-columns query stage-number joinable {:include-implicitly-joinable? false})
          (map (fn [col]
                 (cond-> (assoc col :lib/source :source/joins)
                   join-alias (with-join-alias join-alias))))
          (mark-selected-column query stage-number rhs-column-or-nil)
          sort-join-condition-columns))))
(mu/defn join-condition-operators :- [:sequential ::lib.schema.filter/operator]
  "Return a sequence of valid filter clause operators that can be used to build a join condition. In the Query Builder
  UI, this can be chosen at any point before or after choosing the LHS and RHS. Invalid options are not currently
  filtered out based on values of the LHS or RHS, but in the future we can add this -- see #31174."
  ([query lhs-column-or-nil rhs-column-or-nil]
   (join-condition-operators query -1 lhs-column-or-nil rhs-column-or-nil))
  ([_query             :- ::lib.schema/query
    _stage-number      :- :int
    ;; not yet used, hopefully we will use in the future when present for filtering incompatible options out.
    _lhs-column-or-nil :- [:maybe ::lib.schema.metadata/column]
    _rhs-column-or-nil :- [:maybe ::lib.schema.metadata/column]]
   ;; currently hardcoded to these six operators regardless of LHS and RHS.
   lib.filter.operator/join-operators))
(mu/defn ^:private fk-columns-to :- [:maybe [:sequential
                                             {:min 1}
                                             [:and
                                              ::lib.schema.metadata/column
                                              [:map
                                               [::target ::lib.schema.metadata/column]]]]]
  "Find FK columns in `source` pointing at a column in `target`. Includes the target column under the `::target` key."
  [query        :- ::lib.schema/query
   stage-number :- :int
   source
   target]
  (let [target-columns (delay
                         (lib.metadata.calculation/visible-columns
                          query stage-number target
                          {:include-implicitly-joinable?                 false
                           :include-implicitly-joinable-for-source-card? false}))]
    (not-empty
     (into []
           (keep (fn [{:keys [fk-target-field-id], :as col}]
                   (when (and (lib.types.isa/foreign-key? col)
                              fk-target-field-id)
                     (when-let [target-column (m/find-first (fn [target-column]
                                                              (= fk-target-field-id
                                                                 (:id target-column)))
                                                            @target-columns)]
                       (assoc col ::target target-column)))))
           (lib.metadata.calculation/visible-columns query stage-number source)))))
(mu/defn suggested-join-conditions :- [:maybe [:sequential {:min 1} ::lib.schema.expression/boolean]] ; i.e., a filter clause
  "Return suggested default join conditions when constructing a join against `joinable`, e.g. a Table, Saved
  Question, or another query. Suggested conditions will be returned if the source Table has a foreign key to the
  primary key of the thing we're joining (see #31175 for more info); otherwise this will return `nil` if no default
  conditions are suggested."
  ([query joinable]
   (suggested-join-conditions query -1 joinable))
  ([query         :- ::lib.schema/query
    stage-number  :- :int
    joinable]
   (let [stage (lib.util/query-stage query stage-number)]
     (letfn [ ;; only keep one FK to each target column e.g. for
             ;;
             ;;    messages (sender_id REFERENCES user(id),  recipient_id REFERENCES user(id))
             ;;
             ;; we only want join on one or the other, not both, because that makes no sense. However with a composite
             ;; FK -> composite PK suggest multiple conditions. See #34184
             (fks [source target]
               (->> (fk-columns-to query stage-number source target)
                    (m/distinct-by #(-> % ::target :id))
                    not-empty))
             (filter-clause [x y]
               ;; DO NOT force broken refs for fields that come from Cards (broken refs in this case means use Field
               ;; ID refs instead of nominal field literal refs), that will break things if a Card returns the same
               ;; Field more than once (there would be no way to disambiguate). See #34227 for more info
               (let [x (dissoc x ::lib.card/force-broken-id-refs)
                     y (dissoc y ::lib.card/force-broken-id-refs)]
                 (lib.filter/filter-clause (lib.filter.operator/operator-def :=) x y)))]
       (or
        ;; find cases where we have FK(s) pointing to joinable. Our column goes on the LHS.
        (when-let [fks (fks stage joinable)]
          (mapv (fn [fk]
                  (filter-clause fk (::target fk)))
                fks))
        ;; find cases where the `joinable` has FK(s) pointing to us. Note our column is the target this time around --
        ;; keep in on the LHS.
        (when-let [fks (fks joinable stage)]
          (mapv (fn [fk]
                  (filter-clause (::target fk) fk))
                fks)))))))
(defn- add-join-alias-to-joinable-columns [cols a-join]
  (let [join-alias     (lib.join.util/current-join-alias a-join)
        unique-name-fn (lib.util/unique-name-generator)]
    (mapv (fn [col]
            (as-> col col
              (with-join-alias col join-alias)
              (add-source-and-desired-aliases a-join unique-name-fn col)))
          cols)))

Mark the column metadatas in cols as :selected if they appear in a-join's :fields.

(defn- mark-selected-joinable-columns
  [cols a-join]
  (let [j-fields (join-fields a-join)]
    (case j-fields
      :all        (mapv #(assoc % :selected? true)
                        cols)
      (:none nil) (mapv #(assoc % :selected? false)
                        cols)
      (lib.equality/mark-selected-columns cols j-fields))))
(mu/defn joinable-columns :- [:sequential ::lib.schema.metadata/column]
  "Return information about the fields that you can pass to [[with-join-fields]] when constructing a join against
  something [[Joinable]] (i.e., a Table or Card) or manipulating an existing join. When passing in a join, currently
  selected columns (those in the join's `:fields`) will include `:selected true` information."
  [query            :- ::lib.schema/query
   stage-number     :- :int
   join-or-joinable :- JoinOrJoinable]
  (let [a-join   (when (join? join-or-joinable)
                   join-or-joinable)
        source (if a-join
                 (joined-thing query join-or-joinable)
                 join-or-joinable)
        cols   (lib.metadata.calculation/returned-columns query stage-number source)]
    (cond-> cols
      a-join (add-join-alias-to-joinable-columns a-join)
      a-join (mark-selected-joinable-columns a-join))))
(defn- join-lhs-display-name-from-condition-lhs
  [query stage-number join-or-joinable condition-lhs-column-or-nil]
  (when-let [condition-lhs-column (or condition-lhs-column-or-nil
                                      (when (join? join-or-joinable)
                                        (standard-join-condition-lhs (first (join-conditions join-or-joinable)))))]
    (let [display-info (lib.metadata.calculation/display-info query stage-number condition-lhs-column)]
      (get-in display-info [:table :display-name]))))

Whether a join-or-joinable is (or will be) the first join in a stage of a query.

If a join is passed, we need to check whether it's the first join in the first stage of a source-table query or not.

New joins get appended after any existing ones, so it would be safe to assume that if there are any other joins in the current stage, this will not be the first join in the stage.

(defn- first-join?
  [query stage-number join-or-joinable]
  (let [existing-joins (joins query stage-number)]
    (or
     ;; if there are no existing joins, then this will be the first join regardless of what is passed in.
     (empty? existing-joins)
     ;; otherwise there ARE existing joins, so this is only the first join if it is the same thing as the first join
     ;; in `existing-joins`.
     (when (join? join-or-joinable)
       (= (:alias join-or-joinable)
          (:alias (first existing-joins)))))))
(defn- join-lhs-display-name-for-first-join-in-first-stage
  [query stage-number join-or-joinable]
  (when (and (zero? (lib.util/canonical-stage-index query stage-number)) ; first stage?
             (first-join? query stage-number join-or-joinable)           ; first join?
             (lib.util/source-table-id query))                           ; query ultimately uses source Table?
    (let [table-id (lib.util/source-table-id query)
          table    (lib.metadata/table query table-id)]
      ;; I think `:default` display name style is okay here, there shouldn't be a difference between `:default` and
      ;; `:long` for a Table anyway
      (lib.metadata.calculation/display-name query stage-number table))))
(mu/defn join-lhs-display-name :- ::lib.schema.common/non-blank-string
  "Get the display name for whatever we are joining. See #32015 and #32764 for screenshot examples.
  The rules, copied from MLv1, are as follows:
  1. If we have the LHS column for the first join condition, we should use display name for wherever it comes from. E.g.
     if the join is
     ```
     JOIN whatever ON orders.whatever_id = whatever.id
     ```
     then we should display the join like this:
    ```
    +--------+   +----------+    +-------------+    +----------+
    | Orders | + | Whatever | on | Orders      | =  | Whatever |
    |        |   |          |    | Whatever ID |    | ID       |
    +--------+   +----------+    +-------------+    +----------+
    ```
    1a. If `join-or-joinable` is a join, we can take the condition LHS column from the join itself, since a join will
        always have a condition. This should only apply to [[standard-join-condition?]] conditions.
    1b. When building a join, you can optionally pass in `condition-lhs-column-or-nil` yourself.
  2. If the condition LHS column is unknown, and this is the first join in the first stage of a query, and the query
     uses a `:source-table`, then use the display name for the source Table.
  3. Otherwise use `Previous results`.
  This function needs to be usable while we are in the process of constructing a join in the context of a given stage,
  but also needs to work for rendering existing joins. Pass a join in for existing joins, or something [[Joinable]]
  for ones we are currently building."
  ([query join-or-joinable]
   (join-lhs-display-name query join-or-joinable nil))
  ([query join-or-joinable condition-lhs-column-or-nil]
   (join-lhs-display-name query -1 join-or-joinable condition-lhs-column-or-nil))
  ([query                       :- ::lib.schema/query
    stage-number                :- :int
    join-or-joinable            :- [:maybe JoinOrJoinable]
    condition-lhs-column-or-nil :- [:maybe [:or ::lib.schema.metadata/column :mbql.clause/field]]]
   (or
    (join-lhs-display-name-from-condition-lhs query stage-number join-or-joinable condition-lhs-column-or-nil)
    (join-lhs-display-name-for-first-join-in-first-stage query stage-number join-or-joinable)
    (i18n/tru "Previous results"))))
(mu/defn join-condition-update-temporal-bucketing :- ::lib.schema.expression/boolean
  "Updates the provided join-condition's fields' temporal-bucketing option, returns the updated join-condition.
   Must be called on a standard join condition as per [[standard-join-condition?]].
   This will sync both the lhs and rhs fields, and the fields that support the provided option will be updated.
   Fields that do not support the provided option will be ignored."
  ([query :- ::lib.schema/query
    join-condition :- [:or ::lib.schema.expression/boolean ::lib.schema.common/external-op]
    option-or-unit :- [:maybe [:or
                               ::lib.schema.temporal-bucketing/option
                               ::lib.schema.temporal-bucketing/unit]]]
   (join-condition-update-temporal-bucketing query -1 join-condition option-or-unit))
  ([query :- ::lib.schema/query
    stage-number :- :int
    join-condition :- [:or ::lib.schema.expression/boolean ::lib.schema.common/external-op]
    option-or-unit :- [:maybe [:or
                               ::lib.schema.temporal-bucketing/option
                               ::lib.schema.temporal-bucketing/unit]]]
   (let [[_ _ lhs rhs :as join-condition] (lib.common/->op-arg join-condition)]
     (assert (standard-join-condition? join-condition)
             (i18n/tru "Non-standard join condition. {0}" (pr-str join-condition)))
     (let [unit (cond-> option-or-unit
                  (not (keyword? option-or-unit)) :unit)
           stage-number (lib.util/canonical-stage-index query stage-number)
           available-lhs (lib.temporal-bucket/available-temporal-buckets query stage-number lhs)
           available-rhs (lib.temporal-bucket/available-temporal-buckets query stage-number rhs)
           sync-lhs? (or (nil? unit) (contains? (set (map :unit available-lhs)) unit))
           sync-rhs? (or (nil? unit) (contains? (set (map :unit available-rhs)) unit))]
       (cond-> join-condition
         sync-lhs? (update 2 lib.temporal-bucket/with-temporal-bucket unit)
         sync-rhs? (update 3 lib.temporal-bucket/with-temporal-bucket unit))))))
(defmethod lib.metadata.calculation/describe-top-level-key-method :joins
  [query stage-number _key]
  (some->> (not-empty (joins query stage-number))
           (map #(lib.metadata.calculation/display-name query stage-number %))
           (str/join " + " )))
 

Some small join-related helper functions which are used from a few different namespaces.

(ns metabase.lib.join.util
  (:require
   [metabase.lib.dispatch :as lib.dispatch]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.options :as lib.options]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.join :as lib.schema.join]
   [metabase.lib.util :as lib.util]
   [metabase.util.malli :as mu]))

A Join that may not yet have an :alias, which is normally required; [[join]] accepts this and will add a default alias if one is not present.

(def JoinWithOptionalAlias
  [:merge
   [:ref ::lib.schema.join/join]
   [:map
    [:alias {:optional true} [:ref ::lib.schema.join/alias]]]])

A join that may not yet have an :alias or :conditions.

(def PartialJoin
  [:merge
   JoinWithOptionalAlias
   [:map
    [:conditions {:optional true} [:ref ::lib.schema.join/conditions]]]])

A field in a join, either [[lib.metadata/ColumnMetadata]] or a :field ref.

(def Field
  [:or
   lib.metadata/ColumnMetadata
   [:ref :mbql.clause/field]])

A field or a partial join.

(def FieldOrPartialJoin
  [:or Field PartialJoin])
(mu/defn current-join-alias :- [:maybe ::lib.schema.common/non-blank-string]
  "Get the current join alias associated with something, if it has one."
  [field-or-join :- [:maybe FieldOrPartialJoin]]
  (case (lib.dispatch/dispatch-value field-or-join)
    :dispatch-type/nil nil
    :field             (:join-alias (lib.options/options field-or-join))
    :metadata/column   (:metabase.lib.join/join-alias field-or-join)
    :mbql/join         (:alias field-or-join)))
(mu/defn joined-field-desired-alias :- ::lib.schema.common/non-blank-string
  "Desired alias for a Field that comes from a join, e.g.
    MyJoin__my_field
  You should pass the results thru a unique name function."
  [join-alias :- ::lib.schema.common/non-blank-string
   field-name :- ::lib.schema.common/non-blank-string]
  (lib.util/format "%s__%s" join-alias field-name))
(mu/defn format-implicit-join-name :- ::lib.schema.common/non-blank-string
  "Name for an implicit join against `table-name` via an FK field, e.g.
    CATEGORIES__via__CATEGORY_ID
  You should make sure this gets ran thru a unique-name fn."
  [table-name           :- ::lib.schema.common/non-blank-string
   source-field-id-name :- ::lib.schema.common/non-blank-string]
  (lib.util/format "%s__via__%s" table-name source-field-id-name))
(defn- implicit-join-name [query {:keys [fk-field-id table-id], :as _field-metadata}]
  (when (and fk-field-id table-id)
    (when-let [table (lib.metadata/table-or-card query table-id)]
      (let [table-name           (:name table)
            source-field-id-name (:name (lib.metadata/field query fk-field-id))]
        (format-implicit-join-name table-name source-field-id-name)))))
(mu/defn desired-alias :- ::lib.schema.common/non-blank-string
  "Desired alias for a Field e.g.
    my_field
    OR
    MyJoin__my_field
  You should pass the results thru a unique name function."
  [query          :- ::lib.schema/query
   field-metadata :- lib.metadata/ColumnMetadata]
  (if-let [join-alias (or (current-join-alias field-metadata)
                          (implicit-join-name query field-metadata))]
    (joined-field-desired-alias join-alias (:name field-metadata))
    (:name field-metadata)))
 

JavaScript-friendly interface to the entire Metabase lib? This stuff will probably change a bit as MLv2 evolves.

Note that in JS we've made the decision to make the stage number always be required as an explicit parameter, so we DO NOT need to expose the stage-index = -1 arities of functions below. Generally we probably only need to export one arity... see TypeScript wrappers for actual usage.

(ns metabase.lib.js
  (:refer-clojure
   :exclude
   [filter])
  (:require
   [clojure.string :as str]
   [clojure.walk :as walk]
   [goog.object :as gobject]
   [medley.core :as m]
   [metabase.lib.cache :as lib.cache]
   [metabase.lib.convert :as lib.convert]
   [metabase.lib.core :as lib.core]
   [metabase.lib.equality :as lib.equality]
   [metabase.lib.field :as lib.field]
   [metabase.lib.join :as lib.join]
   [metabase.lib.js.metadata :as js.metadata]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.lib.order-by :as lib.order-by]
   [metabase.lib.stage :as lib.stage]
   [metabase.lib.util :as lib.util]
   [metabase.mbql.js :as mbql.js]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.shared.util.time :as shared.ut]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.memoize :as memoize]))

this is mostly to ensure all the relevant namespaces with multimethods impls get loaded.

(comment lib.core/keep-me)
(defn- remove-undefined-properties
  [obj]
  (cond-> obj
    (object? obj) (gobject/filter (fn [e _ _] (not (undefined? e))))))
(defn- convert-js-template-tags [tags]
  (-> tags
      (gobject/map (fn [e _ _]
                     (remove-undefined-properties e)))
      js->clj
      (update-vals #(-> %
                        (update-keys keyword)
                        (update :type keyword)))))

Extract the template tags from a native query's text.

If the optional map of existing tags previously parsed is given, this will reuse the existing tags where they match up with the new one (in particular, it will preserve the UUIDs).

Given the text of a native query, extract a possibly-empty set of template tag strings from it.

These look like mustache templates. For variables, we only allow alphanumeric characters, eg. {{foo}}. For snippets they start with snippet:, eg. {{ snippet: arbitrary text here }}. And for card references either {{ #123 }} or with the optional human label {{ #123-card-title-slug }}.

Invalid patterns are simply ignored, so something like {{&foo!}} is just disregarded.

(defn ^:export extract-template-tags
  ([query-text] (extract-template-tags query-text {}))
  ([query-text existing-tags]
   (->> (convert-js-template-tags existing-tags)
        (lib.core/extract-template-tags query-text)
        clj->js)))

Return a nice description of a query.

(defn ^:export suggestedName
  [query]
  (lib.core/suggested-name query))

Convert metadata to a metadata provider if it is not one already.

(defn ^:export metadataProvider
  [database-id metadata]
  (if (lib.metadata.protocols/metadata-provider? metadata)
    metadata
    (js.metadata/metadata-provider database-id metadata)))

Coerce a plain map query to an actual query object that you can use with MLv2.

(defn ^:export query
  ([metadata-provider table-or-card-metadata]
   (lib.core/query metadata-provider table-or-card-metadata))
  ([database-id metadata query-map]
   (let [query-map (lib.convert/js-legacy-query->pMBQL query-map)]
     (log/debugf "query map: %s" (pr-str query-map))
     (lib.core/query (metadataProvider database-id metadata) query-map))))

This converts namespaced keywords to strings as "foo/bar".

clj->js supports overriding how keyword map keys get transformed, but it doesn't let you override how values are handled. So this function runs first and turns them into strings.

As an example of such a value, (get-in card [:template-tags "some-tag" :widget-type]) can be :date/all-options.

(defn- fix-namespaced-values
  [x]
  (cond
    (qualified-keyword? x) (str (namespace x) "/" (name x))
    (map? x)               (update-vals x fix-namespaced-values)
    (sequential? x)        (map fix-namespaced-values x)
    :else                  x))

Coerce a CLJS pMBQL query back to (1) a legacy query (2) in vanilla JS.

(defn ^:export legacy-query
  [query-map]
  (-> query-map lib.convert/->legacy-MBQL fix-namespaced-values (clj->js :keyword-fn u/qualified-name)))

Adds a new blank stage to the end of the pipeline

(defn ^:export append-stage
  [a-query]
  (lib.core/append-stage a-query))

Drops the final stage in the pipeline, will no-op if it is the only stage

(defn ^:export drop-stage
  [a-query]
  (lib.core/drop-stage a-query))

Drops the final stage in the pipeline IF the stage is empty of clauses, otherwise no-op

(defn ^:export drop-stage-if-empty
  [a-query]
  (lib.core/drop-stage-if-empty a-query))

Return a sequence of Column metadatas about the columns you can add order bys for in a given stage of a-query. To add an order by, pass the result to [[order-by]].

(defn ^:export orderable-columns
  [a-query stage-number]
  (to-array (lib.order-by/orderable-columns a-query stage-number)))

Display-info ===================================================================================================== This is a complicated stack of caches and inner functions, so some guidance is in order.

The outer surface is lib.js/display-info in this file. It has a [[lib.cache/side-channel-cache]], so if display-info is called multiple times on the same opaque CLJS value, it will be cached.

[[display-info*]] is the inner implementation. It calls [[lib.core/display-info]] to get the CLJS form, then [[display-info->js]] to convert it to JS.

JS conversion in the tricky cases (maps and seqs) are handled by separate, LRU-cached functions [[display-info-map->js]] and [[display-info-seq->js]]. Keywords are converted with [[u/qualified-name]].

[[display-info-map->js]] converts CLJS maps to JS objects. Keys are converted from :kebab-case-keywords to "camelCaseStrings". Values are recursively converted by [[display-info->js]]. (Note that this passes through the LRU caches for nested maps and seqs - this is important since many inner pieces are reused across eg. columns.)

[[display-info-seq->js]] converts CLJS sequential? things to JS arrays, recursively calling [[display-info->js]] on each element. (This is cached just like map values above.)

Note: there's an important property here that's worth calling out explicitly. It's possible for visible-columns on two different queries to return columns which are =. Since the different queries might cause different display names or other values to be generated for those = columns, it's vital that the caching of display-info is per-query. These side-channel caches attached to individual column instances are implicitly per-query (since visible-columns always generates new ones even for the same query) so they work here. In contrast, the CLJS -> JS conversion doesn't know about queries, so it can use =-based LRU caches.

(declare ^:private display-info->js)
(defn- cljs-key->js-key [cljs-key]
  (let [key-str (u/qualified-name cljs-key)
        ;; if the key is something like `many-pks?` convert it to something that is more JS-friendly (remove the
        ;; question mark), `:is-many-pks`, which becomes `isManyPks`
        key-str (if (str/ends-with? key-str "?")
                  (str "is-" (str/replace key-str #"\?$" ))
                  key-str)]
    (u/->camelCaseEn key-str)))
(defn- display-info-map->js* [x]
  (reduce (fn [obj [cljs-key cljs-val]]
            (let [js-key (cljs-key->js-key cljs-key)
                  js-val (display-info->js cljs-val)] ;; Recursing through the cache
              (gobject/set obj js-key js-val)
              obj))
          #js {}
          x))
(def ^:private display-info-map->js
  (memoize/lru display-info-map->js* :lru/threshold 256))
(defn- display-info-seq->js* [x]
  (to-array (map display-info->js x)))
(def ^:private display-info-seq->js
  (memoize/lru display-info-seq->js* :lru/threshold 256))

Converts CLJS [[lib.core/display-info]] results into JS objects for the FE to consume. Recursively converts CLJS maps and sequential? things likewise.

(defn- display-info->js
  [x]
  (cond
    ;; Note that map? is only true for CLJS maps, not JS objects.
    (map? x)        (display-info-map->js x)
    ;; Likewise, JS arrays are not sequential? while CLJS vectors, seqs and sets are.
    (sequential? x) (display-info-seq->js x)
    (keyword? x)    (u/qualified-name x)
    :else           x))
(defn- display-info* [a-query stage-number x]
  (-> a-query
      (lib.stage/ensure-previous-stages-have-metadata stage-number)
      (lib.core/display-info stage-number x)
      display-info->js))

Given an opaque CLJS object, return a plain JS object with info you'd need to implement UI for it. See :metabase.lib.metadata.calculation/display-info for the keys this might contain. Note that the JS versions of the keys are converted to the equivalent camelCase strings from the original :kebab-case.

(defn ^:export display-info
  ;; See the big comment above about how `display-info` fits together.
  [a-query stage-number x]
  ;; Attaches a cached display-info blob to `x`, in case it gets called again for the same object.
  ;; TODO: Keying by stage is probably unnecessary - if we eg. fetched a column from different stages, it would be a
  ;; different object. Test that idea and remove the stage from the cache key.
  (lib.cache/side-channel-cache
    (keyword "display-info-outer" (str "stage-" stage-number)) x
    #(display-info* a-query stage-number %)))

Find the field id for something or nil.

(defn ^:export field-id
  [field-metadata]
  (lib.core/field-id field-metadata))

Find the legacy card id or table id for a given ColumnMetadata or nil. Returns a either "card__<id>" or integer table id.

(defn ^:export legacy-card-or-table-id
  [field-metadata]
  (lib.core/legacy-card-or-table-id field-metadata))

Create an order-by clause independently of a query, e.g. for replace or whatever.

(defn ^:export order-by-clause
  ([orderable]
   (order-by-clause orderable :asc))
  ([orderable direction]
   (lib.core/order-by-clause (lib.core/normalize (js->clj orderable :keywordize-keys true)) (keyword direction))))

Add an order-by clause to a-query. Returns updated query.

(defn ^:export order-by
  [a-query stage-number orderable direction]
  (lib.core/order-by a-query stage-number orderable (keyword direction)))

Get the order-by clauses (as an array of opaque objects) in a-query at a given stage-number. Returns an empty array if there are no order bys in the query.

(defn ^:export order-bys
  [a-query stage-number]
  (to-array (lib.core/order-bys a-query stage-number)))

Flip the direction of current-order-by in a-query.

(defn ^:export change-direction
  [a-query current-order-by]
  (lib.core/change-direction a-query current-order-by))

Return an array of Column metadatas about the columns that can be broken out by in a given stage of a-query. To break out by a given column, the corresponding element of the result has to be added to the query using [[breakout]].

(defn ^:export breakoutable-columns
  [a-query stage-number]
  (to-array (lib.core/breakoutable-columns a-query stage-number)))

Get the breakout clauses (as an array of opaque objects) in a-query at a given stage-number. Returns an empty array if there are no order bys in the query.

(defn ^:export breakouts
  [a-query stage-number]
  (to-array (lib.core/breakouts a-query stage-number)))

Add an order-by clause to a-query. Returns updated query.

(defn ^:export breakout
  [a-query stage-number x]
  (lib.core/breakout a-query stage-number (lib.core/ref x)))

Retrieve the current binning state of a :field clause, field metadata, etc. as an opaque object, or nil if it does not have binning options set.

(defn ^:export binning
  [x]
  (lib.core/binning x))

Given x (a field reference) and a binning value, return a new :field clause with its :binning options set.

If binning is nil, removes any :binning options currently present.

binning can be one of the opaque values returned by [[available-binning-strategies]], or a literal [[metabase.lib.schema.binning/binning]] value.

(defn ^:export with-binning
  [x binning-option]
  (lib.core/with-binning x binning-option))

Get a list of available binning strategies for x (a field reference, generally) in the context of a-query and optionally stage-number. The returned list contains opaque objects which should be passed to [[display-info]].

(defn ^:export available-binning-strategies
  ([a-query x]
   (-> (lib.core/available-binning-strategies a-query x)
       to-array))
  ([a-query stage-number x]
   (-> (lib.core/available-binning-strategies a-query stage-number x)
       to-array)))

Get the current temporal bucketing options associated with something, if any.

(defn ^:export temporal-bucket
  [x]
  (lib.core/temporal-bucket x))

Add a temporal bucketing option to an MBQL clause (or something that can be converted to an MBQL clause).

(defn ^:export with-temporal-bucket
  [x bucketing-option]
  (lib.core/with-temporal-bucket x bucketing-option))

Get a list of available temporal bucketing options for x (a field reference, generally) in the context of a-query and optionally stage-number. The returned list contains opaque objects which should be passed to [[display-info]].

(defn ^:export available-temporal-buckets
  ([a-query x]
   (-> (lib.core/available-temporal-buckets a-query x)
       to-array))
  ([a-query stage-number x]
   (-> (lib.core/available-temporal-buckets a-query stage-number x)
       to-array)))

Removes the target-clause in the filter of the query.

(defn ^:export remove-clause
  [a-query stage-number clause]
  (lib.core/remove-clause
   a-query stage-number
   (lib.core/normalize (js->clj clause :keywordize-keys true))))

Replaces the target-clause with new-clause in the query stage.

(defn ^:export replace-clause
  [a-query stage-number target-clause new-clause]
  (lib.core/replace-clause
   a-query stage-number
   (lib.core/normalize (js->clj target-clause :keywordize-keys true))
   (lib.core/normalize (js->clj new-clause :keywordize-keys true))))
(defn- prep-query-for-equals [a-query field-ids]
  (-> a-query
      mbql.js/normalize-cljs
      ;; If `:native` exists, but it doesn't have `:template-tags`, add it.
      (m/update-existing :native #(merge {:template-tags {}} %))
      (m/update-existing :query (fn [inner-query]
                                  (let [fields (or (:fields inner-query)
                                                   (for [id field-ids]
                                                     [:field id nil]))]
                                    ;; We ignore the order of the fields in the lists, but need to make sure any dupes
                                    ;; match up. Therefore de-dupe with `frequencies` rather than simply `set`.
                                    (assoc inner-query :fields (frequencies fields)))))))

Returns whether the provided queries should be considered equal.

If field-ids is specified, an input MBQL query without :fields set defaults to the field-ids.

Currently this works only for legacy queries in JS form! It duplicates the logic formerly found in query_builder/selectors.js.

TODO: This should evolve into a more robust, pMBQL-based sense of equality over time. For now it pulls logic that touches query internals into metabase.lib.

(defn ^:export query=
  ([query1 query2] (query= query1 query2 nil))
  ([query1 query2 field-ids]
   (let [n1 (prep-query-for-equals query1 field-ids)
         n2 (prep-query-for-equals query2 field-ids)]
     (= n1 n2))))

Given a group of columns returned by a function like [[metabase.lib.js/orderable-columns]], group the columns by Table or equivalent (e.g. Saved Question) so that they're in an appropriate shape for showing in the Query Builder. e.g a sequence of columns like

[venues.id venues.name venues.category-id ;; implicitly joinable categories.id categories.name]

would get grouped into groups like

[{::columns [venues.id venues.name venues.category-id]} {::columns [categories.id categories.name]}]

Groups have the type :metadata/column-group and can be passed directly to [[metabase.lib.js/display-info]]. Use [[metabase.lib.js/columns-group-columns]] to extract the columns from a group.

(defn ^:export group-columns
  [column-metadatas]
  (to-array (lib.core/group-columns column-metadatas)))

Get the columns associated with a column group

(defn ^:export columns-group-columns
  [column-group]
  (to-array (lib.core/columns-group-columns column-group)))

Get a translated description of a temporal bucketing unit.

(defn ^:export describe-temporal-unit
  [n unit]
  (let [unit (if (string? unit) (keyword unit) unit)]
    (lib.core/describe-temporal-unit n unit)))

Get a translated description of a temporal bucketing interval.

(defn ^:export describe-temporal-interval
  [n unit]
  (let [n    (if (string? n) (keyword n) n)
        unit (if (string? unit) (keyword unit) unit)]
    (lib.core/describe-temporal-interval n unit)))

Get a translated description of a relative datetime interval.

(defn ^:export describe-relative-datetime
  [n unit]
  (let [n    (if (string? n) (keyword n) n)
        unit (if (string? unit) (keyword unit) unit)]
    (lib.core/describe-relative-datetime n unit)))

Adds an aggregation to query.

(defn ^:export aggregate
  [a-query stage-number an-aggregate-clause]
  (lib.core/aggregate a-query stage-number (js->clj an-aggregate-clause :keywordize-keys true)))

Get the aggregations in a given stage of a query.

(defn ^:export aggregations
  [a-query stage-number]
  (to-array (lib.core/aggregations a-query stage-number)))

Returns a standalone aggregation clause for an aggregation-operator and a column. For aggregations requiring an argument column is mandatory, otherwise it is optional.

(defn ^:export aggregation-clause
  ([aggregation-operator]
   (lib.core/aggregation-clause aggregation-operator))
  ([aggregation-operator column]
   (lib.core/aggregation-clause aggregation-operator column)))

Get the available aggregation operators for the stage with stage-number of the query a-query. If stage-number is omitted, the last stage is used.

(defn ^:export available-aggregation-operators
  [a-query stage-number]
  (to-array (lib.core/available-aggregation-operators a-query stage-number)))

Get the columns aggregation-operator can be applied to. The columns are valid for the stage of the query that was used in [[available-binning-strategies]] to get available-aggregation.

(defn ^:export aggregation-operator-columns
  [aggregation-operator]
  (to-array (lib.core/aggregation-operator-columns aggregation-operator)))

Mark the operator and the column (if any) in agg-operators selected by agg-clause.

(defn ^:export selected-aggregation-operators
  [agg-operators agg-clause]
  (to-array (lib.core/selected-aggregation-operators (seq agg-operators) agg-clause)))

Get the available filterable columns for the stage with stage-number of the query a-query.

(defn ^:export filterable-columns
  [a-query stage-number]
  (to-array (lib.core/filterable-columns a-query stage-number)))

Returns the operators for which filterable-column is applicable.

(defn ^:export filterable-column-operators
  [filterable-column]
  (to-array (lib.core/filterable-column-operators filterable-column)))

Returns a standalone filter clause for a filter-operator, a column, and arguments.

(defn ^:export filter-clause
  [filter-operator column & args]
  (apply lib.core/filter-clause filter-operator column args))

Returns the filter operator of filter-clause.

(defn ^:export filter-operator
  [a-query stage-number a-filter-clause]
  (lib.core/filter-operator a-query stage-number a-filter-clause))

Returns a standalone clause for an operator, options, and arguments.

(defn ^:export expression-clause
  [an-operator args options]
  (-> (lib.core/expression-clause
        (keyword an-operator)
        args
        (js->clj options :keywordize-keys true))
      (lib.core/normalize)))

Returns the parts (operator, args, and optionally, options) of expression-clause.

(defn ^:export expression-parts
  [a-query stage-number an-expression-clause]
  (let [parts (lib.core/expression-parts a-query stage-number an-expression-clause)]
    (walk/postwalk
     (fn [node]
       (if (and (map? node) (= :mbql/expression-parts (:lib/type node)))
         (let [{:keys [operator options args]} node]
           #js {:operator (name operator)
                :options (clj->js (select-keys options [:case-sensitive :include-current]))
                :args (to-array (map #(if (keyword? %) (u/qualified-name %) %) args))})
         node))
     parts)))

Returns true if arg is a a ColumnMetadata

(defn ^:export is-column-metadata
  [arg]
  (and (map? arg) (= :metadata/column (:lib/type arg))))

Sets boolean-expression as a filter on query.

(defn ^:export filter
  [a-query stage-number boolean-expression]
  (lib.core/filter a-query stage-number (js->clj boolean-expression :keywordize-keys true)))

Returns the current filters in stage with stage-number of query. Logicaly, the filter attached to the query is the conjunction of the expressions in the returned list. If the returned list is empty, then there is no filter attached to the query.

(defn ^:export filters
  [a-query stage-number]
  (to-array (lib.core/filters a-query stage-number)))

Return the filter clause in a-query at stage stage-number matching the legacy filter clause legacy-filter, if any.

(defn ^:export find-filter-for-legacy-filter
  [a-query stage-number legacy-filter]
  (->> (js->clj legacy-filter :keywordize-keys true)
       (lib.core/find-filter-for-legacy-filter a-query stage-number)))

Given a legacy :field reference, return the filterable [[ColumnWithOperators]] that best fits it.

(defn ^:export find-filterable-column-for-legacy-ref
  [a-query stage-number a-legacy-ref]
  ;; [[lib.convert/legacy-ref->pMBQL]] will handle JS -> Clj conversion as needed
  (lib.core/find-filterable-column-for-legacy-ref a-query stage-number a-legacy-ref))

Get the current :fields in a query. Unlike the lib core version, this will return an empty sequence if :fields is not specified rather than nil for JS-friendliness.

(defn ^:export fields
  [a-query stage-number]
  (to-array (lib.core/fields a-query stage-number)))

Specify the :fields for a query. Pass an empty sequence or nil to remove :fields.

(defn ^:export with-fields
  [a-query stage-number new-fields]
  (lib.core/with-fields a-query stage-number new-fields))

Return a sequence of column metadatas for columns that you can specify in the :fields of a query.

(defn ^:export fieldable-columns
  [a-query stage-number]
  (to-array (lib.core/fieldable-columns a-query stage-number)))

Adds a given field (ColumnMetadata, as returned from eg. [[visible-columns]]) to the fields returned by the query. Exactly what this means depends on the source of the field: - Source table/card, previous stage of the query, aggregation or breakout: - Add it to the :fields list - If :fields is missing, it's implicitly :all, so do nothing. - Implicit join: add it to the :fields list; query processor will do the right thing with it. - Explicit join: add it to that join's :fields list. - Custom expression: Do nothing - expressions are always included.

(defn ^:export add-field
  [a-query stage-number column]
  (lib.core/add-field a-query stage-number column))

Removes the field (a ColumnMetadata, as returned from eg. [[visible-columns]]) from those fields returned by the query. Exactly what this means depends on the source of the field: - Source table/card, previous stage, aggregations or breakouts: - If :fields is missing, it's implicitly :all - populate it with all the columns except the removed one. - Remove the target column from the :fields list - Implicit join: remove it from the :fields list; do nothing if it's not there. - (An implicit join only exists in the :fields clause, so if it's not there then it's not anywhere.) - Explicit join: remove it from that join's :fields list (handle :fields :all like for source tables). - Custom expression: Throw! Custom expressions are always returned. To remove a custom expression, the expression itself should be removed from the query.

(defn ^:export remove-field
  [a-query stage-number column]
  (lib.core/remove-field a-query stage-number column))

Like [[find-visible-column-for-ref]], but takes a legacy MBQL reference instead of a pMBQL one. This is currently only meant for use with :field clauses.

(defn ^:export find-visible-column-for-legacy-ref
  [a-query stage-number a-legacy-ref]
  ;; [[lib.convert/legacy-ref->pMBQL]] will handle JS -> Clj conversion as needed
  (lib.core/find-visible-column-for-legacy-ref a-query stage-number a-legacy-ref))

Given a sequence of columns (column metadatas), return the one that is the best fit for legacy-ref.

(defn ^:export find-column-for-legacy-ref
  [a-query stage-number a-legacy-ref columns]
  ;; [[lib.convert/legacy-ref->pMBQL]] will handle JS -> Clj conversion as needed
  (lib.core/find-column-for-legacy-ref a-query stage-number a-legacy-ref columns))

Return a sequence of column metadatas for columns visible at the given stage of the query.

Does not pass any options to [[visible-columns]], so it uses the defaults.

TODO: Added as an expedient to fix metabase/metabase#32373. Due to the interaction with viz-settings, this issue was difficult to fix entirely within MLv2. Once viz-settings are ported, this function should not be needed, and the FE logic using it should be ported to MLv2 behind more meaningful names.

(defn ^:export visible-columns
  [a-query stage-number]
  (let [stage          (lib.util/query-stage a-query stage-number)
        vis-columns    (lib.metadata.calculation/visible-columns a-query stage-number stage)
        ret-columns    (lib.metadata.calculation/returned-columns a-query stage-number stage)]
    (to-array (lib.equality/mark-selected-columns a-query stage-number vis-columns ret-columns))))

Return a sequence of column metadatas for columns returned by the query.

(defn ^:export returned-columns
  [a-query stage-number]
  (let [stage (lib.util/query-stage a-query stage-number)]
    (->> (lib.metadata.calculation/returned-columns a-query stage-number stage)
         (map #(assoc % :selected? true))
         to-array)))
(defn- normalize-legacy-ref
  [a-ref]
  (if (#{:metric :segment} (first a-ref))
    (subvec a-ref 0 2)
    (update a-ref 2 update-vals #(if (qualified-keyword? %)
                                   (u/qualified-name %)
                                   %))))

Given a column, metric or segment metadata from eg. [[fieldable-columns]] or [[available-segments]], return it as a legacy JSON field ref. For compatibility reasons, segment and metric references are always returned without options.

(defn ^:export legacy-ref
  [column]
  (-> column
      lib.core/ref
      lib.convert/->legacy-MBQL
      normalize-legacy-ref
      clj->js))
(defn- legacy-ref->pMBQL [a-legacy-ref]
  (-> a-legacy-ref
      (js->clj :keywordize-keys true)
      (update 0 keyword)
      lib.convert/->pMBQL))
(defn- ->column-or-ref [column]
  (if-let [^js legacy-column (when (object? column) column)]
    ;; Convert legacy columns like we do for metadata.
    (let [parsed (js.metadata/parse-column legacy-column)]
      (if (= (:lib/source parsed) :source/aggregations)
        ;; Special case: Aggregations need to be converted to a pMBQL :aggregation ref and :lib/source-uuid set.
        (let [agg-ref (legacy-ref->pMBQL (.-field_ref legacy-column))]
          (assoc parsed :lib/source-uuid (last agg-ref)))
        parsed))
    ;; It's already a :metadata/column map
    column))

Given a list of columns (either JS data.cols or MLv2 ColumnMetadata) and a list of legacy refs, find each ref's corresponding index into the list of columns.

Returns a parallel list to the refs, with the corresponding index, or -1 if no matching column is found.

(defn ^:export find-column-indexes-from-legacy-refs
  [a-query stage-number legacy-columns legacy-refs]
  ;; Set up this query stage's `:aggregation` list as the context for [[lib.convert/->pMBQL]] to convert legacy
  ;; `[:aggregation 0]` refs into pMBQL `[:aggregation uuid]` refs.
  (lib.convert/with-aggregation-list (:aggregation (lib.util/query-stage a-query stage-number))
    (let [haystack (mapv ->column-or-ref legacy-columns)
          needles  (map legacy-ref->pMBQL legacy-refs)]
      #_{:clj-kondo/ignore [:discouraged-var]}
      (to-array (lib.equality/find-column-indexes-for-refs a-query stage-number needles haystack)))))

Returns the ID of the source table (as a number) or the ID of the source card (as a string prefixed with "card__") of a-query. If a-query has none of these, nil is returned.

(defn ^:export source-table-or-card-id
  [a-query]
  (or (lib.util/source-table-id a-query)
      (some->> (lib.util/source-card-id a-query) (str "card__"))))

Get the strategy (type) of a given join as an opaque JoinStrategy object.

(defn ^:export join-strategy
  [a-join]
  (lib.core/join-strategy a-join))

Return a copy of a-join with its :strategy set to an opaque JoinStrategy.

(defn ^:export with-join-strategy
  [a-join strategy]
  (lib.core/with-join-strategy a-join strategy))

Get available join strategies for the current Database (based on the Database's supported [[metabase.driver/driver-features]]) as opaque JoinStrategy objects.

(defn ^:export available-join-strategies
  [a-query stage-number]
  (to-array (lib.core/available-join-strategies a-query stage-number)))

Get a sequence of columns that can be used as the left-hand-side (source column) in a join condition. This column is the one that comes from the source Table/Card/previous stage of the query or a previous join.

If you are changing the LHS of a condition for an existing join, pass in that existing join as join-or-joinable so we can filter out the columns added by it (it doesn't make sense to present the columns added by a join as options for its own LHS) or added by later joins (joins can only depend on things from previous joins). Otherwise you can either pass in nil or something joinable (Table or Card metadata) we're joining against when building a new join. (Things other than joins are ignored, but this argument is flexible for consistency with the signature of [[join-condition-rhs-columns]].) See #32005 for more info.

If the left-hand-side column has already been chosen and we're UPDATING it, pass in lhs-column-or-nil so we can mark the current column as :selected in the metadata/display info.

If the right-hand-side column has already been chosen (they can be chosen in any order in the Query Builder UI), pass in the chosen RHS column. In the future, this may be used to restrict results to compatible columns. (See #31174)

Results will be returned in a 'somewhat smart' order with PKs and FKs returned before other columns.

Unlike most other things that return columns, implicitly-joinable columns ARE NOT returned here.

(defn ^:export join-condition-lhs-columns
  [a-query stage-number join-or-joinable lhs-column-or-nil rhs-column-or-nil]
  (to-array (lib.core/join-condition-lhs-columns a-query stage-number join-or-joinable lhs-column-or-nil rhs-column-or-nil)))

Get a sequence of columns that can be used as the right-hand-side (target column) in a join condition. This column is the one that belongs to the thing being joined, join-or-joinable, which can be something like a Table ([[metabase.lib.metadata/TableMetadata]]), Saved Question/Model ([[metabase.lib.metadata/CardMetadata]]), another query, etc. -- anything you can pass to [[join-clause]]. You can also pass in an existing join.

If the left-hand-side column has already been chosen (they can be chosen in any order in the Query Builder UI), pass in the chosen LHS column. In the future, this may be used to restrict results to compatible columns. (See #31174)

If the right-hand-side column has already been chosen and we're UPDATING it, pass in rhs-column-or-nil so we can mark the current column as :selected in the metadata/display info.

Results will be returned in a 'somewhat smart' order with PKs and FKs returned before other columns.

(defn ^:export join-condition-rhs-columns
  [a-query stage-number join-or-joinable lhs-column-or-nil rhs-column-or-nil]
  (to-array (lib.core/join-condition-rhs-columns a-query stage-number join-or-joinable lhs-column-or-nil rhs-column-or-nil)))

Return a sequence of valid filter clause operators that can be used to build a join condition. In the Query Builder UI, this can be chosen at any point before or after choosing the LHS and RHS. Invalid options are not currently filtered out based on values of the LHS or RHS, but in the future we can add this -- see #31174.

(defn ^:export join-condition-operators
  [a-query stage-number lhs-column-or-nil rhs-column-or-nil]
  (to-array (lib.core/join-condition-operators a-query stage-number lhs-column-or-nil rhs-column-or-nil)))

Adds an expression to query.

(defn ^:export expression
  [a-query stage-number expression-name an-expression-clause]
  (lib.core/expression a-query stage-number expression-name an-expression-clause))

Return a new expression clause like an-expression-clause but with name new-name. For expressions from the :expressions clause of a pMBQL query this sets the :lib/expression-name option, for other expressions (for example named aggregation expressions) the :display-name option is set.

(defn ^:export with-expression-name
  [an-expression-clause new-name]
  (lib.core/with-expression-name an-expression-clause new-name))

Get the expressions map from a given stage of a query.

(defn ^:export expressions
  [a-query stage-number]
  (to-array (lib.core/expressions a-query stage-number)))

Return an array of Column metadatas about the columns that can be used in an expression in a given stage of a-query. Pass the current expression-position or null for new expressions.

(defn ^:export expressionable-columns
  ([a-query expression-position]
   (expressionable-columns a-query expression-position))
  ([a-query stage-number expression-position]
   (to-array (lib.core/expressionable-columns a-query stage-number expression-position))))

Return suggested default join conditions when constructing a join against joinable, e.g. a Table, Saved Question, or another query. Suggested conditions will be returned if the source Table has a foreign key to the primary key of the thing we're joining (see #31175 for more info); otherwise this will return nil if no default conditions are suggested.

(defn ^:export suggested-join-conditions
  [a-query stage-number joinable]
  (to-array (lib.core/suggested-join-conditions a-query stage-number joinable)))

Get the :fields associated with a join.

(defn ^:export join-fields
  [a-join]
  (let [joined-fields (lib.core/join-fields a-join)]
    (if (keyword? joined-fields)
      (u/qualified-name joined-fields)
      (to-array joined-fields))))

Set the :fields for a-join.

(defn ^:export with-join-fields
  [a-join new-fields]
  (lib.core/with-join-fields a-join (cond-> new-fields
                                      (string? new-fields) keyword)))

Create a join clause (an :mbql/join map) against something joinable (Table metadata, a Saved Question, another query, etc.) with conditions, which should be an array of filter clauses. You can then manipulate this join clause with stuff like [[with-join-fields]], or add it to a query with [[join]].

(defn ^:export join-clause
  [joinable conditions]
  (lib.core/join-clause joinable conditions))

Add a join clause (as created by [[join-clause]]) to a stage of a query.

(defn ^:export join
  [a-query stage-number a-join]
  (lib.core/join a-query stage-number a-join))

Get the conditions (filter clauses) associated with a join.

(defn ^:export join-conditions
  [a-join]
  (to-array (lib.core/join-conditions a-join)))

Set the :conditions (filter clauses) for a join.

(defn ^:export with-join-conditions
  [a-join conditions]
  (lib.core/with-join-conditions a-join (js->clj conditions :keywordize-keys true)))

Get the joins associated with a particular query stage.

(defn ^:export joins
  [a-query stage-number]
  (to-array (lib.core/joins a-query stage-number)))

Rename the join specified by join-spec in a-query at stage-number to new-name. The join can be specified either by itself (as returned by [[joins]]), by its alias or by its index in the list of joins as returned by [[joins]]. If the specified join cannot be found, then query is returned as is. If renaming the join to new-name would clash with an existing join, a suffix is appended to new-name to make it unique.

(defn ^:export rename-join
  [a-query stage-number join-spec new-name]
  (lib.core/rename-join a-query stage-number join-spec new-name))

Remove the join specified by join-spec in a-query at stage-number. The join can be specified either by itself (as returned by [[joins]]), by its alias or by its index in the list of joins as returned by [[joins]]. If the specified join cannot be found, then a-query is returned as is. Top level clauses containing references to the removed join are removed too.

(defn ^:export remove-join
  [a-query stage-number join-spec]
  (lib.core/remove-join a-query stage-number join-spec))

Return metadata about the origin of join using metadata-providerable as the source of information.

(defn ^:export joined-thing
  [a-query a-join]
  (lib.join/joined-thing a-query a-join))

Temporary solution providing access to internal IDs for the FE to pass on to MLv1 functions.

(defn ^:export picker-info
  [a-query metadata]
  (case (:lib/type metadata)
    :metadata/table #js {:databaseId (:database a-query)
                         :tableId (:id metadata)}
    :metadata/card  #js {:databaseId (:database a-query)
                         :tableId (str "card__" (:id metadata))
                         :cardId (:id metadata)
                         :isModel (:dataset metadata)}
    (do
      (log/warn "Cannot provide picker-info for" (:lib/type metadata))
      nil)))

Convert the internal operator clause to the external format.

(defn ^:export external-op
  [clause]
  (let [{:keys [operator options args]} (lib.core/external-op clause)]
    #js {:operator operator
         :options (clj->js options)
         :args (to-array args)}))

Create a new native query.

Native in this sense means a pMBQL query with a first stage that is a native query.

(defn ^:export native-query
  [database-id metadata inner-query]
  (lib.core/native-query (metadataProvider database-id metadata) inner-query))

Update the raw native query, the first stage must already be a native type. Replaces templates tags

(defn ^:export with-native-query
  [a-query inner-query]
  (lib.core/with-native-query a-query inner-query))

Updates the native query's template tags.

(defn ^:export with-template-tags
  [a-query tags]
  (lib.core/with-template-tags a-query (convert-js-template-tags tags)))

Returns the native query string

(defn ^:export raw-native-query
  [a-query]
  (lib.core/raw-native-query a-query))

Returns the native query's template tags

(defn ^:export template-tags
  [a-query]
  (clj->js (lib.core/template-tags a-query)))

Returns the extra keys that are required for this database's native queries, for example :collection name is needed for MongoDB queries.

(defn ^:export required-native-extras
  [database-id metadata]
  (to-array
   (map u/qualified-name
        (lib.core/required-native-extras (metadataProvider database-id metadata)))))

Returns whether the database has native write permissions. This is only filled in by [[metabase.api.database/add-native-perms-info]] and added to metadata when pulling a database from the list of dbs in js.

(defn ^:export has-write-permission
  [a-query]
  (lib.core/has-write-permission a-query))

Changes the database for this query. The first stage must be a native type. Native extras must be provided if the new database requires it.

(defn ^:export with-different-database
  ([a-query database-id metadata]
   (with-different-database a-query database-id metadata nil))
  ([a-query database-id metadata native-extras]
   (lib.core/with-different-database a-query (metadataProvider database-id metadata) (js->clj native-extras :keywordize-keys true))))

Updates the extras required for the db to run this query. The first stage must be a native type. Will ignore extras not in required-native-extras.

(defn ^:export with-native-extras
  [a-query native-extras]
  (lib.core/with-native-extras a-query (js->clj native-extras :keywordize-keys true)))

Returns the extra keys for native queries associated with this query.

(defn ^:export native-extras
  [a-query]
  (clj->js (lib.core/native-extras a-query)))

Returns the database engine. Must be a native query

(defn ^:export engine
  [a-query]
  (name (lib.core/engine a-query)))

Get a list of Segments that you may consider using as filters for a query. Returns JS array of opaque Segment metadata objects.

(defn ^:export available-segments
  [a-query stage-number]
  (to-array (lib.core/available-segments a-query stage-number)))

Get a list of Metrics that you may consider using as aggregations for a query. Returns JS array of opaque Metric metadata objects.

(defn ^:export available-metrics
  [a-query]
  (to-array (lib.core/available-metrics a-query)))

Return information about the fields that you can pass to [[with-join-fields]] when constructing a join against something [[Joinable]] (i.e., a Table or Card) or manipulating an existing join. When passing in a join, currently selected columns (those in the join's :fields) will include :selected true information.

(defn ^:export joinable-columns
  [a-query stage-number join-or-joinable]
  (to-array (lib.core/joinable-columns a-query stage-number join-or-joinable)))

Get TableMetadata if passed an integer table-id, or CardMetadata if passed a legacy-style card__<id> string. Returns nil if no matching metadata is found.

(defn ^:export table-or-card-metadata
  [query-or-metadata-provider table-id]
  (lib.metadata/table-or-card query-or-metadata-provider table-id))

Get the display name for whatever we are joining. For an existing join, pass in the join clause. When constructing a join, pass in the thing we are joining against, e.g. a TableMetadata or CardMetadata.

(defn ^:export join-lhs-display-name
  [a-query stage-number join-or-joinable condition-lhs-column-or-nil]
  (lib.core/join-lhs-display-name a-query stage-number join-or-joinable condition-lhs-column-or-nil))

Get the Database ID (:database) associated with a query. If the query is using the [[metabase.mbql.schema/saved-questions-virtual-database-id]] (used in some situations for queries with a :source-card)

{:database -1337}

we will attempt to resolve the correct Database ID by getting metadata for the source Card and returning its :database-id; if this is not available for one reason or another this will return nil.

(defn ^:export database-id
  [a-query]
  (lib.core/database-id a-query))

Updates the provided join-condition's fields' temporal-bucketing option. Must be called on a standard join condition as per [[standard-join-condition?]]. This will sync both the lhs and rhs fields, and the fields that support the provided option will be updated. Fields that do not support the provided option will be ignored.

(defn ^:export join-condition-update-temporal-bucketing
  [a-query stage-number join-condition bucketing-option]
  (lib.core/join-condition-update-temporal-bucketing a-query stage-number join-condition bucketing-option))
(defn- fix-column-with-ref [a-ref column]
  (cond-> column
    ;; Sometimes the FE has result metadata from the QP, without the required :lib/source-uuid on it.
    ;; We have the UUID for the aggregation in its ref, so use that here.
    (some-> a-ref first (= :aggregation)) (assoc :lib/source-uuid (last a-ref))))

Given a col-fn, returns a function that will extract a JS object like {col: {name: "ID", ...}, value: 12} into a CLJS map like ``` {:column {:lib/type :metadata/column ...} :column-ref [:field ...] :value 12} ```

The spelling of the column key differs between multiple JS objects of this same general shape (col on data rows, column on dimensions), etc., hence the abstraction.

(defn- js-cells-by
  [col-fn]
  (fn [^js cell]
    (let [column     (js.metadata/parse-column (col-fn cell))
          column-ref (when-let [a-ref (:field-ref column)]
                       (legacy-ref->pMBQL a-ref))]
      {:column     (fix-column-with-ref column-ref column)
       :column-ref column-ref
       :value      (.-value cell)})))
(def ^:private row-cell       (js-cells-by #(.-col ^js %)))
(def ^:private dimension-cell (js-cells-by #(.-column ^js %)))

Return an array (possibly empty) of drill-thrus given: - Nullable column - Nullable value - Nullable data row (the array of {col, value} pairs from clicked.data) - Nullable dimensions list ({column, value} pairs from clicked.dimensions)

Column can be nil for a "chart legend" click, eg. clicking a category in the legend explaining the colours in a multiple bar or line chart. Underlying records drills apply in that case!

(defn ^:export available-drill-thrus
  [a-query stage-number column value row dimensions]
  (lib.convert/with-aggregation-list (lib.core/aggregations a-query stage-number)
    (let [column-ref (when-let [a-ref (and column (.-field_ref ^js column))]
                       (legacy-ref->pMBQL a-ref))]
      (->> (merge {:column     (when column
                                 (fix-column-with-ref column-ref (js.metadata/parse-column column)))
                   :column-ref column-ref
                   :value      (cond
                                 (undefined? value) nil   ; Missing a value, ie. a column click
                                 (nil? value)       :null ; Provided value is null, ie. database NULL
                                 :else              value)}
                  (when row                    {:row        (mapv row-cell       row)})
                  (when (not-empty dimensions) {:dimensions (mapv dimension-cell dimensions)}))
           (lib.core/available-drill-thrus a-query stage-number)
           to-array))))

Applies the given drill-thru to the specified query and stage. Returns the updated query.

Each type of drill-thru has a different effect on the query.

(defn ^:export drill-thru
  [a-query stage-number a-drill-thru & args]
  (apply lib.core/drill-thru a-query stage-number a-drill-thru args))

Returns a JS object with opaque CLJS things in it, which are needed to render the complex UI for column-filter and some quick-filter drills. Since the query might need an extra stage appended, this returns a possibly updated query and stageNumber, as well as a column as returned by [[filterable-columns]].

(defn ^:export filter-drill-details
  [{a-query :query
    :keys [column stage-number value]
    :as _filter-drill}]
  #js {"column"     column
       "query"      a-query
       "stageIndex" stage-number
       "value"      (if (= value :null) nil value)})

Returns an array of pivot types that are available in this drill-thru, which must be a pivot drill-thru.

(defn ^:export pivot-types
  [a-drill-thru]
  (->> (lib.core/pivot-types a-drill-thru)
       (map name)
       to-array))

Returns an array of pivotable columns of the specified type.

(defn ^:export pivot-columns-for-type
  [a-drill-thru pivot-type]
  (to-array (lib.core/pivot-columns-for-type a-drill-thru (keyword pivot-type))))

Changes an existing query to use a different source table or card. Can be passed an integer table id or a legacy card__<id> string.

(defn ^:export with-different-table
  [a-query table-id]
  (lib.core/with-different-table a-query table-id))

Given a n unit time interval and the current date, return a string representing the date-time range. Provide an offset-n and offset-unit time interval to change the date used relative to the current date. options is a map and supports :include-current to include the current given unit of time in the range.

(defn ^:export format-relative-date-range
  [n unit offset-n offset-unit options]
  (shared.ut/format-relative-date-range
    n
    (keyword unit)
    offset-n
    (some-> offset-unit keyword)
    (js->clj options :keywordize-keys true)))

Given a-ref-or-column and a list of columns, finds the column that best matches this ref or column.

Matching is based on finding the basically plausible matches first. There is often zero or one plausible matches, and this can return quickly.

If there are multiple plausible matches, they are disambiguated by the most important extra included in the ref. (:join-alias first, then :temporal-unit, etc.)

  • Integer IDs in the ref are matched by ID; this usually is unambiguous.
  • If there are multiple joins on one table (including possible implicit joins), check :join-alias next.
  • If a-ref has a :join-alias, only a column which matches it can be the match, and it should be unique.
  • If a-ref doesn't have a :join-alias, prefer the column with no :join-alias, and prefer already selected columns over implicitly joinable ones.
  • There may be broken cases where the ref has an ID but the column does not. Therefore the ID must be resolved to a name or :lib/desired-column-alias and matched that way.
  • query and stage-number are required for this case, since they're needed to resolve the correct name.
  • Columns with :id set are dropped to prevent them matching. (If they didn't match by :id above they shouldn't match by name due to a coincidence of column names in different tables.)
  • String IDs are checked against :lib/desired-column-alias first.
  • If that doesn't match any columns, :name is compared next.
  • The same disambiguation (by :join-alias etc.) is applied if there are multiple plausible matches.

    Returns the matching column, or nil if no match is found.

(defn ^:export find-matching-column
  [a-query stage-number a-ref columns]
  (lib.core/find-matching-column a-query stage-number a-ref columns))

Returns the count of stages in query

(defn ^:export stage-count
  [a-query]
  (lib.core/stage-count a-query))

Provides a reasonable display name for the filter-clause excluding the column-name. Can be expanded as needed but only currently defined for a narrow set of date filters.

Falls back to the full filter display-name

(defn ^:export filter-args-display-name
  [a-query stage-number a-filter-clause]
  (lib.core/filter-args-display-name a-query stage-number a-filter-clause))

Create an expression clause from legacy-expression at stage stage-number of a-query.

(defn ^:export expression-clause-for-legacy-expression
  [a-query stage-number legacy-expression]
  (lib.convert/with-aggregation-list (lib.core/aggregations a-query stage-number)
    (let [expr (js->clj legacy-expression :keywordize-keys true)
          expr (first (mbql.normalize/normalize-fragment [:query :aggregation] [expr]))]
      (lib.convert/->pMBQL expr))))

Create a legacy expression from an-expression-clause at stage stage-number of a-query. When processing aggregation clauses, the aggregation-options wrapper (e.g., specifying the name of the aggregation expression) (if any) is thrown away.

(defn ^:export legacy-expression-for-expression-clause
  [a-query stage-number an-expression-clause]
  (lib.convert/with-aggregation-list (lib.core/aggregations a-query stage-number)
    (let [legacy-expr (-> an-expression-clause lib.convert/->legacy-MBQL)]
      (clj->js (cond-> legacy-expr
                 (and (vector? legacy-expr)
                      (= (first legacy-expr) :aggregation-options))
                 (get 1))))))

Info about whether the column in question has FieldValues associated with it for purposes of powering a search widget in the QB filter modals.

(defn ^:export field-values-search-info
  [metadata-providerable column]
  (-> (lib.field/field-values-search-info metadata-providerable column)
      (update :has-field-values name)
      (update-keys cljs-key->js-key)
      clj->js))

Add or update a filter against a latitude-column and longitude-column.

(defn ^:export update-lat-lon-filter
  [a-query stage-number latitude-column longitude-column bounds]
  (let [bounds (js->clj bounds :keywordize-keys true)]
    (lib.core/update-lat-lon-filter a-query stage-number latitude-column longitude-column bounds)))

Add or update a filter against numeric-column.

(defn ^:export update-numeric-filter
  [a-query numeric-column stage-number start end]
  (lib.core/update-numeric-filter a-query numeric-column stage-number start end))

Add or update a filter against temporal-column. Modify the temporal unit for any breakouts.

(defn ^:export update-temporal-filter
  [a-query temporal-column stage-number start end]
  (lib.core/update-temporal-filter a-query temporal-column stage-number start end))
 
(ns metabase.lib.js.metadata
  (:require
   [clojure.core.protocols]
   [clojure.string :as str]
   [clojure.walk :as walk]
   [goog]
   [goog.object :as gobject]
   [medley.core :as m]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.lib.util :as lib.util]
   [metabase.util :as u]
   [metabase.util.log :as log]))

metabase-lib/metadata/Metadata comes in an object like

{ databases: {}, tables: {}, fields: {}, metrics: {}, segments: {}, questions: {}, }

where keys are a map of String ID => metadata

Even tho [[u/->kebab-case-en]] has LRU memoization, plain memoization is significantly faster, and since the keys we're parsing here are bounded it's fine to memoize this stuff forever.

(def ^:private ^{:arglists '([k])} memoized-kebab-key
  (memoize u/->kebab-case-en))
(defn- object-get [obj k]
  (when (and obj (js-in k obj))
    (gobject/get obj k)))

Convert a JS object of any class to a ClojureScript object.

(defn- obj->clj
  ([xform obj]
   (obj->clj xform obj {}))
  ([xform obj {:keys [use-plain-object?] :or {use-plain-object? true}}]
   (if (map? obj)
     ;; already a ClojureScript object.
     (into {} xform obj)
     ;; has a plain-JavaScript `_plainObject` attached: apply `xform` to it and call it a day
     (if-let [plain-object (when use-plain-object?
                             (some-> (object-get obj "_plainObject")
                                     js->clj
                                     not-empty))]
       (into {} xform plain-object)
       ;; otherwise do things the hard way and convert an arbitrary object into a Cljs map. (`js->clj` doesn't work on
       ;; arbitrary classes other than `Object`)
       (into {}
             (comp
              (map (fn [k]
                     [k (object-get obj k)]))
              ;; ignore values that are functions
              (remove (fn [[_k v]]
                        (js-fn? v)))
              xform)
             (js-keys obj))))))

this intentionally does not use the lib hierarchy since it's not dealing with MBQL/lib keys

(defmulti ^:private excluded-keys
  {:arglists '([object-type])}
  keyword)
(defmethod excluded-keys :default
  [_]
  nil)

Return a function with the signature

(f k v) => v'

For parsing an individual field.

yes, the multimethod could dispatch on object-type AND k and get called for every object, but that would be slow, by doing it this way we only need to do it once.

(defmulti ^:private parse-field-fn
  {:arglists '([object-type])}
  keyword)
(defmethod parse-field-fn :default
  [_object-type]
  nil)

The metadata type that should be attached the sorts of metadatas with the :lib/type key, e.g. :metadata/table.

(defmulti ^:private lib-type
  {:arglists '([object-type])}
  keyword)

Returns a function of the keys, either renaming each one or preserving it. If this function returns nil for a given key, the original key is preserved. Use [[excluded-keys]] to drop keys from the input.

Defaults to nil, which means no renaming is done.

(defmulti ^:private rename-key-fn
  identity)
(defmethod rename-key-fn :default [_]
  nil)
(defn- parse-object-xform [object-type]
  (let [excluded-keys-set (excluded-keys object-type)
        parse-field       (parse-field-fn object-type)
        rename-key        (rename-key-fn object-type)]
    (comp
     ;; convert keys to kebab-case keywords
     (map (fn [[k v]]
            [(cond-> (keyword (memoized-kebab-key k))
               rename-key (#(or (rename-key %) %)))
             v]))
     ;; remove [[excluded-keys]]
     (if (empty? excluded-keys-set)
       identity
       (remove (fn [[k _v]]
                 (contains? excluded-keys-set k))))
     ;; parse each key with its [[parse-field-fn]]
     (if-not parse-field
       identity
       (map (fn [[k v]]
              [k (parse-field k v)]))))))
(defmulti ^:private parse-object-fn*
  {:arglists '([object-type opts])}
  (fn
    [object-type _opts]
    object-type))
(defn- parse-object-fn
  ([object-type]      (parse-object-fn* object-type {}))
  ([object-type opts] (parse-object-fn* object-type opts)))
(defmethod parse-object-fn* :default
  [object-type opts]
  (let [xform         (parse-object-xform object-type)
        lib-type-name (lib-type object-type)]
    (fn [object]
      (try
        (let [parsed (assoc (obj->clj xform object opts) :lib/type lib-type-name)]
          (log/debugf "Parsed metadata %s %s\n%s" object-type (:id parsed) (u/pprint-to-str parsed))
          parsed)
        (catch js/Error e
          (log/errorf e "Error parsing %s %s: %s" object-type (pr-str object) (ex-message e))
          nil)))))
(defmulti ^:private parse-objects
  {:arglists '([object-type metadata])}
  (fn [object-type _metadata]
    (keyword object-type)))

Key to use to get unparsed objects of this type from the metadata, if you're using the default implementation of [[parse-objects]].

(defmulti ^:private parse-objects-default-key
  {:arglists '([object-type])}
  keyword)
(defmethod parse-objects :default
  [object-type metadata]
  (let [parse-object (parse-object-fn object-type)]
    (obj->clj (map (fn [[k v]]
                     [(parse-long k) (delay (parse-object v))]))
              (object-get metadata (parse-objects-default-key object-type)))))
(defmethod lib-type :database
  [_object-type]
  :metadata/database)
(defmethod excluded-keys :database
  [_object-type]
  #{:tables :fields})
(defmethod parse-field-fn :database
  [_object-type]
  (fn [k v]
    (case k
      :dbms-version       (js->clj v :keywordize-keys true)
      :features           (into #{} (map keyword) v)
      :native-permissions (keyword v)
      v)))
(defmethod parse-objects-default-key :database
  [_object-type]
  "databases")
(defmethod lib-type :table
  [_object-type]
  :metadata/table)
(defmethod excluded-keys :table
  [_object-type]
  #{:database :fields :segments :metrics :dimension-options})
(defmethod parse-field-fn :table
  [_object-type]
  (fn [k v]
    (case k
      :entity-type         (keyword v)
      :field-order         (keyword v)
      :initial-sync-status (keyword v)
      :visibility-type     (keyword v)
      v)))
(defmethod parse-objects :table
  [object-type metadata]
  (let [parse-table (parse-object-fn object-type)]
    (obj->clj (comp (remove (fn [[k _v]]
                              (str/starts-with? k "card__")))
                    (map (fn [[k v]]
                           [(parse-long k) (delay (parse-table v))])))
              (object-get metadata "tables"))))
(defmethod lib-type :field
  [_object-type]
  :metadata/column)
(defmethod excluded-keys :field
  [_object-type]
  #{:_comesFromEndpoint
    :database
    :default-dimension-option
    :dimension-options
    :metrics
    :table})
(defmethod rename-key-fn :field
  [_object-type]
  {:source          :lib/source
   :unit            :metabase.lib.field/temporal-unit
   :expression-name :lib/expression-name
   :binning-info    :metabase.lib.field/binning
   :dimensions      ::dimension
   :values          ::field-values})
(defn- parse-field-id
  [id]
  (cond-> id
    ;; sometimes instead of an ID we get a field reference
    ;; with the name of the column in the second position
    (vector? id) second))
(defn- parse-binning-info
  [m]
  (obj->clj
   (map (fn [[k v]]
          (let [k (keyword (memoized-kebab-key k))
                k (if (= k :binning-strategy)
                    :strategy
                    k)
                v (if (= k :strategy)
                    (keyword v)
                    v)]
            [k v])))
   m))
(defn- parse-field-values [field-values]
  (when (= (object-get field-values "type") "full")
    {:values                (js->clj (object-get field-values "values"))
     :human-readable-values (js->clj (object-get field-values "human_readable_values"))}))

:dimensions comes in as an array for historical reasons, even tho a Field can only have one. So it should never have more than one element. See #27054. Anyways just to be safe let's make sure it's either :external or :internal.

(defn- parse-dimension
  [dimensions]
  (when-let [dimension (m/find-first (fn [dimension]
                                       (#{"external" "internal"} (object-get dimension "type")))
                                     dimensions)]
    (let [dimension-type (keyword (object-get dimension "type"))]
      (merge
       {:id   (object-get dimension "id")
        :name (object-get dimension "name")}
       (case dimension-type
         ;; external = mapped to a different column
         :external
         {:lib/type :metadata.column.remapping/external
          :field-id (object-get dimension "human_readable_field_id")}
         ;; internal = mapped to FieldValues
         :internal
         {:lib/type :metadata.column.remapping/internal})))))
(defmethod parse-field-fn :field
  [_object-type]
  (fn [k v]
    (case k
      :base-type                        (keyword v)
      :coercion-strategy                (keyword v)
      :effective-type                   (keyword v)
      :fingerprint                      (if (map? v)
                                          (walk/keywordize-keys v)
                                          (js->clj v :keywordize-keys true))
      :has-field-values                 (keyword v)
      :lib/source                       (case v
                                          "aggregation" :source/aggregations
                                          "breakout"    :source/breakouts
                                          (keyword "source" v))
      :metabase.lib.field/temporal-unit (keyword v)
      :semantic-type                    (keyword v)
      :visibility-type                  (keyword v)
      :id                               (parse-field-id v)
      :metabase.lib.field/binning       (parse-binning-info v)
      ::field-values                    (parse-field-values v)
      ::dimension                       (parse-dimension v)
      v)))
(defmethod parse-object-fn* :field
  [object-type opts]
  (let [f ((get-method parse-object-fn* :default) object-type opts)]
    (fn [unparsed]
      (let [{{dimension-type :lib/type, :as dimension} ::dimension, ::keys [field-values], :as parsed} (f unparsed)]
        (-> (case dimension-type
              :metadata.column.remapping/external
              (assoc parsed :lib/external-remap dimension)

              :metadata.column.remapping/internal
              (assoc parsed :lib/internal-remap (merge dimension field-values))

              parsed)
            (dissoc ::dimension ::field-values))))))
(defmethod parse-objects :field
  [object-type metadata]
  (let [parse-object    (parse-object-fn object-type)
        unparsed-fields (object-get metadata "fields")]
    (obj->clj (keep (fn [[k v]]
                      ;; Sometimes fields coming from saved questions are only present with their ID
                      ;; prefixed with "card__<card-id>:". For such keys we parse the field ID from
                      ;; the suffix and use the entry unless the ID is present in the metadata without
                      ;; prefix. (The assumption being that the data under the two keys are mostly the
                      ;; same but the one under the plain key is to be preferred.)
                      (when-let [field-id (or (parse-long k)
                                              (when-let [[_ id-str] (re-matches #"card__\d+:(\d+)" k)]
                                                (and (nil? (object-get unparsed-fields id-str))
                                                     (parse-long id-str))))]
                        [field-id (delay (parse-object v))])))
              unparsed-fields)))
(defmethod lib-type :card
  [_object-type]
  :metadata/card)
(defmethod excluded-keys :card
  [_object-type]
  #{:database
    :db
    :dimension-options
    :fks
    :metadata
    :metrics
    :plain-object
    :segments
    :schema
    :schema-name
    :table})
(defn- parse-fields [fields]
  (mapv (parse-object-fn :field) fields))
(defmethod parse-field-fn :card
  [_object-type]
  (fn [k v]
    (case k
      :result-metadata (if ((some-fn sequential? array?) v)
                         (parse-fields v)
                         (js->clj v :keywordize-keys true))
      :fields          (parse-fields v)
      :visibility-type (keyword v)
      :dataset-query   (js->clj v :keywordize-keys true)
      :dataset         v
      ;; this is not complete, add more stuff as needed.
      v)))

Sometimes a card is stored in the metadata as some sort of weird object where the thing we actually want is under the key _card (not sure why), but if it is just unwrap it and then parse it normally.

(defn- unwrap-card
  [obj]
  (or (object-get obj "_card")
      obj))
(defn- assemble-card
  [metadata id]
  (let [parse-card-ignoring-plain-object (parse-object-fn :card {:use-plain-object? false})
        parse-card (parse-object-fn :card)]
    ;; The question objects might not contain the fields so we merge them
    ;; in from the table matadata.
    (merge
     (-> metadata
         (object-get "tables")
         (object-get (str "card__" id))
         ;; _plainObject can contain field names in the field property
         ;; instead of the field objects themselves.  Ignoring this
         ;; property makes sure we parse the real fields.
         parse-card-ignoring-plain-object
         (assoc :id id))
     (-> metadata
         (object-get "questions")
         (object-get (str id))
         unwrap-card
         parse-card))))
(defmethod parse-objects :card
  [_object-type metadata]
  (into {}
        (map (fn [id]
               [id (delay (assemble-card metadata id))]))
        (-> #{}
            (into (keep lib.util/legacy-string-table-id->card-id)
                  (js-keys (object-get metadata "tables")))
            (into (map parse-long)
                  (js-keys (object-get metadata "questions"))))))
(defmethod lib-type :metric
  [_object-type]
  :metadata/metric)
(defmethod excluded-keys :metric
  [_object-type]
  #{:database :table})
(defmethod parse-field-fn :metric
  [_object-type]
  (fn [_k v]
    v))
(defmethod parse-objects-default-key :metric
  [_object-type]
  "metrics")
(defmethod lib-type :segment
  [_object-type]
  :metadata/segment)
(defmethod excluded-keys :segment
  [_object-type]
  #{:database :table})
(defmethod parse-field-fn :segment
  [_object-type]
  (fn [_k v]
    v))
(defmethod parse-objects-default-key :segment
  [_object-type]
  "segments")
(defn- parse-objects-delay [object-type metadata]
  (delay
    (try
      (parse-objects object-type metadata)
      (catch js/Error e
        (log/errorf e "Error parsing %s objects: %s" object-type (ex-message e))
        nil))))
(defn- parse-metadata [metadata]
  {:databases (parse-objects-delay :database metadata)
   :tables    (parse-objects-delay :table    metadata)
   :fields    (parse-objects-delay :field    metadata)
   :cards     (parse-objects-delay :card     metadata)
   :metrics   (parse-objects-delay :metric   metadata)
   :segments  (parse-objects-delay :segment  metadata)})
(defn- database [metadata database-id]
  (some-> metadata :databases deref (get database-id) deref))
(defn- table [metadata table-id]
  (some-> metadata :tables deref (get table-id) deref))
(defn- field [metadata field-id]
  (some-> metadata :fields deref (get field-id) deref))
(defn- card [metadata card-id]
  (some-> metadata :cards deref (get card-id) deref))
(defn- metric [metadata metric-id]
  (some-> metadata :metrics deref (get metric-id) deref))
(defn- segment [metadata segment-id]
  (some-> metadata :segments deref (get segment-id) deref))
(defn- tables [metadata database-id]
  (for [[_id table-delay] (some-> metadata :tables deref)
        :let              [a-table (some-> table-delay deref)]
        :when             (and a-table (= (:db-id a-table) database-id))]
    a-table))
(defn- fields [metadata table-id]
  (for [[_id field-delay] (some-> metadata :fields deref)
        :let              [a-field (some-> field-delay deref)]
        :when             (and a-field (= (:table-id a-field) table-id))]
    a-field))
(defn- metrics [metadata table-id]
  (for [[_id metric-delay] (some-> metadata :metrics deref)
        :let               [a-metric (some-> metric-delay deref)]
        :when              (and a-metric (= (:table-id a-metric) table-id))]
    a-metric))
(defn- segments [metadata table-id]
  (for [[_id segment-delay] (some-> metadata :segments deref)
        :let               [a-segment (some-> segment-delay deref)]
        :when              (and a-segment (= (:table-id a-segment) table-id))]
    a-segment))
(defn- setting [setting-key ^js unparsed-metadata]
  (-> unparsed-metadata
    (object-get "settings")
    (object-get (name setting-key))))

Use a metabase-lib/metadata/Metadata as a [[metabase.lib.metadata.protocols/MetadataProvider]].

(defn metadata-provider
  [database-id unparsed-metadata]
  (let [metadata (parse-metadata unparsed-metadata)]
    (log/debug "Created metadata provider for metadata")
    (reify lib.metadata.protocols/MetadataProvider
      (database [_this]             (database metadata database-id))
      (table    [_this table-id]    (table    metadata table-id))
      (field    [_this field-id]    (field    metadata field-id))
      (metric   [_this metric-id]   (metric   metadata metric-id))
      (segment  [_this segment-id]  (segment  metadata segment-id))
      (card     [_this card-id]     (card     metadata card-id))
      (tables   [_this]             (tables   metadata database-id))
      (fields   [_this table-id]    (fields   metadata table-id))
      (metrics  [_this table-id]    (metrics  metadata table-id))
      (segments [_this table-id]    (segments metadata table-id))
      (setting  [_this setting-key] (setting  setting-key unparsed-metadata))
      ;; for debugging: call [[clojure.datafy/datafy]] on one of these to parse all of our metadata and see the whole
      ;; thing at once.
      clojure.core.protocols/Datafiable
      (datafy [_this]
        (walk/postwalk
         (fn [form]
           (if (delay? form)
             (deref form)
             form))
         metadata)))))

Parses a JS column provided by the FE into a :metadata/column value for use in MLv2.

(def parse-column
  (parse-object-fn :field))
 
(ns metabase.lib.limit
  (:require
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.util :as lib.util]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util.malli :as mu]))
(defmethod lib.metadata.calculation/describe-top-level-key-method :limit
  [query stage-number _k]
  (when-let [limit (:limit (lib.util/query-stage query stage-number))]
    (str limit \space (i18n/trun "row" "rows" limit))))
(mu/defn ^:export limit :- ::lib.schema/query
  "Set the maximum number of rows to be returned by a stage of a query to `n`. If `n` is `nil`, remove the limit."
  ([query n]
   (limit query -1 n))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    n            :- [:maybe ::lib.schema.common/positive-int]]
   (lib.util/update-query-stage query stage-number (fn [stage]
                                                     (if n
                                                       (assoc stage :limit n)
                                                       (dissoc stage :limit))))))
(mu/defn ^:export current-limit :- [:maybe ::lib.schema.common/positive-int]
  "Get the maximum number of rows to be returned by a stage of a query. `nil` indicates there is no limit"
  ([query :- ::lib.schema/query]
   (current-limit query -1))
  ([query :- ::lib.schema/query
    stage-number :- :int]
   (:limit (lib.util/query-stage query stage-number))))
 
(ns metabase.lib.metadata
  (:require
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.lib.util :as lib.util]
   [metabase.util.malli :as mu]))

Column vs Field?

Lately I've been using Field to only mean a something that lives in the application database, i.e. something that is associated with row in the Field table and has an :id. I'm using Column as a more generic term that includes not only Fields but also the columns returned by a stage of a query, e.g. SELECT count(*) AS count returns a Column called count, but it's not a Field because it's not associated with an actual Field in the application database.

Malli schema for a valid map of column metadata, which can mean one of two things:

  1. Metadata about a particular Field in the application database. This will always have an :id

  2. Results metadata from a column in data.cols and/or data.results_metadata.columns in a Query Processor response, or saved in something like Card.result_metadata. These may have an :id, or may not -- columns coming back from native queries or things like SELECT count(*) aren't associated with any particular Field and thus will not have an :id.

Now maybe these should be two different schemas, but :id being there or not is the only real difference; besides that they are largely compatible. So they're the same for now. We can revisit this in the future if we actually want to differentiate between the two versions.

(def ColumnMetadata
  [:ref ::lib.schema.metadata/column])

Schema for metadata about a specific Saved Question (which may or may not be a Model). More or less the same as a [[metabase.models.card]], but with kebab-case keys. Note that the :dataset-query is not necessarily converted to pMBQL yet. Probably safe to assume it is normalized however. Likewise, :result-metadata is probably not quite massaged into a sequence of ColumnMetadatas just yet. See [[metabase.lib.card/card-metadata-columns]] that converts these as needed.

(def CardMetadata
  [:ref ::lib.schema.metadata/card])

More or less the same as a [[metabase.models.segment]], but with kebab-case keys.

(def SegmentMetadata
  [:ref ::lib.schema.metadata/segment])

Malli schema for a legacy v1 [[metabase.models.metric]], but with kebab-case keys. A Metric defines an MBQL snippet with an aggregation and optionally a filter clause. You can add a :metric reference to the :aggregations in an MBQL stage, and the QP treats it like a macro and expands it to the underlying clauses -- see [[metabase.query-processor.middleware.expand-macros]].

(def MetricMetadata
  [:ref ::lib.schema.metadata/metric])

Schema for metadata about a specific [[metabase.models.table]]. More or less the same as a [[metabase.models.table]], but with kebab-case keys.

(def TableMetadata
  [:ref ::lib.schema.metadata/table])

Malli schema for the DatabaseMetadata as returned by GET /api/database/:id/metadata -- what should be available to the frontend Query Builder.

(def DatabaseMetadata
  [:ref ::lib.schema.metadata/database])

Schema for something that satisfies the [[lib.metadata.protocols/MetadataProvider]] protocol.

(def MetadataProvider
  [:ref ::lib.schema.metadata/metadata-provider])

Something that can be used to get a MetadataProvider. Either a MetadataProvider, or a map with a MetadataProvider in the key :lib/metadata (i.e., a query).

(def MetadataProviderable
  [:ref ::lib.schema.metadata/metadata-providerable])
(mu/defn ->metadata-provider :- MetadataProvider
  "Get a MetadataProvider from something that can provide one."
  [metadata-providerable :- MetadataProviderable]
  (if (lib.metadata.protocols/metadata-provider? metadata-providerable)
    metadata-providerable
    (:lib/metadata metadata-providerable)))
(mu/defn database :- DatabaseMetadata
  "Get metadata about the Database we're querying."
  [metadata-providerable :- MetadataProviderable]
  (lib.metadata.protocols/database (->metadata-provider metadata-providerable)))
(mu/defn tables :- [:sequential TableMetadata]
  "Get metadata about all Tables for the Database we're querying."
  [metadata-providerable :- MetadataProviderable]
  (lib.metadata.protocols/tables (->metadata-provider metadata-providerable)))
(mu/defn table :- TableMetadata
  "Find metadata for a specific Table, either by string `table-name`, and optionally `schema`, or by ID."
  [metadata-providerable :- MetadataProviderable
   table-id              :- ::lib.schema.id/table]
  (lib.metadata.protocols/table (->metadata-provider metadata-providerable) table-id))
(mu/defn fields :- [:sequential ColumnMetadata]
  "Get metadata about all the Fields belonging to a specific Table."
  [metadata-providerable :- MetadataProviderable
   table-id              :- ::lib.schema.id/table]
  (lib.metadata.protocols/fields (->metadata-provider metadata-providerable) table-id))
(mu/defn field :- [:maybe ColumnMetadata]
  "Get metadata about a specific Field in the Database we're querying."
  [metadata-providerable :- MetadataProviderable
   field-id              :- ::lib.schema.id/field]
  (lib.metadata.protocols/field (->metadata-provider metadata-providerable) field-id))
(mu/defn setting :- any?
  "Get the value of a Metabase setting for the instance we're querying."
  ([metadata-providerable :- MetadataProviderable
    setting-key           :- [:or string? keyword?]]
   (lib.metadata.protocols/setting (->metadata-provider metadata-providerable) setting-key)))

Stage metadata

Metadata about the columns returned by a particular stage of a pMBQL query. For example a single-stage native query like

{:database 1 :lib/type :mbql/query :stages [{:lib/type :mbql.stage/mbql :native "SELECT id, name FROM VENUES;"}]}

might have stage metadata like

{:columns [{:name "id", :base-type :type/Integer} {:name "name", :base-type :type/Text}]}

associated with the query's lone stage.

At some point in the near future we will hopefully attach this metadata directly to each stage in a query, so a multi-stage query will have :lib/stage-metadata for each stage. The main goal is to facilitate things like returning lists of visible or filterable columns for a given stage of a query. This is TBD, see #28717 for a WIP implementation of this idea.

This is the same format as the results metadata returned with QP results in data.results_metadata. The :columns portion of this (data.results_metadata.columns) is also saved as Card.result_metadata for Saved Questions.

Note that queries currently actually come back with both data.results_metadata AND data.cols; it looks like the Frontend actually merges these together -- see applyMetadataDiff in frontend/src/metabase/query_builder/selectors.js -- but this is ridiculous. Let's try to merge anything missing in results_metadata into cols going forward so things don't need to be manually merged in the future.

(def StageMetadata
  [:map
   [:lib/type [:= :metadata/results]]
   [:columns [:sequential ColumnMetadata]]])
(mu/defn stage :- [:maybe StageMetadata]
  "Get metadata associated with a particular `stage-number` of the query, if any. `stage-number` can be a negative
  index.
  Currently, only returns metadata if it is explicitly attached to a stage; in the future we will probably dynamically
  calculate this stuff if possible based on DatabaseMetadata and previous stages. Stay tuned!"
  [query        :- :map
   stage-number :- :int]
  (:lib/stage-metadata (lib.util/query-stage query stage-number)))
(mu/defn stage-column :- [:maybe ColumnMetadata]
  "Metadata about a specific column returned by a specific stage of the query, e.g. perhaps the first stage of the
  query has an expression `num_cans`, then
    (lib.metadata/stage-column query stage \"num_cans\")
  should return something like
    {:name \"num_cans\", :base-type :type/Integer, ...}
  This is currently a best-effort thing and will only return information about columns if stage metadata is attached
  to a particular stage. In the near term future this should be better about calculating that metadata dynamically and
  returning correct info here."
  ([query       :- :map
    column-name :- ::lib.schema.common/non-blank-string]
   (stage-column query -1 column-name))
  ([query        :- :map
    stage-number :- :int
    column-name  :- ::lib.schema.common/non-blank-string]
   (some (fn [column]
           (when (= (:name column) column-name)
             column))
         (:columns (stage query stage-number)))))
(mu/defn card :- [:maybe CardMetadata]
  "Get metadata for a Card, aka Saved Question, with `card-id`, if it can be found."
  [metadata-providerable :- MetadataProviderable
   card-id               :- ::lib.schema.id/card]
  (lib.metadata.protocols/card (->metadata-provider metadata-providerable) card-id))
(mu/defn segment :- [:maybe SegmentMetadata]
  "Get metadata for the Segment with `segment-id`, if it can be found."
  [metadata-providerable :- MetadataProviderable
   segment-id            :- ::lib.schema.id/segment]
  (lib.metadata.protocols/segment (->metadata-provider metadata-providerable) segment-id))
(mu/defn metric :- [:maybe MetricMetadata]
  "Get metadata for the Metric with `metric-id`, if it can be found."
  [metadata-providerable :- MetadataProviderable
   metric-id             :- ::lib.schema.id/metric]
  (lib.metadata.protocols/metric (->metadata-provider metadata-providerable) metric-id))
(mu/defn table-or-card :- [:maybe [:or CardMetadata TableMetadata]]
  "Convenience, for frontend JS usage (see #31915): look up metadata based on Table ID, handling legacy-style
  `card__<id>` strings as well. Throws an Exception (Clj-only, due to Malli validation) if passed an integer Table ID
  and the Table does not exist, since this is a real error; however if passed a `card__<id>` that does not exist,
  simply returns `nil` (since we do not have a strict expectation that Cards always be present in the
  MetadataProvider)."
  [metadata-providerable :- MetadataProviderable
   table-id              :- [:or ::lib.schema.id/table :string]]
  (if-let [card-id (lib.util/legacy-string-table-id->card-id table-id)]
    (card metadata-providerable card-id)
    (table metadata-providerable table-id)))
(mu/defn editable? :- :boolean
  "Given a query, returns whether it is considered editable.
  There's no editable flag! Instead, a query is **not** editable if:
  - Database is missing from the metadata (no permissions at all);
  - Database is present but tables (at least the `:source-table`) are missing (missing table permissions); or
  - Similarly, the card specified by `:source-card` is missing from the metadata.
  If metadata for the `:source-table` or `:source-card` can be found, then the query is editable."
  [query :- ::lib.schema/query]
  (let [{:keys [source-table source-card] :as stage0} (lib.util/query-stage query 0)]
    (boolean (and (database query)
                  (or (and source-table (table query source-table))
                      (and source-card  (card  query source-card))
                      (= (:lib/type stage0) :mbql.stage/native))))))
 
(ns metabase.lib.metadata.calculation
  (:require
   [clojure.string :as str]
   [metabase.lib.cache :as lib.cache]
   [metabase.lib.dispatch :as lib.dispatch]
   [metabase.lib.hierarchy :as lib.hierarchy]
   [metabase.lib.join.util :as lib.join.util]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.options :as lib.options]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.expression :as lib.schema.expresssion]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.lib.schema.temporal-bucketing
    :as lib.schema.temporal-bucketing]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.lib.util :as lib.util]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.registry :as mr]))

Schema for valid values of display-name-style as passed to [[display-name-method]].

  • :default: normal style used for 99% of FE stuff. For example a column that comes from a joined table might return "Price".

  • :long: Slightly longer style that includes a little bit of extra context, used for stuff like query suggested name generation. For a joined column, this might look like "Venues → Price".

(def DisplayNameStyle
  [:enum :default :long])

Display name style to use when not explicitly passed in to [[display-name]].

(def ^:dynamic *display-name-style*
  :default)

Calculate a nice human-friendly display name for something.

(defmulti display-name-method
  {:arglists '([query stage-number x display-name-style])}
  (fn [_query _stage-number x _display-name-style]
    (lib.dispatch/dispatch-value x))
  :hierarchy lib.hierarchy/hierarchy)

Calculate a database-friendly name to use for something.

(defmulti column-name-method
  {:arglists '([query stage-number x])}
  (fn [_query _stage-number x]
    (lib.dispatch/dispatch-value x))
  :hierarchy lib.hierarchy/hierarchy)
(mu/defn ^:export display-name :- :string
  "Calculate a nice human-friendly display name for something. See [[DisplayNameStyle]] for a the difference between
  different `style`s."
  ([query]
   (display-name query query))
  ([query x]
   (display-name query -1 x))
  ([query stage-number x]
   (display-name query stage-number x *display-name-style*))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    x
    style        :- DisplayNameStyle]
   (or
    ;; if this is an MBQL clause with `:display-name` in the options map, then use that rather than calculating a name.
    ((some-fn :display-name :lib/expression-name) (lib.options/options x))
    (try
      (display-name-method query stage-number x style)
      (catch #?(:clj Throwable :cljs js/Error) e
        (throw (ex-info (i18n/tru "Error calculating display name for {0}: {1}" (pr-str x) (ex-message e))
                        {:query query, :x x}
                        e)))))))
(mu/defn column-name :- ::lib.schema.common/non-blank-string
  "Calculate a database-friendly name to use for an expression."
  ([query x]
   (column-name query -1 x))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    x]
   (or
    ;; if this is an MBQL clause with `:name` in the options map, then use that rather than calculating a name.
    (:name (lib.options/options x))
    (try
      (column-name-method query stage-number x)
      (catch #?(:clj Throwable :cljs js/Error) e
        (throw (ex-info (i18n/tru "Error calculating column name for {0}: {1}" (pr-str x) (ex-message e))
                        {:x            x
                         :query        query
                         :stage-number stage-number}
                        e)))))))
(defmethod display-name-method :default
  [_query _stage-number x _stage]
  (log/warnf "Don't know how to calculate display name for %s. Add an impl for %s for %s"
             (pr-str x)
             `display-name-method
             (lib.dispatch/dispatch-value x))
  (if (and (vector? x)
           (keyword? (first x)))
    ;; MBQL clause: just use the name of the clause.
    (name (first x))
    ;; anything else: use `pr-str` representation.
    (pr-str x)))

TODO -- this logic is wack, we should probably be snake casing stuff and display names like

"Sum of Products → Price"

result in totally wacko column names like "sumproducts%E2%86%92_price", let's try to generate things that are actually going to be allowed here.

(defn- slugify [s]
  (-> s
      (str/replace #"[\(\)]" )
      (u/slugify {:unicode? true})))

default impl just takes the display name and slugifies it.

(defmethod column-name-method :default
  [query stage-number x]
  (slugify (display-name query stage-number x)))

Implementation for [[describe-top-level-key]]. Describe part of a stage of a query, e.g. the :filters part or the :aggregation part. Return nil if there is nothing to describe.

Implementations that call [[display-name]] should specify the :long display name style.

(defmulti describe-top-level-key-method
  {:arglists '([query stage-number top-level-key])}
  (fn [_query _stage-number top-level-key]
    top-level-key)
  :hierarchy lib.hierarchy/hierarchy)

In the interest of making this easy to use in JS-land we'll accept either strings or keywords.

(def ^:private TopLevelKey
  [:enum :aggregation :breakout :filters :limit :order-by :source-table :source-card :joins])
(mu/defn describe-top-level-key :- [:maybe ::lib.schema.common/non-blank-string]
  "'top-level' here means the top level of an individual stage. Generate a human-friendly string describing a specific
  part of an MBQL stage, or `nil` if that part doesn't exist."
  ([query top-level-key]
   (describe-top-level-key query -1 top-level-key))
  ([query         :- ::lib.schema/query
    stage-number  :- :int
    top-level-key :- TopLevelKey]
   (describe-top-level-key-method query stage-number (keyword top-level-key))))

Calculate the effective type of something. This differs from [[metabase.lib.schema.expression/type-of]] in that it is called with a query/MetadataProvider and a stage number, allowing us to fully resolve information and return complete, unambigous type information. Default implementation calls [[metabase.lib.schema.expression/type-of]].

(defmulti type-of-method
  {:arglists '([query stage-number expr])}
  (fn [_query _stage-number expr]
    (lib.dispatch/dispatch-value expr))
  :hierarchy lib.hierarchy/hierarchy)
(mu/defn type-of :- ::lib.schema.common/base-type
  "Get the effective type of an MBQL expression."
  ([query x]
   (type-of query -1 x))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    x]
   ;; this logic happens here so we don't need to code up every single individual method to handle these special
   ;; cases.
   (let [{:keys [temporal-unit], :as options} (lib.options/options x)]
     (or
      ;; If the options map includes `:effective-type` we can assume you know what you are doing and that it is
      ;; correct and just return it directly.
      (:effective-type options)
      ;; If `:temporal-unit` is specified (currently only supported by `:field` clauses), we should return
      ;; `:type/Integer` if its an extraction operation, e.g. `:month-of-year` always returns an integer; otherwise we
      ;; can return `:base-type`.
      (when (and temporal-unit
                 (contains? lib.schema.temporal-bucketing/datetime-extraction-units temporal-unit))
        :type/Integer)
      ;; otherwise if `:base-type` is specified, we can return that.
      (:base-type options)
      ;; if none of the special cases are true, fall back to [[type-of-method]].
      (let [calculated-type (type-of-method query stage-number x)]
        ;; if calculated type is not a true type but a placeholder like `:metabase.lib.schema.expression/type.unknown`
        ;; or a union of types then fall back to `:type/*`, an actual type.
        (if (isa? calculated-type :type/*)
          calculated-type
          :type/*))))))
(defmethod type-of-method :default
  [_query _stage-number expr]
  (lib.schema.expresssion/type-of expr))

for MBQL clauses whose type is the same as the type of the first arg. Also used for [[metabase.lib.schema.expression/type-of]].

(defmethod type-of-method :lib.type-of/type-is-type-of-first-arg
  [query stage-number [_tag _opts expr]]
  (type-of query stage-number expr))
(defmethod type-of-method :lib.type-of/type-is-temporal-type-of-first-arg
  [query stage-number [_tag _opts expr :as clause]]
  (if (string? expr)
    ;; If a string, get the type filtered by this expression (eg. `:datetime-add`).
    (lib.schema.expresssion/type-of clause)
    ;; Otherwise, just get the type of this first arg.
    (type-of query stage-number expr)))

Impl for [[metadata]]. Implementations that call [[display-name]] should use the :default display name style.

(defmulti metadata-method
  {:arglists '([query stage-number x])}
  (fn [_query _stage-number x]
    (lib.dispatch/dispatch-value x))
  :hierarchy lib.hierarchy/hierarchy)
(defmethod metadata-method :default
  [query stage-number x]
  (try
    {:lib/type     :metadata/column
     ;; TODO -- effective-type
     :base-type    (type-of query stage-number x)
     :name         (column-name query stage-number x)
     :display-name (display-name query stage-number x)}
    ;; if you see this error it's usually because you're calling [[metadata]] on something that you shouldn't be, for
    ;; example a query
    (catch #?(:clj Throwable :cljs js/Error) e
      (throw (ex-info (i18n/tru "Error calculating metadata for {0}: {1}"
                                (pr-str (lib.dispatch/dispatch-value x))
                                (ex-message e))
                      {:query query, :stage-number stage-number, :x x}
                      e)))))
(mu/defn metadata :- [:map [:lib/type [:and
                                       :keyword
                                       [:fn
                                        {:error/message ":lib/type should be a :metadata/ keyword"}
                                        #(= (namespace %) "metadata")]]]]
  "Calculate an appropriate `:metadata/*` object for something. What this looks like depends on what we're calculating
  metadata for. If it's a reference or expression of some sort, this should return a single `:metadata/column`
  map (i.e., something satisfying the `::lib.schema.metadata/column` schema."
  ([query]
   (metadata query -1 query))
  ([query x]
   (metadata query -1 x))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    x]
   (metadata-method query stage-number x)))
(mu/defn describe-query :- ::lib.schema.common/non-blank-string
  "Convenience for calling [[display-name]] on a query to describe the results of its final stage."
  [query]
  (display-name query query))
(mu/defn suggested-name :- [:maybe ::lib.schema.common/non-blank-string]
  "Name you might want to use for a query when saving an previously-unsaved query. This is the same
  as [[describe-query]] except for native queries, where we don't describe anything."
  [query]
  (when-not (= (:lib/type (lib.util/query-stage query -1)) :mbql.stage/native)
    (try
      (describe-query query)
      (catch #?(:clj Throwable :cljs js/Error) e
        (log/error e (i18n/tru "Error calculating display name for query: {0}" (ex-message e)))
        nil))))

Implementation for [[display-info]]. Implementations that call [[display-name]] should use the :default display name style.

Do not call this recursively from its own defmethods, aside from calling the :default. Prefer calling [[display-info]] directly, so that its caching can encourage reuse. (Eg. column-groups recursively call display-info on their columns.)

(defmulti display-info-method
  {:arglists '([query stage-number x])}
  (fn [_query _stage-number x]
    (lib.dispatch/dispatch-value x))
  :hierarchy lib.hierarchy/hierarchy)
(mr/def ::display-info
  [:map
   [:display-name {:optional true} :string]
   [:long-display-name {:optional true} :string]
   ;; for things with user specified names
   [:named? {:optional true} :boolean]
   ;; for things that have a Table, e.g. a Field
   [:table {:optional true} [:maybe [:ref ::display-info]]]
   ;; these are derived from the `:lib/source`/`:metabase.lib.schema.metadata/column-source`, but instead of using
   ;; that value directly we're returning a different property so the FE doesn't break if we change those keys in the
   ;; future, e.g. if we consolidate or split some of those keys. This is all the FE really needs to know.
   ;;
   ;; if this is a Column, does it come from a previous stage?
   [:is-from-previous-stage {:optional true} [:maybe :boolean]]
   ;; if this is a Column, does it come from a join in this stage?
   [:is-from-join {:optional true} [:maybe :boolean]]
   ;; if this is a Column, is it 'calculated', i.e. does it come from an expression in this stage?
   [:is-calculated {:optional true} [:maybe :boolean]]
   ;; if this is a Column, is it an implicitly joinable one? I.e. is it from a different table that we have not
   ;; already joined, but could implicitly join against?
   [:is-implicitly-joinable {:optional true} [:maybe :boolean]]
   ;; For the `:table` field of a Column, is this the source table, or a joined table?
   [:is-source-table {:optional true} [:maybe :boolean]]
   ;; does this column occur in the breakout clause?
   [:is-breakout-column {:optional true} [:maybe :boolean]]
   ;; does this column occur in the order-by clause?
   [:is-order-by-column {:optional true} [:maybe :boolean]]
   ;; for joins
   [:name {:optional true} :string]
   ;; for aggregation operators
   [:column-name {:optional true} :string]
   [:description {:optional true} :string]
   [:short-name {:optional true} :string]
   [:requires-column {:optional true} :boolean]
   [:selected {:optional true} :boolean]
   ;; for binning and bucketing
   [:default {:optional true} :boolean]
   ;; for order by
   [:direction {:optional true} [:enum :asc :desc]]])
(mu/defn display-info :- ::display-info
  "Given some sort of Cljs object, return a map with the info you'd need to implement UI for it. This is mostly meant to
  power the Frontend JavaScript UI; in JS, results will be converted to plain JavaScript objects, so avoid returning
  things that should remain opaque."
  ([query x]
   (display-info query -1 x))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    x]
   (lib.cache/side-channel-cache
     ;; TODO: Caching by stage here is probably unnecessary - it's already a mistake to have an `x` from a different
     ;; stage than `stage-number`. But it also doesn't hurt much, since a given `x` will only ever have `display-info`
     ;; called with one `stage-number` anyway.
     (keyword "display-info" (str "stage-" stage-number)) x
     (fn [x]
       (try
         (display-info-method query stage-number x)
         (catch #?(:clj Throwable :cljs js/Error) e
           (throw (ex-info (i18n/tru "Error calculating display info for {0}: {1}"
                                     (lib.dispatch/dispatch-value x)
                                     (ex-message e))
                           {:query query, :stage-number stage-number, :x x}
                           e))))))))

Default implementation of [[display-info-method]], available in case you want to use this in a different implementation and add additional information to it.

(defn default-display-info
  [query stage-number x]
  (let [x-metadata (metadata query stage-number x)]
    (merge
     ;; TODO -- not 100% convinced the FE should actually have access to `:name`, can't it use `:display-name`
     ;; everywhere? Determine whether or not this is the case.
     (select-keys x-metadata [:name :display-name :semantic-type])
     (when-let [custom (lib.util/custom-name x)]
       {:display-name custom
        :named? true})
     (when-let [long-display-name (display-name query stage-number x :long)]
       {:long-display-name long-display-name})
     ;; don't return `:base-type`, FE should just use `:effective-type` everywhere and not even need to know
     ;; `:base-type` exists.
     (when-let [effective-type ((some-fn :effective-type :base-type) x-metadata)]
       {:effective-type effective-type})
     (when-let [table-id (:table-id x-metadata)]
       ;; TODO: only ColumnMetadatas should possibly have legacy `card__<id>` `:table-id`s... we should
       ;; probably move this special casing into [[metabase.lib.field]] instead of having it be part of the
       ;; `:default` method.
       (when-let [inner-metadata (cond
                                   (integer? table-id) (lib.metadata/table query table-id)
                                   (string? table-id)  (lib.metadata/card
                                                         query (lib.util/legacy-string-table-id->card-id table-id)))]
         {:table (display-info query stage-number inner-metadata)}))
     (when-let [source (:lib/source x-metadata)]
       {:is-from-previous-stage (= source :source/previous-stage)
        :is-from-join           (= source :source/joins)
        :is-calculated          (= source :source/expressions)
        :is-implicitly-joinable (= source :source/implicitly-joinable)
        :is-aggregation         (= source :source/aggregations)
        :is-breakout            (= source :source/breakouts)})
     (when-some [selected (:selected? x-metadata)]
       {:selected selected})
     (select-keys x-metadata [:breakout-position :order-by-position :filter-positions]))))
(defmethod display-info-method :default
  [query stage-number x]
  (default-display-info query stage-number x))
(defmethod display-info-method :metadata/table
  [query stage-number table]
  (merge (default-display-info query stage-number table)
         {:is-source-table (= (lib.util/source-table-id query) (:id table))}))

Schema for the column metadata that should be returned by [[metadata]].

(def ColumnMetadataWithSource
  [:merge
   [:ref ::lib.schema.metadata/column]
   [:map
    [:lib/source ::lib.schema.metadata/column-source]]])

Schema for column metadata that should be returned by [[visible-columns]]. This is mostly used to power metadata calculation for stages (see [[metabase.lib.stage]].

(def ColumnsWithUniqueAliases
  [:and
   [:sequential
    [:merge
     ColumnMetadataWithSource
     [:map
      [:lib/source-column-alias  ::lib.schema.common/non-blank-string]
      [:lib/desired-column-alias [:string {:min 1, :max 60}]]]]]
   [:fn
    ;; should be dev-facing only, so don't need to i18n
    {:error/message "Column :lib/desired-column-alias values must be distinct, regardless of case, for each stage!"
     :error/fn      (fn [{:keys [value]} _]
                      (str "Column :lib/desired-column-alias values must be distinct, got: "
                           (pr-str (mapv :lib/desired-column-alias value))))}
    (fn [columns]
      (or
       (empty? columns)
       (apply distinct? (map (comp u/lower-case-en :lib/desired-column-alias) columns))))]])
(def ^:private UniqueNameFn
  [:=>
   [:cat ::lib.schema.common/non-blank-string]
   ::lib.schema.common/non-blank-string])

Schema for options passed to [[returned-columns]] and [[returned-columns-method]].

(def ReturnedColumnsOptions
  [:map
   ;; has the signature (f str) => str
   [:unique-name-fn {:optional true} UniqueNameFn]])
(mu/defn ^:private default-returned-columns-options :- ReturnedColumnsOptions
  []
  {:unique-name-fn (lib.util/unique-name-generator)})

Impl for [[returned-columns]].

(defmulti returned-columns-method
  {:arglists '([query stage-number x options])}
  (fn [_query _stage-number x _options]
    (lib.dispatch/dispatch-value x))
  :hierarchy lib.hierarchy/hierarchy)
(defmethod returned-columns-method :dispatch-type/nil
  [_query _stage-number _x _options]
  [])
(mu/defn returned-columns :- [:maybe ColumnsWithUniqueAliases]
  "Return a sequence of metadata maps for all the columns expected to be 'returned' at a query, stage of the query, or
  join, and include the `:lib/source` of where they came from. This should only include columns that will be present
  in the results; DOES NOT include 'expected' columns that are not 'exported' to subsequent stages.
  See [[ReturnedColumnsOptions]] for allowed options and [[default-returned-columns-options]] for default values."
  ([query]
   (returned-columns query (lib.util/query-stage query -1)))
  ([query x]
   (returned-columns query -1 x))
  ([query stage-number x]
   (returned-columns query stage-number x nil))
  ([query          :- ::lib.schema/query
    stage-number   :- :int
    x
    options        :- [:maybe ReturnedColumnsOptions]]
   (let [options (merge (default-returned-columns-options) options)]
     (returned-columns-method query stage-number x options))))

Schema for options passed to [[visible-columns]] and [[visible-columns-method]].

(def VisibleColumnsOptions
  [:merge
   ReturnedColumnsOptions
   [:map
    ;; these all default to true
    [:include-joined?                              {:optional true} :boolean]
    [:include-expressions?                         {:optional true} :boolean]
    [:include-implicitly-joinable?                 {:optional true} :boolean]
    [:include-implicitly-joinable-for-source-card? {:optional true} :boolean]]])
(mu/defn ^:private default-visible-columns-options :- VisibleColumnsOptions
  []
  (merge
   (default-returned-columns-options)
   {:include-joined?                              true
    :include-expressions?                         true
    :include-implicitly-joinable?                 true
    :include-implicitly-joinable-for-source-card? true}))

Impl for [[visible-columns]].

This should mostly be similar to the implementation for [[metadata-method]], but needs to include :lib/source-column-alias and :lib/desired-column-alias. :lib/source-column-alias should probably be the same as :name; use the supplied :unique-name-fn from options with the signature (f str) => str to ensure :lib/desired-column-alias is unique.

Also, columns that aren't 'projected' should be returned as well -- in other words, ignore :fields, :aggregations, and :breakouts.

(defmulti visible-columns-method
  {:arglists '([query stage-number x options])}
  (fn [_query _stage-number x _options]
    (lib.dispatch/dispatch-value x))
  :hierarchy lib.hierarchy/hierarchy)
(defmethod visible-columns-method :dispatch-type/nil
  [_query _stage-number _x _options]
  [])

default impl is just the impl for [[returned-columns-method]]

(defmethod visible-columns-method :default
  [query stage-number x options]
  (returned-columns-method query stage-number x options))
(mu/defn visible-columns :- ColumnsWithUniqueAliases
  "Return a sequence of columns that should be visible *within* a given stage of something, e.g. a query stage or a
  join query. This includes not just the columns that get returned (ones present in [[metadata]], but other columns
  that are 'reachable' in this stage of the query. E.g. in a query like
    SELECT id, name
    FROM table
    ORDER BY position
  only `id` and `name` are 'returned' columns, but other columns such as `position` are visible in this stage as well
  and would thus be returned by this function.
  Columns from joins, expressions, and implicitly joinable columns are included automatically by default;
  see [[VisibleColumnsOptions]] for the options for disabling these columns."
  ([query]
   (visible-columns query (lib.util/query-stage query -1)))
  ([query x]
   (visible-columns query -1 x))
  ([query stage-number x]
   (visible-columns query stage-number x nil))
  ([query          :- ::lib.schema/query
    stage-number   :- :int
    x
    options        :- [:maybe VisibleColumnsOptions]]
   (let [options (merge (default-visible-columns-options) options)]
     (visible-columns-method query stage-number x options))))
(mu/defn primary-keys :- [:sequential ::lib.schema.metadata/column]
  "Returns a list of primary keys for the source table of this query."
  [query        :- ::lib.schema/query]
  (if-let [table-id (lib.util/source-table-id query)]
    (filter lib.types.isa/primary-key? (lib.metadata/fields query table-id))
    []))

Columns that are implicitly joinable from some other columns in column-metadatas. To be joinable, the column has to have appropriate FK metadata, i.e. have an :fk-target-field-id pointing to another Field. (I think we only include this information for Databases that support FKs and joins, so I don't think we need to do an additional DB feature check here.)

Does not include columns from any Tables that are already explicitly joined.

Does not include columns that would be implicitly joinable via multiple hops.

(defn implicitly-joinable-columns
  [query stage-number column-metadatas unique-name-fn]
  (let [existing-table-ids (into #{} (map :table-id) column-metadatas)]
    (into []
          (comp (filter :fk-target-field-id)
                (map (fn [{source-field-id :id, :keys [fk-target-field-id] :as source}]
                       (-> (lib.metadata/field query fk-target-field-id)
                           (assoc ::source-field-id source-field-id
                                  ::source-join-alias (:metabase.lib.join/join-alias source)))))
                (remove #(contains? existing-table-ids (:table-id %)))
                (mapcat (fn [{:keys [table-id], ::keys [source-field-id source-join-alias]}]
                          (let [table-metadata (lib.metadata/table query table-id)
                                options        {:unique-name-fn               unique-name-fn
                                                :include-implicitly-joinable? false}]
                            (for [field (visible-columns-method query stage-number table-metadata options)
                                  :let  [field (assoc field
                                                      :fk-field-id              source-field-id
                                                      :fk-join-alias            source-join-alias
                                                      :lib/source               :source/implicitly-joinable
                                                      :lib/source-column-alias  (:name field))]]
                              (assoc field :lib/desired-column-alias (unique-name-fn
                                                                      (lib.join.util/desired-alias query field))))))))
          column-metadatas)))
(mu/defn default-columns-for-stage :- ColumnsWithUniqueAliases
  "Given a query and stage, returns the columns which would be selected by default.
  This is exactly [[lib.metadata.calculation/returned-columns]] filtered by the `:lib/source`.
  (Fields from explicit joins are listed on the join itself and should not be listed in `:fields`.)
  If there is already a `:fields` list on that stage, it is ignored for this calculation."
  [query        :- ::lib.schema/query
   stage-number :- :int]
  (let [no-fields (lib.util/update-query-stage query stage-number dissoc :fields)]
    (into [] (remove (comp #{:source/joins :source/implicitly-joinable}
                           :lib/source))
          (returned-columns no-fields stage-number (lib.util/query-stage no-fields stage-number)))))
 
(ns metabase.lib.metadata.composed-provider
  (:require
   [clojure.core.protocols]
   [clojure.datafy :as datafy]
   [medley.core :as m]
   [metabase.lib.metadata.protocols :as metadata.protocols]))
(defn- cached-providers [providers]
  (filter #(satisfies? metadata.protocols/CachedMetadataProvider %)
          providers))
(defn- object-for-id [f id metadata-providers]
  (some (fn [provider]
          (f provider id))
        metadata-providers))
(defn- objects-for-table-id [f table-id metadata-providers]
  (into []
        (comp
         (mapcat (fn [provider]
                   (f provider table-id)))
         (m/distinct-by :id))
        metadata-providers))

A metadata provider composed of several different metadata-providers. Methods try each constituent provider in turn from left to right until one returns a truthy result.

(defn composed-metadata-provider
  [& metadata-providers]
  (reify
    metadata.protocols/MetadataProvider
    (database [_this]              (some metadata.protocols/database metadata-providers))
    (table    [_this table-id]     (object-for-id metadata.protocols/table   table-id     metadata-providers))
    (field    [_this field-id]     (object-for-id metadata.protocols/field   field-id     metadata-providers))
    (card     [_this card-id]      (object-for-id metadata.protocols/card    card-id      metadata-providers))
    (metric   [_this metric-id]    (object-for-id metadata.protocols/metric  metric-id    metadata-providers))
    (segment  [_this segment-id]   (object-for-id metadata.protocols/segment segment-id   metadata-providers))
    (setting  [_this setting-name] (object-for-id metadata.protocols/setting setting-name metadata-providers))
    (tables   [_this]              (m/distinct-by :id (mapcat metadata.protocols/tables metadata-providers)))
    (fields   [_this table-id]     (objects-for-table-id metadata.protocols/fields   table-id metadata-providers))
    (metrics  [_this table-id]     (objects-for-table-id metadata.protocols/metrics  table-id metadata-providers))
    (segments [_this table-id]     (objects-for-table-id metadata.protocols/segments table-id metadata-providers))
    metadata.protocols/CachedMetadataProvider
    (cached-database [_this]
      (some metadata.protocols/cached-database
            (cached-providers metadata-providers)))
    (cached-metadata [_this metadata-type id]
      (some #(metadata.protocols/cached-metadata % metadata-type id)
            (cached-providers metadata-providers)))
    (store-database! [_this database-metadata]
      (when-first [provider (cached-providers metadata-providers)]
        (metadata.protocols/store-database! provider database-metadata)))
    (store-metadata! [_this metadata-type id metadata]
      (when-first [provider (cached-providers metadata-providers)]
        (metadata.protocols/store-metadata! provider metadata-type id metadata)))
    clojure.core.protocols/Datafiable
    (datafy [_this]
      (cons `composed-metadata-provider (map datafy/datafy metadata-providers)))))
 

Implementation(s) of [[metabase.lib.metadata.protocols/MetadataProvider]] only for the JVM.

(ns metabase.lib.metadata.jvm
  (:require
   [clojure.string :as str]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.cached-provider :as lib.metadata.cached-provider]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.models.interface :as mi]
   [metabase.models.setting :as setting]
   [metabase.plugins.classloader :as classloader]
   [metabase.util :as u]
   [metabase.util.malli :as mu]
   [metabase.util.snake-hating-map :as u.snake-hating-map]
   [methodical.core :as methodical]
   [potemkin :as p]
   [pretty.core :as pretty]
   #_{:clj-kondo/ignore [:discouraged-namespace]}
   [toucan2.core :as t2]
   [toucan2.model :as t2.model]
   [toucan2.pipeline :as t2.pipeline]
   [toucan2.query :as t2.query]))
(set! *warn-on-reflection* true)
(defn- qualified-key? [k]
  (or (qualified-keyword? k)
      (str/includes? k ".")))

Calculating the kebab-case version of a key every time is pretty slow (even with the LRU caching [[u/->kebab-case-en]] has), since the keys here are static and finite we can just memoize them forever and get a nice performance boost.

(def ^:private ^{:arglists '([k])} memoized-kebab-key
  ;; we spent a lot of time messing around with different ways of doing this and this seems to be the fastest. See
  ;; https://metaboat.slack.com/archives/C04CYTEL9N2/p1702671632956539 -- Cam
  (let [cache      (java.util.concurrent.ConcurrentHashMap.)
        mapping-fn (reify java.util.function.Function
                     (apply [_this k]
                       (u/->kebab-case-en k)))]
    (fn [k]
      (.computeIfAbsent cache k mapping-fn))))

Convert a (presumably) Toucan 2 instance of an application database model with snake_case keys to a MLv2 style metadata instance with :lib/type and kebab-case keys.

(defn instance->metadata
  [instance metadata-type]
  (-> instance
      (update-keys memoized-kebab-key)
      (assoc :lib/type metadata-type)
      u.snake-hating-map/snake-hating-map))

Database

(derive :metadata/database :model/Database)
(methodical/defmethod t2.model/resolve-model :metadata/database
  [model]
  (classloader/require 'metabase.models.database)
  model)
(methodical/defmethod t2.pipeline/build [#_query-type     :toucan.query-type/select.*
                                         #_model          :metadata/database
                                         #_resolved-query clojure.lang.IPersistentMap]
  [query-type model parsed-args honeysql]
  (merge (next-method query-type model parsed-args honeysql)
         {:select [:id :engine :name :dbms_version :settings :is_audit :details]}))
(t2/define-after-select :metadata/database
  [database]
  ;; ignore encrypted details that we cannot decrypt, because that breaks schema
  ;; validation
  (let [database (instance->metadata database :metadata/database)]
    (cond-> database
      (not (map? (:details database))) (dissoc :details))))

Table

(derive :metadata/table :model/Table)
(methodical/defmethod t2.model/resolve-model :metadata/table
  [model]
  (classloader/require 'metabase.models.table)
  model)
(methodical/defmethod t2.pipeline/build [#_query-type     :toucan.query-type/select.*
                                         #_model          :metadata/table
                                         #_resolved-query clojure.lang.IPersistentMap]
  [query-type model parsed-args honeysql]
  (merge (next-method query-type model parsed-args honeysql)
         {:select [:id :db_id :name :display_name :schema :active :visibility_type]}))
(t2/define-after-select :metadata/table
  [table]
  (instance->metadata table :metadata/table))

Field

(derive :metadata/column :model/Field)
(methodical/defmethod t2.model/resolve-model :metadata/column
  [model]
  (classloader/require 'metabase.models.dimension
                       'metabase.models.field
                       'metabase.models.field-values
                       'metabase.models.table)
  model)
(methodical/defmethod t2.model/model->namespace :metadata/column
  ":metadata/column joins Dimension and FieldValues by default; namespace their columns so we can distinguish them from
  the columns coming back from Field."
  [_model]
  {:model/Dimension   "dimension"
   :model/FieldValues "values"})
(methodical/defmethod t2.query/apply-kv-arg [#_model          :metadata/column
                                             #_resolved-query clojure.lang.IPersistentMap
                                             #_k              :default]
  "Qualify unqualified kv-args when fetching a `:metadata/column`."
  [model honeysql k v]
  (let [k (if (not (qualified-key? k))
            (keyword "field" (name k))
            k)]
    (next-method model honeysql k v)))
(methodical/defmethod t2.pipeline/build [#_query-type     :toucan.query-type/select.*
                                         #_model          :metadata/column
                                         #_resolved-query clojure.lang.IPersistentMap]
  [query-type model parsed-args honeysql]
  (merge
   (next-method query-type model parsed-args honeysql)
   {:select    [:field/base_type
                :field/coercion_strategy
                :field/database_type
                :field/description
                :field/display_name
                :field/effective_type
                :field/fingerprint
                :field/fk_target_field_id
                :field/id
                :field/name
                :field/nfc_path
                :field/parent_id
                :field/position
                :field/semantic_type
                :field/settings
                :field/table_id
                :field/visibility_type
                :dimension/human_readable_field_id
                :dimension/id
                :dimension/name
                :dimension/type
                :values/human_readable_values
                :values/values]
    :from      [[(t2/table-name :model/Field) :field]]
    :left-join [[(t2/table-name :model/Table) :table]
                [:= :field/table_id :table/id]
                [(t2/table-name :model/Dimension) :dimension]
                [:and
                 [:= :dimension/field_id :field/id]
                 [:inline [:in :dimension/type ["external" "internal"]]]]
                [(t2/table-name :model/FieldValues) :values]
                [:and
                 [:= :values/field_id :field/id]
                 [:= :values/type [:inline "full"]]]]}))
(t2/define-after-select :metadata/column
  [field]
  (let [field          (instance->metadata field :metadata/column)
        dimension-type (some-> (:dimension/type field) keyword)]
    (merge
     (dissoc field
             :dimension/human-readable-field-id :dimension/id :dimension/name :dimension/type
             :values/human-readable-values :values/values)
     (when (and (= dimension-type :external)
                (:dimension/human-readable-field-id field))
       {:lib/external-remap {:lib/type :metadata.column.remapping/external
                             :id       (:dimension/id field)
                             :name     (:dimension/name field)
                             :field-id (:dimension/human-readable-field-id field)}})
     (when (and (= dimension-type :internal)
                (:values/values field)
                (:values/human-readable-values field))
       {:lib/internal-remap {:lib/type              :metadata.column.remapping/internal
                             :id                    (:dimension/id field)
                             :name                  (:dimension/name field)
                             :values                (mi/json-out-with-keywordization
                                                     (:values/values field))
                             :human-readable-values (mi/json-out-without-keywordization
                                                     (:values/human-readable-values field))}}))))

Card

(derive :metadata/card :model/Card)
(methodical/defmethod t2.model/resolve-model :metadata/card
  [model]
  (classloader/require 'metabase.models.card
                       'metabase.models.persisted-info)
  model)
(methodical/defmethod t2.model/model->namespace :metadata/card
  [_model]
  {:model/PersistedInfo "persisted"})
(methodical/defmethod t2.query/apply-kv-arg [#_model          :metadata/card
                                             #_resolved-query clojure.lang.IPersistentMap
                                             #_k              :default]
  [model honeysql k v]
  ()
  (let [k (if (not (qualified-key? k))
            (keyword "card" (name k))
            k)]
    (next-method model honeysql k v)))
(methodical/defmethod t2.pipeline/build [#_query-type     :toucan.query-type/select.*
                                         #_model          :metadata/card
                                         #_resolved-query clojure.lang.IPersistentMap]
  [query-type model parsed-args honeysql]
  (merge
   (next-method query-type model parsed-args honeysql)
   {:select    [:card/collection_id
                :card/database_id
                :card/dataset
                :card/dataset_query
                :card/id
                :card/name
                :card/result_metadata
                :card/table_id
                :card/visualization_settings
                :persisted/active
                :persisted/state
                :persisted/definition
                :persisted/query_hash
                :persisted/table_name]
    :from      [[(t2/table-name :model/Card) :card]]
    :left-join [[(t2/table-name :model/PersistedInfo) :persisted]
                [:= :persisted/card_id :card/id]]}))
(defn- parse-persisted-info-definition [x]
  ((get-in (t2/transforms :model/PersistedInfo) [:definition :out] identity) x))
(t2/define-after-select :metadata/card
  [card]
  (let [card (instance->metadata card :metadata/card)]
    (merge
     (dissoc card :persisted/active :persisted/state :persisted/definition :persisted/query-hash :persisted/table-name)
     (when (:persisted/definition card)
       {:lib/persisted-info {:active     (:persisted/active card)
                             :state      (:persisted/state card)
                             :definition (parse-persisted-info-definition (:persisted/definition card))
                             :query-hash (:persisted/query-hash card)
                             :table-name (:persisted/table-name card)}}))))

Metric

(derive :metadata/metric :model/Metric)
(methodical/defmethod t2.model/resolve-model :metadata/metric
  [model]
  (classloader/require 'metabase.models.metric)
  model)
(methodical/defmethod t2.query/apply-kv-arg [#_model          :metadata/metric
                                             #_resolved-query clojure.lang.IPersistentMap
                                             #_k              :default]
  [model honeysql k v]
  (let [k (if (not (qualified-key? k))
            (keyword "metric" (name k))
            k)]
    (next-method model honeysql k v)))
(methodical/defmethod t2.pipeline/build [#_query-type     :toucan.query-type/select.*
                                         #_model          :metadata/metric
                                         #_resolved-query clojure.lang.IPersistentMap]
  [query-type model parsed-args honeysql]
  (merge
   (next-method query-type model parsed-args honeysql)
   {:select    [:metric/id
                :metric/table_id
                :metric/name
                :metric/description
                :metric/archived
                :metric/definition]
    :from      [[(t2/table-name :model/Metric) :metric]]
    :left-join [[(t2/table-name :model/Table) :table]
                [:= :metric/table_id :table/id]]}))
(t2/define-after-select :metadata/metric
  [metric]
  (instance->metadata metric :metadata/metric))

Segment

(derive :metadata/segment :model/Segment)
(methodical/defmethod t2.model/resolve-model :metadata/segment
  [model]
  (classloader/require 'metabase.models.segment
                       'metabase.models.table)
  model)
(methodical/defmethod t2.query/apply-kv-arg [#_model          :metadata/segment
                                             #_resolved-query clojure.lang.IPersistentMap
                                             #_k              :default]
  [model honeysql k v]
  (let [k (if (not (qualified-key? k))
            (keyword "segment" (name k))
            k)]
    (next-method model honeysql k v)))
(methodical/defmethod t2.pipeline/build [#_query-type     :toucan.query-type/select.*
                                         #_model          :metadata/segment
                                         #_resolved-query clojure.lang.IPersistentMap]
  [query-type model parsed-args honeysql]
  (merge
   (next-method query-type model parsed-args honeysql)
   {:select    [:segment/id
                :segment/table_id
                :segment/name
                :segment/description
                :segment/archived
                :segment/definition]
    :from      [[(t2/table-name :model/Segment) :segment]]
    :left-join [[(t2/table-name :model/Table) :table]
                [:= :segment/table_id :table/id]]}))
(t2/define-after-select :metadata/segment
  [segment]
  (instance->metadata segment :metadata/segment))

MetadataProvider

(p/deftype+ UncachedApplicationDatabaseMetadataProvider [database-id]
  lib.metadata.protocols/MetadataProvider
  (database [_this]
    (when-not database-id
      (throw (ex-info (format "Cannot use %s with %s with a nil Database ID"
                              `lib.metadata.protocols/database
                              `UncachedApplicationDatabaseMetadataProvider)
                      {})))
    (t2/select-one :metadata/database database-id))
  (table   [_this table-id]   (t2/select-one :metadata/table   :id table-id   :db_id       database-id))
  (field   [_this field-id]   (t2/select-one :metadata/column  :id field-id   :table/db_id database-id))
  (card    [_this card-id]    (t2/select-one :metadata/card    :id card-id    :database_id database-id))
  (metric  [_this metric-id]  (t2/select-one :metadata/metric  :id metric-id  :table/db_id database-id))
  (segment [_this segment-id] (t2/select-one :metadata/segment :id segment-id :table/db_id database-id))
  (tables [_this]
    (t2/select :metadata/table
               :db_id           database-id
               :active          true
               :visibility_type [:not-in #{"hidden" "technical" "cruft"}]))
  (fields [_this table-id]
    (t2/select :metadata/column
               :table_id        table-id
               :active          true
               :visibility_type [:not-in #{"sensitive" "retired"}]))
  (metrics [_this table-id]
    (t2/select :metadata/metric :table_id table-id, :archived false))
  (segments [_this table-id]
    (t2/select :metadata/segment :table_id table-id, :archived false))
  (setting [_this setting-name]
    (setting/get setting-name))
  lib.metadata.protocols/BulkMetadataProvider
  (bulk-metadata [_this metadata-type ids]
    (let [database-id-key (case metadata-type
                            :metadata/table :db_id
                            :metadata/card  :database_id
                            :table/db_id)]
      (when (seq ids)
        (t2/select metadata-type
                   database-id-key database-id
                   :id             [:in (set ids)]))))
  pretty/PrettyPrintable
  (pretty [_this]
    (list `->UncachedApplicationDatabaseMetadataProvider database-id)))
(mu/defn application-database-metadata-provider :- lib.metadata/MetadataProvider
  "An implementation of [[metabase.lib.metadata.protocols/MetadataProvider]] for the application database.
  The application database metadata provider implements both of the optional
  protocols, [[metabase.lib.metadata.protocols/CachedMetadataProvider]]
  and [[metabase.lib.metadata.protocols/BulkMetadataProvider]]. All operations are cached; so you can use the bulk
  operations to pre-warm the cache if you need to."
  [database-id :- ::lib.schema.id/database]
  (lib.metadata.cached-provider/cached-metadata-provider
   (->UncachedApplicationDatabaseMetadataProvider database-id)))
 

A Metric is a saved MBQL query stage snippet with EXACTLY ONE :aggregation and optionally a :filter (boolean) expression. Can be passed into the :aggregations list.

(ns metabase.lib.metric
  (:require
   [metabase.lib.convert :as lib.convert]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.lib.ref :as lib.ref]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.expression :as lib.schema.expression]
   [metabase.lib.util :as lib.util]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util.malli :as mu]))
(defn- resolve-metric [query metric-id]
  (when (integer? metric-id)
    (lib.metadata/metric query metric-id)))
(mu/defn ^:private metric-definition :- [:maybe ::lib.schema/stage.mbql]
  [{:keys [definition], :as _metric-metadata} :- lib.metadata/MetricMetadata]
  (when definition
    (if (:mbql/type definition)
      definition
      ;; legacy; needs conversion
      (->
        ;; database-id cannot be nil, but gets thrown out
        (lib.convert/legacy-query-from-inner-query #?(:clj Integer/MAX_VALUE :cljs js/Number.MAX_SAFE_INTEGER) definition)
        mbql.normalize/normalize
        lib.convert/->pMBQL
        (lib.util/query-stage -1)))))
(defmethod lib.ref/ref-method :metadata/metric
  [{:keys [id], :as metric-metadata}]
  (let [effective-type (or (:effective-type metric-metadata)
                           (:base-type metric-metadata)
                           (when-let [aggregation (first (:aggregation (metric-definition metric-metadata)))]
                             (let [ag-effective-type (lib.schema.expression/type-of aggregation)]
                               (when (isa? ag-effective-type :type/*)
                                 ag-effective-type))))
        options (cond-> {:lib/uuid (str (random-uuid))}
                  effective-type (assoc :effective-type effective-type))]
    [:metric options id]))
(defmethod lib.metadata.calculation/type-of-method :metadata/metric
  [query stage-number metric-metadata]
  (or
   (when-let [[aggregation] (not-empty (:aggregation (metric-definition metric-metadata)))]
     (lib.metadata.calculation/type-of query stage-number aggregation))
   :type/*))
(defmethod lib.metadata.calculation/type-of-method :metric
  [query stage-number [_tag _opts metric-id-or-name]]
  (or (when-let [metric-metadata (resolve-metric query metric-id-or-name)]
        (lib.metadata.calculation/type-of query stage-number metric-metadata))
      :type/*))
(defn- fallback-display-name []
  (i18n/tru "[Unknown Metric]"))
(defmethod lib.metadata.calculation/display-name-method :metadata/metric
  [_query _stage-number metric-metadata _style]
  (or ((some-fn :display-name :name) metric-metadata)
      (fallback-display-name)))
(defmethod lib.metadata.calculation/display-name-method :metric
  [query stage-number [_tag _opts metric-id-or-name] style]
  (or (when-let [metric-metadata (resolve-metric query metric-id-or-name)]
        (lib.metadata.calculation/display-name query stage-number metric-metadata style))
      (fallback-display-name)))
(defmethod lib.metadata.calculation/display-info-method :metadata/metric
  [query stage-number metric-metadata]
  (merge
   ((get-method lib.metadata.calculation/display-info-method :default) query stage-number metric-metadata)
   (select-keys metric-metadata [:description :aggregation-position])))
(defmethod lib.metadata.calculation/display-info-method :metric
  [query stage-number [_tag _opts metric-id-or-name]]
  (if-let [metric-metadata (resolve-metric query metric-id-or-name)]
    (lib.metadata.calculation/display-info query stage-number metric-metadata)
    {:effective-type    :type/*
     :display-name      (fallback-display-name)
     :long-display-name (fallback-display-name)}))
(defmethod lib.metadata.calculation/column-name-method :metric
  [query stage-number [_tag _opts metric-id-or-name]]
  (or (when-let [metric-metadata (resolve-metric query metric-id-or-name)]
        (lib.metadata.calculation/column-name query stage-number metric-metadata))
      "metric"))
(mu/defn available-metrics :- [:maybe [:sequential {:min 1} lib.metadata/MetricMetadata]]
  "Get a list of Metrics that you may consider using as aggregations for a query. Only Metrics that have the same
  `table-id` as the `source-table` for this query will be suggested."
  ([query]
   (available-metrics query -1))
  ([query :- ::lib.schema/query
    stage-number :- :int]
   (when-let [source-table-id (lib.util/source-table-id query)]
     (let [metrics (lib.metadata.protocols/metrics (lib.metadata/->metadata-provider query) source-table-id)
           metric-aggregations (into {}
                                     (keep-indexed (fn [index aggregation-clause]
                                                     (when (lib.util/clause-of-type? aggregation-clause :metric)
                                                       [(get aggregation-clause 2) index])))
                                     (:aggregation (lib.util/query-stage query stage-number)))]
       (cond
         (empty? metrics)             nil
         (empty? metric-aggregations) (vec metrics)
         :else                        (mapv (fn [metric-metadata]
                                              (let [aggregation-pos (-> metric-metadata :id metric-aggregations)]
                                                (cond-> metric-metadata
                                                  aggregation-pos (assoc :aggregation-position aggregation-pos))))
                                            metrics))))))
 

Functions for working with native queries.

(ns metabase.lib.native
  (:require
   [clojure.set :as set]
   [clojure.string :as str]
   [medley.core :as m]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.query :as lib.query]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.common :as common]
   [metabase.lib.schema.template-tag :as lib.schema.template-tag]
   [metabase.lib.util :as lib.util]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util.humanization :as u.humanization]
   [metabase.util.malli :as mu]
   [metabase.util.malli.registry :as mr]))
(def ^:private variable-tag-regex
  #"\{\{\s*([A-Za-z0-9_\.]+)\s*\}\}")
(def ^:private snippet-tag-regex
  #"\{\{\s*(snippet:\s*[^}]+)\s*\}\}")
(def ^:private card-tag-regex
  #"\{\{\s*(#([0-9]*)(-[a-z0-9-]*)?)\s*\}\}")
(def ^:private tag-regexes
  [variable-tag-regex snippet-tag-regex card-tag-regex])
(mu/defn ^:private recognize-template-tags :- [:set ::common/non-blank-string]
  "Given the text of a native query, extract a possibly-empty set of template tag strings from it."
  [query-text :- ::common/non-blank-string]
  (into #{}
        (comp (mapcat #(re-seq % query-text))
              (map second))
        tag-regexes))
(defn- tag-name->card-id [tag-name]
  (when-let [[_ id-str] (re-matches #"^#(\d+)(-[a-z0-9-]*)?$" tag-name)]
    (parse-long id-str)))
(defn- tag-name->snippet-name [tag-name]
  (when (str/starts-with? tag-name "snippet:")
    (str/trim (subs tag-name (count "snippet:")))))
(defn- fresh-tag [tag-name]
  {:type :text
   :name tag-name
   :id   (str (random-uuid))})
(defn- finish-tag [{tag-name :name :as tag}]
  (merge tag
         (when-let [card-id (tag-name->card-id tag-name)]
           {:type    :card
            :card-id card-id})
         (when-let [snippet-name (tag-name->snippet-name tag-name)]
           {:type         :snippet
            :snippet-name snippet-name})
         (when-not (:display-name tag)
           {:display-name (u.humanization/name->human-readable-name :simple tag-name)})))
(defn- rename-template-tag
  [existing-tags old-name new-name]
  (let [old-tag       (get existing-tags old-name)
        display-name  (if (= (:display-name old-tag)
                             (u.humanization/name->human-readable-name :simple old-name))
                        ;; Replace the display name if it was the default; keep it if customized.
                        (u.humanization/name->human-readable-name :simple new-name)
                        (:display-name old-tag))
        new-tag       (-> old-tag
                          (dissoc :snippet-name :card-id :snippet-id)
                          (assoc :display-name display-name
                                 :name         new-name))]
    (-> existing-tags
        (dissoc old-name)
        (assoc new-name new-tag))))
(defn- unify-template-tags
  [query-tag-names existing-tags existing-tag-names]
  (let [new-tags (set/difference query-tag-names existing-tag-names)
        old-tags (set/difference existing-tag-names query-tag-names)
        tags     (if (= 1 (count new-tags) (count old-tags))
                   ;; With exactly one change, we treat it as a rename.
                   (rename-template-tag existing-tags (first old-tags) (first new-tags))
                   ;; With more than one change, just drop the old ones and add the new.
                   (merge (m/remove-keys old-tags existing-tags)
                          (m/index-by :name (map fresh-tag new-tags))))]
    (update-vals tags finish-tag)))
(mu/defn extract-template-tags :- ::lib.schema.template-tag/template-tag-map
  "Extract the template tags from a native query's text.
  If the optional map of existing tags previously parsed is given, this will reuse the existing tags where
  they match up with the new one (in particular, it will preserve the UUIDs).
  Given the text of a native query, extract a possibly-empty set of template tag strings from it.
  These looks like mustache templates. For variables, we only allow alphanumeric characters, eg. `{{foo}}`.
  For snippets they start with `snippet:`, eg. `{{ snippet: arbitrary text here }}`.
  And for card references either `{{ #123 }}` or with the optional human label `{{ #123-card-title-slug }}`.
  Invalid patterns are simply ignored, so something like `{{&foo!}}` is just disregarded."
  ([query-text :- ::common/non-blank-string]
   (extract-template-tags query-text nil))
  ([query-text    :- ::common/non-blank-string
    existing-tags :- [:maybe ::lib.schema.template-tag/template-tag-map]]
   (let [query-tag-names    (not-empty (recognize-template-tags query-text))
         existing-tag-names (not-empty (set (keys existing-tags)))]
     (if (or query-tag-names existing-tag-names)
       ;; If there's at least some tags, unify them.
       (unify-template-tags query-tag-names existing-tags existing-tag-names)
       ;; Otherwise just an empty map, no tags.
       {}))))
(defn- assert-native-query! [stage]
  (assert (= (:lib/type stage) :mbql.stage/native) (i18n/tru "Must be a native query")))
(def ^:private all-native-extra-keys
  #{:collection})
(mr/def ::native-extras
  [:map
   [:collection {:optional true} ::common/non-blank-string]])
(mu/defn required-native-extras :- set?
  "Returns the extra keys that are required for this database's native queries, for example `:collection` name is
  needed for MongoDB queries."
  [metadata-provider :- lib.metadata/MetadataProviderable]
  (let [db (lib.metadata/database metadata-provider)]
   (cond-> #{}
    (get-in db [:features :native-requires-specified-collection])
    (conj :collection))))
(mu/defn with-native-extras :- ::lib.schema/query
  "Updates the extras required for the db to run this query.
   The first stage must be a native type. Will ignore extras not in `required-native-extras`"
  [query :- ::lib.schema/query
   native-extras :- [:maybe ::native-extras]]
  (let [required-extras (required-native-extras query)]
    (lib.util/update-query-stage
      query 0
      (fn [stage]
        (let [extras-to-remove (set/difference all-native-extra-keys required-extras)
              stage-without-old-extras (apply dissoc stage extras-to-remove)
              result (merge stage-without-old-extras (select-keys native-extras required-extras))
              missing-keys (set/difference required-extras (set (keys native-extras)))]
          (assert-native-query! (lib.util/query-stage query 0))
          (assert (empty? missing-keys)
                  (i18n/tru "Missing extra, required keys for native query: {0}"
                            (pr-str missing-keys)))
          result)))))
(mu/defn native-query :- ::lib.schema/query
  "Create a new native query.
  Native in this sense means a pMBQL query with a first stage that is a native query."
  ([metadata-providerable :- lib.metadata/MetadataProviderable
    inner-query :- ::common/non-blank-string]
   (native-query metadata-providerable inner-query nil nil))
  ([metadata-providerable :- lib.metadata/MetadataProviderable
    inner-query :- ::common/non-blank-string
    results-metadata :- [:maybe lib.metadata/StageMetadata]
    native-extras :- [:maybe ::native-extras]]
   (let [tags (extract-template-tags inner-query)]
     (-> (lib.query/query-with-stages metadata-providerable
                                      [{:lib/type           :mbql.stage/native
                                        :lib/stage-metadata results-metadata
                                        :template-tags      tags
                                        :native             inner-query}])
         (with-native-extras native-extras)))))
(mu/defn with-different-database :- ::lib.schema/query
  "Changes the database for this query. The first stage must be a native type.
   Native extras must be provided if the new database requires it."
  ([query :- ::lib.schema/query
    metadata-provider :- lib.metadata/MetadataProviderable]
   (with-different-database query metadata-provider nil))
  ([query :- ::lib.schema/query
    metadata-provider :- lib.metadata/MetadataProviderable
    native-extras :- [:maybe ::native-extras]]
   (assert-native-query! (lib.util/query-stage query 0))
   ;; Changing the database should also clean up template tags, see #31926
   (-> (lib.query/query-with-stages metadata-provider (:stages query))
       (with-native-extras native-extras))))
(mu/defn native-extras :- [:maybe ::native-extras]
  "Returns the extra keys for native queries associated with this query."
  [query :- ::lib.schema/query]
  (not-empty (select-keys (lib.util/query-stage query 0) (required-native-extras query))))
(mu/defn with-native-query :- ::lib.schema/query
  "Update the raw native query, the first stage must already be a native type.
   Replaces templates tags"
  [query :- ::lib.schema/query
   inner-query :- ::common/non-blank-string]
  (lib.util/update-query-stage
    query 0
    (fn [{existing-tags :template-tags :as stage}]
      (assert-native-query! stage)
      (assoc stage
        :native inner-query
        :template-tags (extract-template-tags inner-query existing-tags)))))
(mu/defn with-template-tags :- ::lib.schema/query
  "Updates the native query's template tags."
  [query :- ::lib.schema/query
   tags :- ::lib.schema.template-tag/template-tag-map]
  (lib.util/update-query-stage
    query 0
    (fn [{existing-tags :template-tags :as stage}]
      (assert-native-query! stage)
      (let [valid-tags (keys existing-tags)]
        (assoc stage :template-tags
               (m/deep-merge existing-tags (select-keys tags valid-tags)))))))
(mu/defn raw-native-query :- ::common/non-blank-string
  "Returns the native query string"
  [query :- ::lib.schema/query]
  (:native (lib.util/query-stage query 0)))
(mu/defn template-tags :- ::lib.schema.template-tag/template-tag-map
  "Returns the native query's template tags"
  [query :- ::lib.schema/query]
  (:template-tags (lib.util/query-stage query 0)))
(mu/defn has-write-permission :- :boolean
  "Returns whether the database has native write permissions.
   This is only filled in by [[metabase.api.database/add-native-perms-info]]
   and added to metadata when pulling a database from the list of dbs in js."
  [query :- ::lib.schema/query]
  (assert-native-query! (lib.util/query-stage query 0))
  (= :write (:native-permissions (lib.metadata/database query))))
(defmethod lib.query/can-run-method :mbql.stage/native
  [query]
  (and
    (set/subset? (required-native-extras query)
                 (set (keys (native-extras query))))
    (not (str/blank? (raw-native-query query)))))
(mu/defn engine :- :keyword
  "Returns the database engine.
   Must be a native query"
  [query :- ::lib.schema/query]
  (assert-native-query! (lib.util/query-stage query 0))
  (:engine (lib.metadata/database query)))
 
(ns metabase.lib.normalize
  (:require
   [metabase.lib.dispatch :as lib.dispatch]
   [metabase.lib.hierarchy :as lib.hierarchy]))
(defn- mbql-clause-type [x]
  (when (and (vector? x)
             ((some-fn keyword? string?) (first x)))
    (keyword (first x))))
(defn- map-type [m]
  (when (map? m)
    (some-> (or
             (:lib/type m)
             (get m "lib/type"))
            keyword)))
(defn- dispatch-value [x]
  (or
   (mbql-clause-type x)
   (map-type x)
   (keyword (lib.dispatch/dispatch-value x))))

Ensure some part of an MBQL query x, e.g. a clause or map, is in the right shape after coming in from JavaScript or deserialized JSON (from the app DB or a REST API request). This is intended for things that are already in a generally correct pMBQL; to 'normalize' things from legacy MBQL, use [[metabase.lib.convert]].

The default implementation will keywordize keys for maps, and convert some known keys using [[default-map-value-fns]]; for MBQL clauses, it will convert the clause name to a keyword and recursively normalize its options and arguments. Implement this method if you need custom behavior for something.

(defmulti normalize
  {:arglists '([x])}
  dispatch-value
  :hierarchy lib.hierarchy/hierarchy)

Default normalization functions keys when doing map normalization.

(def default-map-value-fns
  {:base-type      keyword
   :effective-type keyword
   :semantic-type  keyword
   :type           keyword
   ;; we can calculate `:field_ref` now using [[metabase.lib.ref/ref]]; `:field_ref` is wrong half of the time anyway,
   ;; so ignore it.
   :field_ref      (constantly ::do-not-use-me)
   :lib/type       keyword
   :lib/options    normalize})

[[normalize]] a map using key-fn (default [[clojure.core/keyword]]) for keys and value-fns (default [[default-map-value-fns]]; additional functions are merged into this map).

This is the default implementation for maps. Custom map implementations can call this with a different key-fn or additional value-fns as needed.

(defn normalize-map
  ([m]
   (normalize-map m keyword))
  ([m key-fn]
   (normalize-map m key-fn nil))
  ([m key-fn value-fns]
   (let [value-fns (merge default-map-value-fns value-fns)]
     (into {}
           (map (fn [[k v]]
                  (let [k (key-fn k)]
                    [k
                     (if-let [f (get value-fns k)]
                       (f v)
                       v)])))
           m))))
(defmethod normalize :dispatch-type/map
  [m]
  (normalize-map m))
(defn- default-normalize-mbql-clause [[tag opts & args]]
  (into [(keyword tag) (normalize opts)]
        (map normalize)
        args))
(defmethod normalize :default
  [x]
  (cond
    (mbql-clause-type x) (default-normalize-mbql-clause x)
    (map-type x)         (normalize-map x)
    :else                x))
(defn- maybe-normalize-token
  [expression k]
  (cond-> expression
    (string? (get expression k)) (update k keyword)))
(defmethod normalize :time-interval
  [[_ _ _ amount _unit :as expression]]
  (cond-> (default-normalize-mbql-clause expression)
    (= "current" amount) (update 3 keyword)
    :always (maybe-normalize-token 4)))
(defmethod normalize :relative-datetime
  [[_ _ amount _unit :as expression]]
  (cond-> (default-normalize-mbql-clause expression)
    (= "current" amount) (update 2 keyword)
    :always (maybe-normalize-token 3)))
(defmethod normalize :interval
  [expression]
  (-> (default-normalize-mbql-clause expression)
      (maybe-normalize-token 3)))
(defmethod normalize :datetime-add
  [expression]
  (-> (default-normalize-mbql-clause expression)
      (maybe-normalize-token 4)))
(defmethod normalize :datetime-subtract
  [expression]
  (-> (default-normalize-mbql-clause expression)
      (maybe-normalize-token 4)))
(defmethod normalize :get-week
  [expression]
  (-> (default-normalize-mbql-clause expression)
      (maybe-normalize-token 3)))
(defmethod normalize :temporal-extract
  [expression]
  (-> (default-normalize-mbql-clause expression)
      (maybe-normalize-token 3)
      (maybe-normalize-token 4)))
(defmethod normalize :datetime-diff
  [expression]
  (-> (default-normalize-mbql-clause expression)
      (maybe-normalize-token 4)))
 
(ns metabase.lib.options
  (:refer-clojure :exclude [uuid])
  (:require
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util :as u]
   [metabase.util.malli :as mu]))

TODO -- not 100% sure we actually need all of this stuff anymore.

(defn- mbql-clause? [x]
  (and (vector? x)
       (keyword? (first x))))
(mu/defn options :- [:maybe map?]
  "Return the Metabase lib options map associated with an `x`. Lib options is currently used mostly for
  the `:lib/uuid` we attach to everything to facilitate removing or replacing clauses later, but we will probably
  stick more stuff in here in the future. Some clauses like `:field` use options extensively for different things.
  Normally for an MBQL clause, options are an optional second argument, e.g.
    [:= {:lib/uuid \"03baa510-0415-48ef-987a-462d789c8a02\"} 1 2]
  a la Hiccup or Malli. The default implementation already knows how to handle clauses that follow this shape. For
  historic reasons some MBQL clauses like `:field` or some of the string filter clauses have options as the last
  argument; you'll have to implement this method, and [[with-options]], to deal with the special cases.
  For maps like join specs, options are currently stored under the `:lib/options` key. Does this make sense? Not sure.
  Maybe options should be included directly in the map, but then we'd have to decide which keys are and are not
  options. Is a join `:alias` an option? Probably. What about a `:condition`? It's not optional. So for purposes of
  writing Metabase lib and tracking `:lib/uuid`, this approach seems ok in the short term."
  [x]
  (cond
    (map? x)
    (:lib/options x)
    (mbql-clause? x)
    (when (map? (second x))
      (second x))
    :else
    nil))

Update x so its [[options]] are new-options. If the clause or map already has options, this will replace the old options; if it does not, this will set the new options.

If x is a map with :lib/options and new-options is empty?, this will drop :lib/options entirely.

You should probably prefer [[update-options]] to using this directly, so you don't stomp over existing stuff unintentionally. Implement this if you need to teach Metabase lib how to support something that doesn't follow the usual patterns described in [[options]].

(mu/defn with-options
  [x new-options :- [:maybe map?]]
  (cond
    (map? x)
    (u/assoc-dissoc x :lib/options (not-empty new-options))
    (mbql-clause? x)
    (if ((some-fn nil? map?) (second x))
      (assoc (vec x) 1 new-options)
      (into [(first x) new-options] (rest x)))
    :else
    (throw (ex-info (i18n/tru "Don''t know how to set options for {0}" (pr-str x))
                    {:x x}))))

Update the existing options in an x by applying f like this:

(apply f existing-options args)

(defn update-options
  [x f & args]
  (let [current-options (options x)
        new-options     (apply f current-options args)]
    (with-options x new-options)))

Check that x has a :lib/uuid in its [[options]]; generate a UUID and add it if it does not already have one.

(defn ensure-uuid
  [x]
  (update-options x (fn [options-map]
                      (cond-> options-map
                        (not (:lib/uuid options-map))
                        (assoc :lib/uuid (str (random-uuid)))))))
(mu/defn uuid :- [:maybe ::lib.schema.common/non-blank-string]
  "Get the `:lib/uuid` associated with something, e.g. an MBQL clause or join."
  [x]
  (:lib/uuid (options x)))
 
(ns metabase.lib.order-by
  (:require
   [metabase.lib.aggregation :as lib.aggregation]
   [metabase.lib.breakout :as lib.breakout]
   [metabase.lib.dispatch :as lib.dispatch]
   [metabase.lib.equality :as lib.equality]
   [metabase.lib.hierarchy :as lib.hierarchy]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.options :as lib.options]
   [metabase.lib.ref :as lib.ref]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.expression :as lib.schema.expression]
   [metabase.lib.schema.order-by :as lib.schema.order-by]
   [metabase.lib.util :as lib.util]
   [metabase.mbql.util.match :as mbql.u.match]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util.malli :as mu]))
(lib.hierarchy/derive :asc  ::order-by-clause)
(lib.hierarchy/derive :desc ::order-by-clause)
(defmethod lib.metadata.calculation/describe-top-level-key-method :order-by
  [query stage-number _k]
  (when-let [order-bys (not-empty (:order-by (lib.util/query-stage query stage-number)))]
    (i18n/tru "Sorted by {0}"
              (lib.util/join-strings-with-conjunction
               (i18n/tru "and")
               (for [order-by order-bys]
                 (lib.metadata.calculation/display-name query stage-number order-by :long))))))
(defmethod lib.metadata.calculation/display-name-method ::order-by-clause
  [query stage-number [tag _opts expr] style]
  (let [expr-display-name (lib.metadata.calculation/display-name query stage-number expr style)]
    (case tag
      :asc  (i18n/tru "{0} ascending"  expr-display-name)
      :desc (i18n/tru "{0} descending" expr-display-name))))
(defmethod lib.metadata.calculation/display-info-method ::order-by-clause
  [query stage-number [tag _opts expr]]
  (assoc (lib.metadata.calculation/display-info query stage-number expr)
         :direction tag))
(defmulti ^:private order-by-clause-method
  {:arglists '([orderable])}
  lib.dispatch/dispatch-value
  :hierarchy lib.hierarchy/hierarchy)
(defmethod order-by-clause-method ::order-by-clause
  [clause]
  (lib.options/ensure-uuid clause))

by default, try to convert x to a ref and then order by :asc

(defmethod order-by-clause-method :default
  [x]
  (when (nil? x)
    (throw (ex-info (i18n/tru "Can''t order by nil") {})))
  (lib.options/ensure-uuid [:asc (lib.ref/ref x)]))
(mu/defn ^:private with-direction :- ::lib.schema.order-by/order-by
  "Update the direction of an order by clause."
  [clause    :- ::lib.schema.order-by/order-by
   direction :- ::lib.schema.order-by/direction]
  (assoc (vec clause) 0 direction))

Create an order-by clause independently of a query, e.g. for replace or whatever.

(mu/defn order-by-clause
  ([orderable]
   (order-by-clause orderable :asc))
  ([orderable :- some?
    direction :- [:maybe [:enum :asc :desc]]]
   (-> (order-by-clause-method orderable)
       (with-direction (or direction :asc)))))

Add an MBQL order-by clause (i.e., :asc or :desc) from something that you can theoretically sort by -- maybe a Field, or :field clause, or expression of some sort, etc.

You can teach Metabase lib how to generate order by clauses for different things by implementing the underlying [[order-by-clause-method]] multimethod.

(mu/defn order-by
  ([query orderable]
   (order-by query -1 orderable nil))
  ([query orderable direction]
   (order-by query -1 orderable direction))
  ([query
    stage-number :- [:maybe :int]
    orderable    :- some?
    direction    :- [:maybe [:enum :asc :desc]]]
   (let [stage-number (or stage-number -1)
         new-order-by (cond-> (order-by-clause-method orderable)
                        direction (with-direction direction))]
     (lib.util/update-query-stage query stage-number update :order-by (fn [order-bys]
                                                                        (conj (vec order-bys) new-order-by))))))
(mu/defn order-bys :- [:maybe [:sequential ::lib.schema.order-by/order-by]]
  "Get the order-by clauses in a query."
  ([query :- ::lib.schema/query]
   (order-bys query -1))
  ([query :- ::lib.schema/query
    stage-number :- :int]
   (not-empty (get (lib.util/query-stage query stage-number) :order-by))))
(defn- orderable-column? [{:keys [base-type], :as _column-metadata}]
  (some (fn [orderable-base-type]
          (isa? base-type orderable-base-type))
        lib.schema.expression/orderable-types))
(mu/defn orderable-columns :- [:sequential lib.metadata/ColumnMetadata]
  "Get column metadata for all the columns you can order by in a given `stage-number` of a `query`. Rules are as
  follows:
  1. If the stage has aggregations or breakouts, you can only order by those columns. E.g.
         SELECT id, count(*) AS count FROM core_user GROUP BY id ORDER BY count ASC;
     You can't ORDER BY something not in the SELECT, e.g. ORDER BY user.first_name would not make sense here.
  2. If the stage has no aggregations or breakouts, you can order by any visible Field:
     a. You can filter by any custom `:expressions` in this stage of the query
     b. You can filter by any Field 'exported' by the previous stage of the query, if there is one; otherwise you can
        filter by any Fields from the current `:source-table`.
     c. You can filter by any Fields exported by any explicit joins
     d. You can filter by and Fields in Tables that are implicitly joinable."
  ([query :- ::lib.schema/query]
   (orderable-columns query -1))
  ([query        :- ::lib.schema/query
    stage-number :- :int]
   (let [breakouts          (not-empty (lib.breakout/breakouts-metadata query stage-number))
         aggregations       (not-empty (lib.aggregation/aggregations-metadata query stage-number))
         columns            (if (or breakouts aggregations)
                              (concat breakouts aggregations)
                              (let [stage   (lib.util/query-stage query stage-number)
                                    options {:include-implicitly-joinable-for-source-card? false}]
                                (lib.metadata.calculation/visible-columns query stage-number stage options)))
         columns            (filter orderable-column? columns)
         existing-order-bys (->> (order-bys query stage-number)
                                 (map (fn [[_tag _opts expr]]
                                        expr)))]
     (cond
       (empty? columns)
       nil
       (empty? existing-order-bys)
       (vec columns)
       :else
       (let [matching (into {}
                            (comp (map lib.ref/ref)
                                  (keep-indexed (fn [index an-order-by]
                                                  (when-let [col (lib.equality/find-matching-column
                                                                   query stage-number an-order-by columns)]
                                                    [col index]))))
                            existing-order-bys)]
         (mapv #(let [pos (matching %)]
                  (cond-> %
                    pos (assoc :order-by-position pos)))
               columns))))))
(def ^:private opposite-direction
  {:asc :desc
   :desc :asc})
(mu/defn change-direction :- ::lib.schema/query
  "Flip the direction of `current-order-by` in `query`."
  ([query :- ::lib.schema/query
    current-order-by :- ::lib.schema.order-by/order-by]
   (let [lib-uuid (lib.options/uuid current-order-by)]
     (mbql.u.match/replace query
       [direction (_ :guard #(= (:lib/uuid %) lib-uuid)) _]
       (assoc &match 0 (opposite-direction direction))))))
 
(ns metabase.lib.query
  (:refer-clojure :exclude [remove])
  (:require
   [malli.core :as mc]
   [medley.core :as m]
   [metabase.lib.convert :as lib.convert]
   [metabase.lib.dispatch :as lib.dispatch]
   [metabase.lib.expression :as lib.expression]
   [metabase.lib.hierarchy :as lib.hierarchy]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.normalize :as lib.normalize]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.lib.util :as lib.util]
   [metabase.mbql.util :as mbql.u]
   [metabase.util :as u]
   [metabase.util.malli :as mu]))
(defmethod lib.normalize/normalize :mbql/query
  [query]
  (lib.normalize/normalize-map
   query
   keyword
   {:type   keyword
    :stages (partial mapv lib.normalize/normalize)}))
(defmethod lib.metadata.calculation/metadata-method :mbql/query
  [_query _stage-number _query]
  ;; not i18n'ed because this shouldn't be developer-facing.
  (throw (ex-info "You can't calculate a metadata map for a query! Use lib.metadata.calculation/returned-columns-method instead."
                  {})))
(defmethod lib.metadata.calculation/returned-columns-method :mbql/query
  [query stage-number a-query options]
  (lib.metadata.calculation/returned-columns query stage-number (lib.util/query-stage a-query stage-number) options))
(defmethod lib.metadata.calculation/display-name-method :mbql/query
  [query stage-number x style]
  (lib.metadata.calculation/display-name query stage-number (lib.util/query-stage x stage-number) style))
(mu/defn stage-count :- ::lib.schema.common/int-greater-than-or-equal-to-zero
  "Returns the count of stages in query"
  [query :- ::lib.schema/query]
  (count (:stages query)))

Returns whether the query is runnable based on first stage :lib/type

(defmulti can-run-method
  (fn [query]
    (:lib/type (lib.util/query-stage query 0))))
(defmethod can-run-method :default
  [_query]
  true)
(mu/defn can-run :- :boolean
  "Returns whether the query is runnable. Manually validate schema for cljs."
  [query :- ::lib.schema/query]
  (and (mc/validate ::lib.schema/query query)
       (boolean (can-run-method query))))
(mu/defn query-with-stages :- ::lib.schema/query
  "Create a query from a sequence of stages."
  ([metadata-providerable stages]
   (query-with-stages (:id (lib.metadata/database metadata-providerable)) metadata-providerable stages))
  ([database-id           :- ::lib.schema.id/database
    metadata-providerable :- lib.metadata/MetadataProviderable
    stages]
   {:lib/type     :mbql/query
    :lib/metadata (lib.metadata/->metadata-provider metadata-providerable)
    :database     database-id
    :stages       stages}))

Create a query from a specific stage.

(mu/defn query-with-stage
  ([metadata-providerable stage]
   (query-with-stages metadata-providerable [stage]))
  ([database-id           :- ::lib.schema.id/database
    metadata-providerable :- lib.metadata/MetadataProviderable
    stage]
   (query-with-stages database-id metadata-providerable [stage])))
(mu/defn ^:private query-from-existing :- ::lib.schema/query
  [metadata-providerable :- lib.metadata/MetadataProviderable
   query                 :- lib.util/LegacyOrPMBQLQuery]
  (let [query (lib.convert/->pMBQL query)]
    (query-with-stages metadata-providerable (:stages query))))

Implementation for [[query]].

(defmulti ^:private query-method
  {:arglists '([metadata-providerable x])}
  (fn [_metadata-providerable x]
    (lib.dispatch/dispatch-value x))
  :hierarchy lib.hierarchy/hierarchy)
(defmethod query-method :dispatch-type/map
  [metadata-providerable query]
  (query-from-existing metadata-providerable query))

this should already be a query in the shape we want but: - let's make sure it has the database metadata that was passed in - fill in field refs with metadata (#33680) - fill in top expression refs with metadata

(defmethod query-method :mbql/query
  [metadata-providerable {converted? :lib.convert/converted? :as query}]
  (let [metadata-provider (lib.metadata/->metadata-provider metadata-providerable)
        query (-> query
                  (assoc :lib/metadata metadata-provider)
                  (dissoc :lib.convert/converted?))
        stages (:stages query)]
    (cond-> query
      converted?
      (assoc
        :stages
        (into []
              (map (fn [[stage-number stage]]
                     (mbql.u/replace stage
                       [:field
                        (opts :guard (complement (some-fn :base-type :effective-type)))
                        (field-id :guard (every-pred number? pos?))]
                       (let [found-ref (-> (lib.metadata/field metadata-provider field-id)
                                           (select-keys [:base-type :effective-type]))]
                         ;; Fallback if metadata is missing
                         [:field (merge found-ref opts) field-id])
                       [:expression
                        (opts :guard (complement (some-fn :base-type :effective-type)))
                        expression-name]
                       (let [found-ref (try
                                         (m/remove-vals
                                           #(= :type/* %)
                                           (-> (lib.expression/expression-ref query stage-number expression-name)
                                               second
                                               (select-keys [:base-type :effective-type])))
                                         (catch #?(:clj Exception :cljs :default) _
                                           ;; This currently does not find expressions defined in join stages
                                           nil))]
                         ;; Fallback if metadata is missing
                         [:expression (merge found-ref opts) expression-name]))))
              (m/indexed stages))))))
(defmethod query-method :metadata/table
  [metadata-providerable table-metadata]
  (query-with-stages metadata-providerable
                     [{:lib/type     :mbql.stage/mbql
                       :source-table (u/the-id table-metadata)}]))
(defmethod query-method :metadata/card
  [metadata-providerable card-metadata]
  (query-with-stages metadata-providerable
                     [{:lib/type     :mbql.stage/mbql
                       :source-card (u/the-id card-metadata)}]))
(mu/defn query :- ::lib.schema/query
  "Create a new MBQL query from anything that could conceptually be an MBQL query, like a Database or Table or an
  existing MBQL query or saved question or whatever. If the thing in question does not already include metadata, pass
  it in separately -- metadata is needed for most query manipulation operations."
  [metadata-providerable :- lib.metadata/MetadataProviderable
   x]
  (query-method metadata-providerable x))
(mu/defn query-from-legacy-inner-query :- ::lib.schema/query
  "Create a pMBQL query from a legacy inner query."
  [metadata-providerable :- lib.metadata/MetadataProviderable
   database-id           :- ::lib.schema.id/database
   inner-query           :- :map]
  (->> (lib.convert/legacy-query-from-inner-query database-id inner-query)
       lib.convert/->pMBQL
       (query metadata-providerable)))
(mu/defn with-different-table :- ::lib.schema/query
  "Changes an existing query to use a different source table or card.
   Can be passed an integer table id or a legacy `card__<id>` string."
  [original-query :- ::lib.schema/query
   table-id :- [:or ::lib.schema.id/table :string]]
  (let [metadata-provider (lib.metadata/->metadata-provider original-query)]
   (query metadata-provider (lib.metadata/table-or-card metadata-provider table-id))))
 
(ns metabase.lib.ref
  (:refer-clojure :exclude [ref])
  (:require
   [metabase.lib.dispatch :as lib.dispatch]
   [metabase.lib.schema.ref :as lib.schema.ref]
   [metabase.util.malli :as mu]))

Impl for [[ref]]. This should create a new ref every time it is called, i.e. it should have a fresh UUID every time you call it.

(defmulti ref-method
  {:arglists '([x])}
  lib.dispatch/dispatch-value)
(mu/defn ref :- ::lib.schema.ref/ref
  "Create a fresh ref that can be added to a query, e.g. a `:field`, `:aggregation`, or `:expression` reference. Will
  create a new UUID every time this is called."
  [x :- some?]
  (ref-method x))
 
(ns metabase.lib.remove-replace
  (:require
   [clojure.set :as set]
   [clojure.walk :as walk]
   [malli.core :as mc]
   [medley.core :as m]
   [metabase.lib.common :as lib.common]
   [metabase.lib.equality :as lib.equality]
   [metabase.lib.expression :as lib.expression]
   [metabase.lib.join :as lib.join]
   [metabase.lib.join.util :as lib.join.util]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.options :as lib.options]
   [metabase.lib.ref :as lib.ref]
   [metabase.lib.util :as lib.util]
   [metabase.mbql.util.match :as mbql.match]
   [metabase.types :as types]
   [metabase.util :as u]
   [metabase.util.malli :as mu]))
(defn- stage-paths
  [query stage-number]
  (let [joins (lib.join/joins query stage-number)
        join-indices (range (count joins))
        join-condition-paths (for [idx join-indices]
                               [:joins idx :conditions])
        join-field-paths (for [idx join-indices
                               :let [join (nth joins idx)]
                               ;; :fields in a join can be just :all or :none (#31858)
                               :when (not (keyword? (:fields join)))]
                           [:joins idx :fields])]
    (concat [[:order-by] [:breakout] [:filters] [:fields] [:aggregation] [:expressions]]
            join-field-paths
            join-condition-paths)))
(declare remove-local-references)
(declare remove-stage-references)
(declare remove-join)
(declare normalize-fields-clauses)
(defn- find-matching-order-by-index
  [query stage-number [target-op {:keys [temporal-unit binning]} target-ref-id]]
  (->> (lib.util/query-stage query stage-number)
       :order-by
       m/indexed
       (m/find-first (fn [[_idx [_dir _ ordered-clause]]]
                       (and (= (first ordered-clause) target-op)
                            (= (:temporal-unit (second ordered-clause)) temporal-unit)
                            (= (:binning (second ordered-clause)) binning)
                            (= (last ordered-clause) target-ref-id))))
       first))
(defn- sync-order-by-options-with-breakout
  [query stage-number target-clause new-options]
  (if-let [order-by-idx (find-matching-order-by-index query stage-number target-clause)]
    (lib.util/update-query-stage
      query stage-number
      update-in [:order-by order-by-idx 2 1]
      (comp #(m/remove-vals nil? %) merge)
      new-options)
    query))
(defn- remove-breakout-order-by
  [query stage-number target-clause]
  (if-let [order-by-idx (find-matching-order-by-index query stage-number target-clause)]
    (lib.util/update-query-stage
      query
      stage-number
      lib.util/remove-clause
      [:order-by]
      (get-in (lib.util/query-stage query stage-number) [:order-by order-by-idx])
      stage-number)
    query))
(defn- remove-replace-location
  [query stage-number unmodified-query-for-stage location target-clause remove-replace-fn]
  (let [result (lib.util/update-query-stage query stage-number
                                            remove-replace-fn location target-clause)
        target-uuid (lib.options/uuid target-clause)]
    (if (not= query result)
      (mbql.match/match-one location
        [:expressions]
        (-> result
            (remove-local-references
              stage-number
              unmodified-query-for-stage
              :expression
              {}
              (lib.util/expression-name target-clause))
            (remove-stage-references stage-number unmodified-query-for-stage target-uuid))
        [:aggregation]
        (-> result
            (remove-local-references
              stage-number
              unmodified-query-for-stage
              :aggregation
              {}
              target-uuid)
            (remove-stage-references stage-number unmodified-query-for-stage target-uuid))
        #_{:clj-kondo/ignore [:invalid-arity]}
        (:or
          [:breakout]
          [:fields]
          [:joins _ :fields])
        (remove-stage-references result stage-number unmodified-query-for-stage target-uuid)
        _
        result)
      result)))
(defn- remove-local-references [query stage-number unmodified-query-for-stage target-op target-opts target-ref-id]
  (let [stage (lib.util/query-stage query stage-number)
        to-remove (mapcat
                   (fn [location]
                     (when-let [clauses (get-in stage location)]
                       (->> clauses
                            (keep (fn [clause]
                                    (mbql.match/match-one clause
                                      [target-op
                                       (_ :guard #(or (empty? target-opts)
                                                      (set/subset? (set target-opts) (set %))))
                                       target-ref-id] [location clause]))))))
                   (stage-paths query stage-number))
        dead-joins (volatile! (transient []))]
    (as-> query q
      (reduce
        (fn [query [location target-clause]]
          (remove-replace-location
            query stage-number unmodified-query-for-stage location target-clause
            #(try (lib.util/remove-clause %1 %2 %3 stage-number)
                  (catch #?(:clj Exception :cljs js/Error) e
                    (let [{:keys [error join]} (ex-data e)]
                      (if (= error :metabase.lib.util/cannot-remove-final-join-condition)
                        ;; Return the stage unchanged, but keep track of the dead joins.
                        (do (vswap! dead-joins conj! join)
                            %1)
                        (throw e)))))))
        q
        to-remove)
      (reduce #(remove-join %1 stage-number %2) q (persistent! @dead-joins)))))
(defn- remove-stage-references
  [query previous-stage-number unmodified-query-for-stage target-uuid]
  (if-let [stage-number (lib.util/next-stage-number unmodified-query-for-stage previous-stage-number)]
    (let [stage (lib.util/query-stage unmodified-query-for-stage stage-number)
          target-ref-id (->> (lib.metadata.calculation/visible-columns unmodified-query-for-stage stage-number stage)
                             (some (fn [{:keys [lib/source lib/source-uuid] :as column}]
                                     (when (and (= :source/previous-stage source) (= target-uuid source-uuid))
                                       (:lib/desired-column-alias column)))))]
      (if target-ref-id
        ;; We are moving to the next stage, so pass the current query as the unmodified-query-for-stage
        (remove-local-references query stage-number query :field {} target-ref-id)
        query))
    query))
(defn- remove-replace* [query stage-number target-clause remove-or-replace replacement]
  (mu/disable-enforcement
    (let [target-clause (lib.common/->op-arg target-clause)
          stage (lib.util/query-stage query stage-number)
          location (m/find-first
                    (fn [possible-location]
                      (when-let [clauses (get-in stage possible-location)]
                        (let [target-uuid (lib.options/uuid target-clause)]
                          (when (some (comp #{target-uuid} :lib/uuid second) clauses)
                            possible-location))))
                    (stage-paths query stage-number))
          replace? (= :replace remove-or-replace)
          replacement-clause (when replace?
                               (lib.common/->op-arg replacement))
          remove-replace-fn (if replace?
                              #(lib.util/replace-clause %1 %2 %3 replacement-clause)
                              #(lib.util/remove-clause %1 %2 %3 stage-number))
          changing-breakout? (= [:breakout] location)
          sync-breakout-ordering? (and replace?
                                       changing-breakout?
                                       (and (= (first target-clause)
                                               (first replacement-clause))
                                            (= (last target-clause)
                                               (last replacement-clause))))
          query (cond
                  sync-breakout-ordering?
                  (sync-order-by-options-with-breakout
                   query
                   stage-number
                   target-clause
                   (select-keys (second replacement-clause) [:binning :temporal-unit]))
                  changing-breakout?
                  (remove-breakout-order-by query stage-number target-clause)
                  :else
                  query)]
      (if location
        (-> query
            (remove-replace-location stage-number query location target-clause remove-replace-fn)
            normalize-fields-clauses)
        query))))
(mu/defn remove-clause :- :metabase.lib.schema/query
  "Removes the `target-clause` from the stage specified by `stage-number` of `query`.
  If `stage-number` is not specified, the last stage is used."
  ([query :- :metabase.lib.schema/query
    target-clause]
   (remove-clause query -1 target-clause))
  ([query :- :metabase.lib.schema/query
    stage-number :- :int
    target-clause]
   (if (and (map? target-clause) (= (:lib/type target-clause) :mbql/join))
     (remove-join query stage-number target-clause)
     (remove-replace* query stage-number target-clause :remove nil))))
(defn- fresh-ref
  [reference]
  (lib.options/update-options reference assoc :lib/uuid (str (random-uuid))))
(defn- local-replace-expression-references [stage target-ref-id replacement-ref]
  (let [replace-embedded-refs (fn replace-refs [stage]
                                (mbql.match/replace stage
                                  [:expression _ target-ref-id] (fresh-ref replacement-ref)))]
    (replace-embedded-refs stage)))
(defn- local-replace-expression
  [stage target replacement]
  (let [replacement-name (or (lib.util/expression-name replacement)
                             (-> replacement lib.options/options :name))
        top-level-replacement (-> replacement
                                  (lib.util/top-level-expression-clause replacement-name)
                                  fresh-ref)
        replaced (update stage :expressions (fn [exprs] (mapv #(if (= % target) top-level-replacement %) exprs)))
        target-name (lib.util/expression-name target)
        replacement-type (-> replacement lib.options/options :effective-type)
        replacement-ref [:expression {:effective-type replacement-type} replacement-name]]
    (local-replace-expression-references replaced target-name replacement-ref)))
(defn- local-replace
  [stage target replacement]
  (if (lib.util/expression-name target)
    (local-replace-expression stage target replacement)
    (walk/postwalk #(if (= % target) replacement %) stage)))
(defn- returned-columns-at-stage
  [query stage-number]
  (->> (lib.util/query-stage query stage-number)
       (lib.metadata.calculation/returned-columns query stage-number)))
(defn- replaced-columns
  [query stage-number replaced]
  (let [cols (returned-columns-at-stage query stage-number)
        replaced-cols (returned-columns-at-stage replaced stage-number)]
    (->> (map vector cols replaced-cols)
         (filter #(not= (first %) (second %))))))
(defn- next-stage-replacement
  [query next-stage-number [col replaced-col]]
  (let [target-ref-id (:lib/desired-column-alias col)
        replaced-ref (lib.ref/ref (assoc replaced-col :lib/source :source/previous-stage))]
    (map (fn [target-ref] [target-ref (fresh-ref replaced-ref)])
         (mbql.match/match (lib.util/query-stage query next-stage-number)
           [:field _ target-ref-id] &match))))
(defn- typed-expression
  [query stage-number expression]
  (if (or (-> expression lib.options/options :effective-type)
          (not (lib.expression/expression-clause? expression)))
    expression
    (let [t (lib.metadata.calculation/type-of query stage-number expression)]
      (lib.options/update-options expression assoc :effective-type t))))
(def ^:private expression-validator (mc/validator :metabase.lib.schema.expression/expression))

Returns if replacing an-expression with new-expression in query at stage stage-number is a tweak. A tweak changes a top level expression or an aggregation while preserving its type.

(defn- tweak?
  [query stage-number an-expression new-expression]
  (and (expression-validator an-expression)
       (expression-validator new-expression)
       (types/assignable? (lib.metadata.calculation/type-of query stage-number new-expression)
                          (lib.metadata.calculation/type-of query stage-number an-expression))))
(mu/defn tweak-expression :- :metabase.lib.schema/query
  "Return `query` with `target` replaced by `replacement` at stage `stage-number`.
  If `target` and `replacement` are of different type of have different names or roles,
  an exception is thrown.
  This function exists to make trival edits in the FE possible without losing parts of the query
  depending on `target`."
  [query        :- :metabase.lib.schema/query
   stage-number :- :int
   target       :- :metabase.lib.schema.expression/expression
   replacement  :- :metabase.lib.schema.expression/expression]
  (let [unmodified-query query
        replacement (typed-expression query stage-number replacement)]
    (loop [query (lib.util/update-query-stage query stage-number local-replace target replacement)
           stage-number stage-number]
      (if-let [next-stage-number (lib.util/next-stage-number query stage-number)]
        (let [next-replacements (->> (replaced-columns unmodified-query stage-number query)
                                     (mapcat #(next-stage-replacement query next-stage-number %)))]
          (recur (reduce (fn [query [target replacement]]
                           (lib.util/update-query-stage query next-stage-number local-replace target replacement))
                         query
                         next-replacements)
                 next-stage-number))
        query))))
(declare replace-join)
(mu/defn replace-clause :- :metabase.lib.schema/query
  "Replaces the `target-clause` with `new-clause` in the `query` stage specified by `stage-number`.
  If `stage-number` is not specified, the last stage is used."
  ([query :- :metabase.lib.schema/query
    target-clause
    new-clause]
   (replace-clause query -1 target-clause new-clause))
  ([query :- :metabase.lib.schema/query
    stage-number :- :int
    target-clause
    new-clause]
   (cond
     (and (map? target-clause) (= (:lib/type target-clause) :mbql/join))
     (replace-join query stage-number target-clause new-clause)
     (tweak? query stage-number target-clause new-clause)
     (tweak-expression query stage-number target-clause new-clause)
     :else
     (remove-replace* query stage-number target-clause :replace new-clause))))
(defn- field-clause-with-join-alias?
  [field-clause join-alias]
  (and (lib.util/field-clause? field-clause)
       (= (lib.join.util/current-join-alias field-clause) join-alias)))
(defn- replace-join-alias
  [a-join old-name new-name]
  (mbql.match/replace a-join
    (field :guard #(field-clause-with-join-alias? % old-name))
    (lib.join/with-join-alias field new-name)))
(defn- rename-join-in-stage
  [stage idx new-name]
  (let [the-joins      (:joins stage)
        [idx old-name] (when (< -1 idx (count the-joins))
                         [idx (get-in the-joins [idx :alias])])]
    (if (and idx (not= old-name new-name))
      (let [unique-name-fn (lib.util/unique-name-generator)
            _              (run! unique-name-fn (map :alias the-joins))
            unique-name    (unique-name-fn new-name)]
        (-> stage
            (assoc-in [:joins idx :alias] unique-name)
            (replace-join-alias old-name unique-name)))
      stage)))
(defn- join-spec->clause
  [query stage-number join-spec]
  (if (integer? join-spec)
    join-spec
    (let [pred (cond-> #{join-spec}
                 (string? join-spec) (comp :alias))]
      (some (fn [[idx a-join]]
              (when (pred a-join)
                idx))
            (m/indexed (:joins (lib.util/query-stage query stage-number)))))))
(mu/defn rename-join :- :metabase.lib.schema/query
  "Rename the join specified by `join-spec` in `query` at `stage-number` to `new-name`.
  The join can be specified either by itself (as returned by [[joins]]), by its alias
  or by its index in the list of joins as returned by [[joins]].
  If `stage-number` is not provided, the last stage is used.
  If the specified join cannot be found, then `query` is returned as is.
  If renaming the join to `new-name` would clash with an existing join, a
  suffix is appended to `new-name` to make it unique."
  ([query join-spec new-name]
   (rename-join query -1 join-spec new-name))
  ([query        :- :metabase.lib.schema/query
    stage-number :- :int
    join-spec    :- [:or :metabase.lib.schema.join/join :string :int]
    new-name     :- :metabase.lib.schema.common/non-blank-string]
   (if-let [idx (join-spec->clause query stage-number join-spec)]
     (lib.util/update-query-stage query stage-number rename-join-in-stage idx new-name)
     query)))
(defn- remove-matching-missing-columns
  [query-after query-before stage-number match-spec]
  (let [removed-cols (set/difference
                       (set (lib.metadata.calculation/visible-columns query-before stage-number (lib.util/query-stage query-before stage-number)))
                       (set (lib.metadata.calculation/visible-columns query-after stage-number (lib.util/query-stage query-after stage-number))))]
    (reduce
      #(apply remove-local-references %1 stage-number query-after (match-spec %2))
      query-after
      removed-cols)))
(defn- remove-invalidated-refs
  [query-after query-before stage-number]
  (let [query-without-local-refs (remove-matching-missing-columns
                                   query-after
                                   query-before
                                   stage-number
                                   (fn [column] [:field {:join-alias (::lib.join/join-alias column)} (:id column)]))]
    ;; Because joins can use :all or :none, we cannot just use `remove-local-references` we have to manually look at the next stage as well
    (if-let [stage-number (lib.util/next-stage-number query-without-local-refs stage-number)]
      (remove-matching-missing-columns
        query-without-local-refs
        query-before
        stage-number
        (fn [column] [:field {} (:lib/desired-column-alias column)]))
      query-without-local-refs)))
(defn- join-spec->alias
  [query stage-number join-spec]
  (cond
    (integer? join-spec) (get-in (lib.util/query-stage query stage-number) [:joins join-spec :alias])
    (map? join-spec) (:alias join-spec)
    :else join-spec))
(defn- update-joins
  ([query stage-number join-spec f]
   (if-let [join-alias (join-spec->alias query stage-number join-spec)]
     (mu/disable-enforcement
       (let [query-after (as-> query $q
                           (lib.util/update-query-stage
                            $q
                            stage-number
                            (fn [stage]
                              (u/assoc-dissoc stage :joins (f (:joins stage) join-alias))))
                           (lib.util/update-query-stage
                            $q
                            stage-number
                            (fn [stage]
                              (m/update-existing
                               stage
                               :joins
                               (fn [joins]
                                 (mapv #(lib.join/add-default-alias $q stage-number %) joins))))))]
         (-> query-after
             (remove-invalidated-refs query stage-number)
             normalize-fields-clauses)))
     query)))
(defn- has-field-from-join? [form join-alias]
  (some? (mbql.match/match-one form
           (field :guard #(field-clause-with-join-alias? % join-alias)))))
(defn- dependent-join? [join join-alias]
  (or (= (:alias join) join-alias)
      (has-field-from-join? join join-alias)))
(mu/defn remove-join :- :metabase.lib.schema/query
  "Remove the join specified by `join-spec` in `query` at `stage-number`.
  The join can be specified either by itself (as returned by [[joins]]), by its alias
  or by its index in the list of joins as returned by [[joins]].
  If `stage-number` is not provided, the last stage is used.
  If the specified join cannot be found, then `query` is returned as is.
  Top level clauses containing references to the removed join are removed too."
  ([query join-spec]
   (remove-join query -1 join-spec))
  ([query        :- :metabase.lib.schema/query
    stage-number :- :int
    join-spec    :- [:or :metabase.lib.schema.join/join :string :int]]
   (try
     (update-joins query stage-number join-spec (fn [joins join-alias]
                                                  (not-empty (filterv #(not (dependent-join? % join-alias))
                                                                      joins))))
     (catch #?(:clj Exception :cljs :default) e
       (let [{:keys [error join] error-stage-number :stage-number} (ex-data e)]
         (if (= error ::lib.util/cannot-remove-final-join-condition)
           (-> query
               (remove-join error-stage-number join)
               (remove-join stage-number join-spec))
           (throw e)))))))
(mu/defn replace-join :- :metabase.lib.schema/query
  "Replace the join specified by `join-spec` in `query` at `stage-number` with `new-join`.
  If `new-join` is nil, the join is removed as if by [[remove-join]].
  The join can be specified either by itself (as returned by [[joins]]), by its alias
  or by its index in the list of joins as returned by [[joins]].
  If `stage-number` is not provided, the last stage is used.
  If the specified join cannot be found, then `query` is returned as is.
  Top level clauses containing references to the removed join are removed too."
  ([query join-spec new-join]
   (replace-join query -1 join-spec new-join))
  ([query        :- :metabase.lib.schema/query
    stage-number :- :int
    join-spec    :- [:or :metabase.lib.schema.join/join :string :int]
    new-join]
   (if (nil? new-join)
     (remove-join query stage-number join-spec)
     (update-joins query stage-number join-spec (fn [joins join-alias]
                                                  (mapv #(if (= (:alias %) join-alias)
                                                           new-join
                                                           %)
                                                        joins))))))
(defn- specifies-default-fields? [query stage-number]
  (let [fields (:fields (lib.util/query-stage query stage-number))]
    (and fields
         ;; Quick first check: if there are any implicitly-joined fields, it's not the default list.
         (not (some (comp :source-field lib.options/options) fields))
         (lib.equality/matching-column-sets? query stage-number fields
                                             (lib.metadata.calculation/default-columns-for-stage query stage-number)))))
(defn- normalize-fields-for-join [query stage-number join]
  (if (#{:none :all} (:fields join))
    ;; Nothing to do if it's already a keyword.
    join
    (cond-> join
      (lib.equality/matching-column-sets?
        query stage-number (:fields join)
        (lib.metadata.calculation/returned-columns query stage-number (assoc join :fields :all)))
      (assoc :fields :all))))
(defn- normalize-fields-for-stage [query stage-number]
  (let [stage (lib.util/query-stage query stage-number)]
    (cond-> query
      (specifies-default-fields? query stage-number)
      (lib.util/update-query-stage stage-number dissoc :fields)
      (:joins stage)
      (lib.util/update-query-stage stage-number update :joins
                                   (partial mapv #(normalize-fields-for-join query stage-number %))))))
(mu/defn normalize-fields-clauses :- :metabase.lib.schema/query
  "Check all the `:fields` clauses in the query - on the stages and any joins - and drops them if they are equal to the
  defaults.
  - For stages, if the `:fields` list is identical to the default fields for this stage.
  - For joins, replace it with `:all` if it's all the fields that are in the join by default.
  - For joins, remove it if the list is empty (the default for joins is no fields)."
  [query :- :metabase.lib.schema/query]
  (reduce normalize-fields-for-stage query (range (count (:stages query)))))
 

Malli schema for the pMBQL query type, the version of MBQL produced and manipulated by the new Cljc Metabase lib. Currently this is a little different from the version of MBQL consumed by the QP, specified in [[metabase.mbql.schema]]. Hopefully these versions will converge in the future.

Some primitives below are duplicated from [[metabase.util.malli.schema]] since that's not .cljc. Other stuff is copied from [[metabase.mbql.schema]] so this can exist completely independently; hopefully at some point in the future we can deprecate that namespace and eventually do away with it entirely.

(ns metabase.lib.schema
  (:refer-clojure :exclude [ref])
  (:require
   [metabase.lib.schema.aggregation :as aggregation]
   [metabase.lib.schema.common :as common]
   [metabase.lib.schema.expression :as expression]
   [metabase.lib.schema.expression.arithmetic]
   [metabase.lib.schema.expression.conditional]
   [metabase.lib.schema.expression.string]
   [metabase.lib.schema.expression.temporal]
   [metabase.lib.schema.filter]
   [metabase.lib.schema.id :as id]
   [metabase.lib.schema.join :as join]
   [metabase.lib.schema.literal]
   [metabase.lib.schema.order-by :as order-by]
   [metabase.lib.schema.ref :as ref]
   [metabase.lib.schema.template-tag :as template-tag]
   [metabase.lib.schema.util :as lib.schema.util]
   [metabase.mbql.util :as mbql.u]
   [metabase.mbql.util.match :as mbql.match]
   [metabase.util.malli.registry :as mr]))
(comment metabase.lib.schema.expression.arithmetic/keep-me
         metabase.lib.schema.expression.conditional/keep-me
         metabase.lib.schema.expression.string/keep-me
         metabase.lib.schema.expression.temporal/keep-me
         metabase.lib.schema.filter/keep-me
         metabase.lib.schema.literal/keep-me)
(mr/def ::stage.native
  [:map
   [:lib/type [:= :mbql.stage/native]]
   ;; the actual native query, depends on the underlying database. Could be a raw SQL string or something like that.
   ;; Only restriction is that it is non-nil.
   [:native some?]
   ;; any parameters that should be passed in along with the query to the underlying query engine, e.g. for JDBC these
   ;; are the parameters we pass in for a `PreparedStatement` for `?` placeholders. These can be anything, including
   ;; nil.
   [:args {:optional true} [:sequential any?]]
   ;; the Table/Collection/etc. that this query should be executed against; currently only used for MongoDB, where it
   ;; is required.
   [:collection {:optional true} ::common/non-blank-string]
   ;; optional template tag declarations. Template tags are things like `{{x}}` in the query (the value of the
   ;; `:native` key), but their definition lives under this key.
   [:template-tags {:optional true} [:ref ::template-tag/template-tag-map]]])
(mr/def ::breakout
  [:ref ::ref/ref])
(mr/def ::breakouts
  [:and
   [:sequential {:min 1} ::breakout]
   [:fn
    {:error/message "Breakouts must be distinct"}
    #'lib.schema.util/distinct-refs?]])
(mr/def ::fields
  [:and
   [:sequential {:min 1} [:ref ::ref/ref]]
   [:fn
    {:error/message ":fields must be distinct"}
    #'lib.schema.util/distinct-refs?]])

this is just for enabling round-tripping filters with named segment references

(mr/def ::filterable
  [:or
   [:ref ::expression/boolean]
   [:tuple [:= :segment] :map :string]])
(mr/def ::filters
  [:sequential {:min 1} ::filterable])
(defn- bad-ref-clause? [ref-type valid-ids x]
  (and (vector? x)
       (= ref-type (first x))
       (not (contains? valid-ids (get x 2)))))
(defn- expression-ref-errors-for-stage [stage]
  (let [expression-names (into #{} (map (comp :lib/expression-name second)) (:expressions stage))]
    (mbql.u/matching-locations (dissoc stage :joins :lib/stage-metadata)
                               #(bad-ref-clause? :expression expression-names %))))
(defn- aggregation-ref-errors-for-stage [stage]
  (let [uuids (into #{} (map (comp :lib/uuid second)) (:aggregation stage))]
    (mbql.u/matching-locations (dissoc stage :joins :lib/stage-metadata)
                               #(bad-ref-clause? :aggregation uuids %))))

Return the locations and the clauses with dangling expression or aggregation references. The return value is sequence of pairs (vectors) with the first element specifying the location as a vector usable in [[get-in]] and the second element being the clause with dangling reference.

(defn ref-errors-for-stage
  [stage]
  (concat (expression-ref-errors-for-stage stage)
          (aggregation-ref-errors-for-stage stage)))
(defn- expression-ref-error-for-stage [stage]
  (when-let [err-loc (first (expression-ref-errors-for-stage stage))]
    (if-let [expression-name (get-in err-loc [1 2])]
      (str "Invalid :expression reference: no expression named " (pr-str expression-name))
      (str "Invalid :expression reference: " (get err-loc 1)))))
(defn- aggregation-ref-error-for-stage [stage]
  (when-let [err-loc (first (aggregation-ref-errors-for-stage stage))]
    (if-let [ag-uuid (get-in err-loc [1 2])]
      (str "Invalid :aggregation reference: no aggregation with uuid " ag-uuid)
      (str "Invalid :aggregation reference: " (get err-loc 1)))))

Validate references in the context of a single stage, independent of any previous stages. If there is an error with a reference, return a string describing the error.

(def ^:private ^{:arglists '([stage])} ref-error-for-stage
  (some-fn expression-ref-error-for-stage
           aggregation-ref-error-for-stage))
(mr/def ::stage.valid-refs
  [:fn
   {:error/message "Valid references for a single query stage"
    :error/fn      (fn [{:keys [value]} _]
                     (ref-error-for-stage value))}
   (complement ref-error-for-stage)])
(mr/def ::stage.mbql
  [:and
   [:map
    [:lib/type     [:= :mbql.stage/mbql]]
    [:joins        {:optional true} [:ref ::join/joins]]
    [:expressions  {:optional true} [:ref ::expression/expressions]]
    [:breakout     {:optional true} ::breakouts]
    [:aggregation  {:optional true} [:ref ::aggregation/aggregations]]
    [:fields       {:optional true} ::fields]
    [:filters      {:optional true} ::filters]
    [:order-by     {:optional true} [:ref ::order-by/order-bys]]
    [:source-table {:optional true} [:ref ::id/table]]
    [:source-card  {:optional true} [:ref ::id/card]]
    ;; TODO -- `:page` ???
    ]
   [:fn
    {:error/message ":source-query is not allowed in pMBQL queries."}
    #(not (contains? % :source-query))]
   [:fn
    {:error/message "A query cannot have both a :source-table and a :source-card."}
    (complement (every-pred :source-table :source-card))]
   [:ref ::stage.valid-refs]])

Schema for an MBQL stage that includes either :source-table or :source-query.

(mr/def ::stage.mbql.with-source-table
  [:merge
   [:ref ::stage.mbql]
   [:map
    [:source-table [:ref ::id/table]]]])
(mr/def ::stage.mbql.with-source-card
  [:merge
   [:ref ::stage.mbql]
   [:map
    [:source-card [:ref ::id/card]]]])
(mr/def ::stage.mbql.with-source
  [:or
   [:ref ::stage.mbql.with-source-table]
   [:ref ::stage.mbql.with-source-card]])

Schema for an MBQL stage that DOES NOT include :source-table -- an MBQL stage that is not the initial stage.

(mr/def ::stage.mbql.without-source
  [:and
   [:ref ::stage.mbql]
   [:fn
    {:error/message "Only the initial stage of a query can have a :source-table or :source-card."}
    (complement (some-fn :source-table :source-card))]])

the schemas are constructed this way instead of using :or because they give better error messages

(mr/def ::stage.type
  [:enum :mbql.stage/native :mbql.stage/mbql])
(mr/def ::stage
  [:and
   [:map
    [:lib/type ::stage.type]]
   [:multi {:dispatch :lib/type}
    [:mbql.stage/native [:ref ::stage.native]]
    [:mbql.stage/mbql   [:ref ::stage.mbql]]]])
(mr/def ::stage.initial
  [:and
   [:map
    [:lib/type ::stage.type]]
   [:multi {:dispatch :lib/type}
    [:mbql.stage/native [:ref ::stage.native]]
    [:mbql.stage/mbql   [:ref ::stage.mbql.with-source]]]])
(mr/def ::stage.additional
  ::stage.mbql.without-source)

Apparently you're allowed to use a join alias for a join that appeared in any previous stage or the current stage, or inside any join in any previous stage or the current stage. Why? Who knows, but this is a real thing. See [[metabase.driver.sql.query-processor-test/join-source-queries-with-joins-test]] for example.

This doesn't really make sense IMO (you should use string field refs to refer to things from a previous stage...right?) but for now we'll have to allow it until we can figure out how to go fix all of the old broken queries.

Also, it's apparently legal to use a join alias to refer to a column that comes from a join in a source Card, and there is no way for us to know what joins exist in the source Card without a metadata provider, so we're just going to have to go ahead and skip validation in that case. Icky! But it's better than being overly strict and rejecting queries that the QP could have fixed.

Anyways, this function returns a function with the signature:

(visible-join-alias? ) => boolean

(defn- visible-join-alias?-fn
  [stage]
  (if (:source-card stage)
    (constantly true)
    (letfn [(join-aliases-in-join [join]
              (cons
               (:alias join)
               (mapcat join-aliases-in-stage (:stages join))))
            (join-aliases-in-stage [stage]
              (mapcat join-aliases-in-join (:joins stage)))]
      (set (join-aliases-in-stage stage)))))
(defn- join-ref-error-for-stages [stages]
  (when (sequential? stages)
    (loop [visible-join-alias? (constantly false), i 0, [stage & more] stages]
      (let [visible-join-alias? (some-fn visible-join-alias? (visible-join-alias?-fn stage))]
        (or
         (mbql.match/match-one (dissoc stage :joins :stage/metadata) ; TODO isn't this supposed to be `:lib/stage-metadata`?
           [:field ({:join-alias (join-alias :guard (complement visible-join-alias?))} :guard :join-alias) _id-or-name]
           (str "Invalid :field reference in stage " i ": no join named " (pr-str join-alias)))
         (when (seq more)
           (recur visible-join-alias? (inc i) more)))))))

Like [[ref-error-for-stage]], but validate references in the context of a sequence of several stages; for validations that can't be done on the basis of just a single stage. For example join alias validation needs to take into account previous stages.

(def ^:private ^{:arglists '([stages])} ref-error-for-stages
  ;; this var is ultimately redundant for now since it just points to one function but I'm leaving it here so we can
  ;; add more stuff to it the future as we validate more things.
  join-ref-error-for-stages)
(mr/def ::stages.valid-refs
  [:fn
   {:error/message "Valid references for all query stages"
    :error/fn      (fn [{:keys [value]} _]
                     (ref-error-for-stages value))}
   (complement ref-error-for-stages)])
(mr/def ::stages
  [:and
   [:cat
    [:schema [:ref ::stage.initial]]
    [:* [:schema [:ref ::stage.additional]]]]
   [:ref ::stages.valid-refs]])
(mr/def ::query
  [:and
   [:map
    [:lib/type [:= :mbql/query]]
    [:database [:or
                ::id/database
                ::id/saved-questions-virtual-database]]
    [:stages   [:ref ::stages]]]
   lib.schema.util/UniqueUUIDs])
 
(ns metabase.lib.schema.aggregation
  (:require
   [metabase.lib.hierarchy :as lib.hierarchy]
   [metabase.lib.schema.expression :as expression]
   [metabase.lib.schema.mbql-clause :as mbql-clause]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util.malli.registry :as mr]))

count has an optional expression arg. This is the number of non-NULL values -- corresponds to count() in SQL

(mbql-clause/define-catn-mbql-clause :count :- :type/Integer
  [:expression [:? [:schema [:ref ::expression/expression]]]])

cum-count has an optional expression arg

(mbql-clause/define-catn-mbql-clause :cum-count :- :type/Integer
  [:expression [:? [:schema [:ref ::expression/expression]]]])
(mbql-clause/define-tuple-mbql-clause :avg :- :type/Float
  [:schema [:ref ::expression/number]])

number of distinct values of something.

(mbql-clause/define-tuple-mbql-clause :distinct :- :type/Integer
  [:schema [:ref ::expression/expression]])
(mbql-clause/define-tuple-mbql-clause :count-where :- :type/Integer
  [:schema [:ref ::expression/boolean]])

min and max should work on anything orderable, including numbers, temporal values, and even text values.

(mbql-clause/define-tuple-mbql-clause :max
  [:schema [:ref ::expression/orderable]])
(lib.hierarchy/derive :max :lib.type-of/type-is-type-of-first-arg)

apparently median and percentile only work for numeric args in Postgres, as opposed to anything orderable. Not sure this makes sense conceptually, but since there probably isn't as much of a use case we can keep that restriction in MBQL for now.

(mbql-clause/define-tuple-mbql-clause :median
  [:schema [:ref ::expression/number]])
(lib.hierarchy/derive :median :lib.type-of/type-is-type-of-first-arg)
(mbql-clause/define-tuple-mbql-clause :min
  [:schema [:ref ::expression/orderable]])
(lib.hierarchy/derive :min :lib.type-of/type-is-type-of-first-arg)
(mr/def ::percentile.percentile
  [:and
   {:error/message "valid percentile"}
   [:ref ::expression/number]
   [:fn
    {:error/message "percentile must be between zero and one"}
    #(<= 0 % 1)]])
(mbql-clause/define-tuple-mbql-clause :percentile
  #_expr       [:ref ::expression/number]
  #_percentile [:ref ::percentile.percentile])
(lib.hierarchy/derive :percentile :lib.type-of/type-is-type-of-first-arg)
(mbql-clause/define-tuple-mbql-clause :share :- :type/Float
  [:schema [:ref ::expression/boolean]])
(mbql-clause/define-tuple-mbql-clause :stddev :- :type/Float
  [:schema [:ref ::expression/number]])
(mbql-clause/define-tuple-mbql-clause :sum
  [:schema [:ref ::expression/number]])
(mbql-clause/define-tuple-mbql-clause :cum-sum
  [:schema [:ref ::expression/number]])
(lib.hierarchy/derive :sum :lib.type-of/type-is-type-of-first-arg)
(lib.hierarchy/derive :cum-sum :lib.type-of/type-is-type-of-first-arg)
(mbql-clause/define-tuple-mbql-clause :sum-where
  [:schema [:ref ::expression/number]]
  [:schema [:ref ::expression/boolean]])
(lib.hierarchy/derive :sum-where :lib.type-of/type-is-type-of-first-arg)
(mbql-clause/define-tuple-mbql-clause :var :- :type/Float
  #_expr [:schema [:ref ::expression/number]])
(mr/def ::aggregation
  ;; placeholder!
  [:or
   :mbql.clause/avg
   :mbql.clause/count
   :mbql.clause/cum-count
   :mbql.clause/count-where
   :mbql.clause/distinct
   :mbql.clause/max
   :mbql.clause/median
   :mbql.clause/min
   :mbql.clause/percentile
   :mbql.clause/share
   :mbql.clause/stddev
   :mbql.clause/sum
   :mbql.clause/cum-sum
   :mbql.clause/sum-where
   :mbql.clause/var
   any?])
(mr/def ::aggregations
  [:sequential {:min 1} [:ref ::aggregation]])

The list of available aggregation operator. The order of operators is relevant for the front end.

(def aggregation-operators
  [{:short            :count
    :requires-column? false
    :driver-feature   :basic-aggregations
    :display-info     (fn []
                        {:display-name (i18n/tru "Count of rows")
                         :column-name  (i18n/tru "Count")
                         :description  (i18n/tru "Total number of rows in the answer.")})}
   {:short            :sum
    :supported-field  :metabase.lib.types.constants/summable
    :requires-column? true
    :driver-feature   :basic-aggregations
    :display-info     (fn []
                        {:display-name (i18n/tru "Sum of ...")
                         :column-name  (i18n/tru "Sum")
                         :description  (i18n/tru "Sum of all the values of a column.")})}
   {:short            :avg
    :supported-field  :metabase.lib.types.constants/summable
    :requires-column? true
    :driver-feature   :basic-aggregations
    :display-info     (fn []
                        {:display-name (i18n/tru "Average of ...")
                         :column-name  (i18n/tru "Average")
                         :description  (i18n/tru "Average of all the values of a column")})}
   {:short            :median
    :supported-field  :metabase.lib.types.constants/summable
    :requires-column? true
    :driver-feature   :percentile-aggregations
    :display-info     (fn []
                        {:display-name (i18n/tru "Median of ...")
                         :column-name  (i18n/tru "Median")
                         :description  (i18n/tru "Median of all the values of a column")})}
   {:short            :distinct
    :supported-field  :any
    :requires-column? true
    :driver-feature   :basic-aggregations
    :display-info     (fn []
                        {:display-name (i18n/tru "Number of distinct values of ...")
                         :column-name  (i18n/tru "Distinct values")
                         :description  (i18n/tru "Number of unique values of a column among all the rows in the answer.")})}
   {:short            :cum-sum
    :supported-field  :metabase.lib.types.constants/summable
    :requires-column? true
    :driver-feature   :basic-aggregations
    :display-info     (fn []
                        {:display-name (i18n/tru "Cumulative sum of ...")
                         :column-name  (i18n/tru "Sum")
                         :description  (i18n/tru "Additive sum of all the values of a column.\ne.x. total revenue over time.")})}
   {:short            :cum-count
    :requires-column? false
    :driver-feature   :basic-aggregations
    :display-info     (fn []
                        {:display-name (i18n/tru "Cumulative count of rows")
                         :column-name  (i18n/tru "Count")
                         :description  (i18n/tru "Additive count of the number of rows.\ne.x. total number of sales over time.")})}
   {:short            :stddev
    :supported-field  :metabase.lib.types.constants/summable
    :requires-column? true
    :driver-feature   :standard-deviation-aggregations
    :display-info     (fn []
                        {:display-name (i18n/tru "Standard deviation of ...")
                         :column-name  (i18n/tru "SD")
                         :description  (i18n/tru "Number which expresses how much the values of a column vary among all rows in the answer.")})}
   {:short            :min
    :supported-field  :metabase.lib.types.constants/scope
    :requires-column? true
    :driver-feature   :basic-aggregations
    :display-info     (fn []
                        {:display-name (i18n/tru "Minimum of ...")
                         :column-name  (i18n/tru "Min")
                         :description  (i18n/tru "Minimum value of a column")})}
   {:short            :max
    :supported-field  :metabase.lib.types.constants/scope
    :requires-column? true
    :driver-feature   :basic-aggregations
    :display-info     (fn []
                        {:display-name (i18n/tru "Maximum of ...")
                         :column-name  (i18n/tru "Max")
                         :description  (i18n/tru "Maximum value of a column")})}])
(mr/def ::operator
  [:map
   [:lib/type [:= :operator/aggregation]]
   [:short (into [:enum] (map :short) aggregation-operators)]
   [:supported-field {:optional true} [:maybe :keyword]] ; TODO more precise type?
   [:requires-column? :boolean]
   [:driver-feature :keyword]           ; TODO more precise type?
   [:display-info fn?]])
 

Malli schema for binning of a column's values.

There are two approaches to binning, selected by :strategy: - {:strategy :bin-width :bin-width 10} makes 1 or more bins that are 10 wide; - {:strategy :num-bins :num-bins 12} splits the column into 12 bins.

(ns metabase.lib.schema.binning
  (:require
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.util.malli.registry :as mr]))
(mr/def ::strategy
  [:enum :bin-width :default :num-bins])
(mr/def ::num-bins
  ::lib.schema.common/positive-int)
(mr/def ::bin-width
  ::lib.schema.common/positive-number)
(mr/def ::binning
  [:merge
   [:map
    [:strategy [:ref ::strategy]]]
   [:multi {:dispatch :strategy
            :error/fn (fn [{:keys [value]} _]
                        (str "Invalid binning strategy" (pr-str value)))}
    [:default   :map]
    [:bin-width [:map
                 [:bin-width [:ref ::bin-width]]]]
    [:num-bins  [:map
                 [:num-bins [:ref ::num-bins]]]]]])
(mr/def ::binning-option
  [:map
   [:lib/type [:= :option/binning]]
   [:display-name :string]
   [:mbql [:maybe ::binning]]
   [:default {:optional true} :boolean]])
 
(ns metabase.lib.schema.common
  (:require
   [clojure.string :as str]
   [metabase.types]
   [metabase.util.malli.registry :as mr]))
(comment metabase.types/keep-me)

Schema for a string that cannot be blank.

(mr/def ::non-blank-string
  [:and
   [:string {:min 1}]
   [:fn
    {:error/message "non-blank string"}
    (complement str/blank?)]])

Schema representing an integer than must also be greater than or equal to zero.

(mr/def ::int-greater-than-or-equal-to-zero
  [:int {:min 0}])
(mr/def ::positive-int
  pos-int?)
(mr/def ::positive-number
  [:fn
   {:error/message "positive number"}
   (every-pred number? pos?)])
(mr/def ::uuid
  ;; TODO -- should this be stricter?
  [:string {:min 36, :max 36}])
(defn- semantic-type? [x]
  (isa? x :Semantic/*))
(mr/def ::semantic-type
  [:fn
   {:error/message "valid semantic type"
    :error/fn      (fn [{:keys [value]} _]
                     (str "Not a valid semantic type: " (pr-str value)))}
   semantic-type?])
(defn- relation-type? [x]
  (isa? x :Relation/*))
(mr/def ::relation-type
  [:fn
   {:error/message "valid relation type"
    :error/fn      (fn [{:keys [value]} _]
                     (str "Not a valid relation type: " (pr-str value)))}
   relation-type?])
(mr/def ::semantic-or-relation-type
  [:or
   [:ref ::semantic-type]
   [:ref ::relation-type]])
(defn- base-type? [x]
  (isa? x :type/*))
(mr/def ::base-type
  [:fn
   {:error/message "valid base type"
    :error/fn      (fn [{:keys [value]} _]
                     (str "Not a valid base type: " (pr-str value)))}
   base-type?])
(mr/def ::options
  [:map
   [:lib/uuid ::uuid]
   ;; these options aren't required for any clause in particular, but if they're present they must follow these schemas.
   [:base-type      {:optional true} [:maybe ::base-type]]
   [:effective-type {:optional true} [:maybe ::base-type]]
   ;; these two different types are currently both stored under one key, but maybe one day we can fix this.
   [:semantic-type  {:optional true} [:maybe ::semantic-or-relation-type]]
   [:database-type  {:optional true} [:maybe ::non-blank-string]]
   [:name           {:optional true} [:maybe ::non-blank-string]]
   [:display-name   {:optional true} [:maybe ::non-blank-string]]])
(mr/def ::external-op
  [:map
   [:lib/type [:= :lib/external-op]]
   [:operator [:or :string :keyword]]
   [:args     [:sequential :any]]
   [:options {:optional true} ::options]])
 

Malli schemas for possible drill-thru operations.

Drill-thrus are not part of MBQL; they are a set of actions one can take to transform a query. For example, adding a filter like created_at < 2022-01-01, or following a foreign key.

(ns metabase.lib.schema.drill-thru
  (:require
   [metabase.lib.schema :as-alias lib.schema]
   [metabase.lib.schema.binning :as lib.schema.binning]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.expression :as lib.schema.expression]
   [metabase.lib.schema.filter :as lib.schema.filter]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.lib.schema.order-by :as lib.schema.order-by]
   [metabase.lib.schema.ref :as lib.schema.ref]
   [metabase.lib.schema.temporal-bucketing
    :as lib.schema.temporal-bucketing]
   [metabase.util.malli.registry :as mr]))
(mr/def ::pivot-types
  [:enum :category :location :time])
(mr/def ::drill-thru.type
  [:fn
   {:error/message "valid drill-thru :type keyword"}
   (fn [k]
     (and (qualified-keyword? k)
          (= (namespace k) "drill-thru")))])
(mr/def ::drill-thru.common
  [:map
   [:type     ::drill-thru.type]
   [:lib/type [:= :metabase.lib.drill-thru/drill-thru]]])

A drill thru that contains a column

(mr/def ::drill-thru.common.with-column
  [:merge
   ::drill-thru.common
   [:map
    [:column [:ref ::lib.schema.metadata/column]]]])

there are three "object details" drills: :pk, :fk-details, and :zoom. Originally, all three had :column and :object-id (value), but since we want :pk to handle multiple PKs (thus multiple columns and values) we changed it to instead have a list of :dimensions (similar in shape to ::context.row, but without requiring :column-ref). I didn't change the other ones so as to avoid unintentionally breaking something in the middle of the drills epic. We should revisit these shapes in the future. See https://metaboat.slack.com/archives/C04CYTEL9N2/p1701803047600169 for more information. -- Cam

(mr/def ::drill-thru.object-details.dimension
  [:map
   [:column [:ref ::lib.schema.metadata/column]]
   ;; we should ignore NULL values for PKs and FKs -- do not add filters on them.
   [:value  [:and
             :some
             [:fn {:error/message "Non-NULL value"} #(not= % :null)]]]])
(mr/def ::drill-thru.object-details.dimensions
  [:sequential {:min 1} [:ref ::drill-thru.object-details.dimension]])
(mr/def ::drill-thru.pk
  [:merge
   ::drill-thru.common
   [:map
    [:type       [:= :drill-thru/pk]]
    [:dimensions [:ref ::drill-thru.object-details.dimensions]]]])
(mr/def ::drill-thru.fk-details.fk-column
  [:merge
   [:ref ::lib.schema.metadata/column]
   [:map
    [:fk-target-field-id ::lib.schema.id/field]]])
(mr/def ::drill-thru.fk-details
  [:merge
   ::drill-thru.common.with-column
   [:map
    [:type      [:= :drill-thru/fk-details]]
    [:column    [:ref ::drill-thru.fk-details.fk-column]]
    [:object-id :any]
    [:many-pks? :boolean]]])
(mr/def ::drill-thru.zoom
  [:merge
   ::drill-thru.common.with-column
   [:map
    [:type      [:= :drill-thru/zoom]]
    [:object-id :any]
    ;; TODO -- I don't think we really need this because there is no situation in which this isn't `false`, if it were
    ;; true we'd return a `::drill-thru.pk` drill instead. See if we can remove this key without breaking the FE.
    [:many-pks? [:= false]]]])
(mr/def ::drill-thru.quick-filter.operator
  [:map
   [:name   ::lib.schema.common/non-blank-string]
   [:filter [:ref ::lib.schema.expression/boolean]]])
(mr/def ::drill-thru.quick-filter
  [:merge
   ::drill-thru.common
   [:map
    [:type         [:= :drill-thru/quick-filter]]
    [:operators    [:sequential ::drill-thru.quick-filter.operator]]
    [:column       [:ref ::lib.schema.metadata/column]]
    [:value        [:maybe :any]]
    [:query        [:ref ::lib.schema/query]]
    [:stage-number number?]]])
(mr/def ::drill-thru.fk-filter
  [:merge
   ::drill-thru.common
   [:map
    [:type   [:= :drill-thru/fk-filter]]
    [:filter ::lib.schema.expression/boolean]
    [:table-name :string]
    [:column-name :string]]])
(mr/def ::drill-thru.distribution
  [:merge
   ::drill-thru.common.with-column
   [:map
    [:type [:= :drill-thru/distribution]]]])
(mr/def ::drill-thru.pivot
  [:merge
   ::drill-thru.common
   [:map
    [:type   [:= :drill-thru/pivot]]
    [:pivots [:map-of ::pivot-types [:sequential [:ref ::lib.schema.metadata/column]]]]]])
(mr/def ::drill-thru.sort
  [:merge
   ::drill-thru.common
   [:map
    [:type            [:= :drill-thru/sort]]
    [:sort-directions [:sequential ::lib.schema.order-by/direction]]]])
(mr/def ::drill-thru.summarize-column.aggregation-type
  [:enum :avg :distinct :sum])
(mr/def ::drill-thru.summarize-column
  [:merge
   ::drill-thru.common.with-column
   [:map
    [:type         [:= :drill-thru/summarize-column]]
    [:aggregations [:sequential [:ref ::drill-thru.summarize-column.aggregation-type]]]]])
(mr/def ::drill-thru.summarize-column-by-time
  [:merge
   ::drill-thru.common.with-column
   [:map
    [:type     [:= :drill-thru/summarize-column-by-time]]
    [:breakout [:ref ::lib.schema.metadata/column]]
    [:unit     ::lib.schema.temporal-bucketing/unit]]])
(mr/def ::drill-thru.column-filter
  [:merge
   ::drill-thru.common.with-column
   [:map
    [:type         [:= :drill-thru/column-filter]]
    [:initial-op   [:maybe ::lib.schema.filter/operator]]
    [:column       [:ref ::lib.schema.metadata/column]]
    [:query        [:ref ::lib.schema/query]]
    [:stage-number number?]]])

TODO FIXME -- it seems like underlying records drills also include :dimensions and :column-ref... see [[metabase.lib.drill-thru.underlying-records/underlying-records-drill]]... this should be part of the schema

(mr/def ::drill-thru.underlying-records
  [:merge
   ::drill-thru.common
   [:map
    [:type       [:= :drill-thru/underlying-records]]
    [:row-count  number?]
    [:table-name [:maybe string?]]]])
(mr/def ::drill-thru.automatic-insights
  [:merge
   ::drill-thru.common
   [:map
    [:type     [:= :drill-thru/automatic-insights]]
    [:lib/type [:= :metabase.lib.drill-thru/drill-thru]]
    [:column-ref [:maybe [:ref ::lib.schema.ref/ref]]]
    [:dimensions [:ref ::context.row]]]])
(mr/def ::drill-thru.zoom-in.timeseries.next-unit
  [:enum :quarter :month :week :day :hour :minute])
(mr/def ::drill-thru.zoom-in.timeseries
  [:merge
   ::drill-thru.common
   [:map
    [:type      [:= :drill-thru/zoom-in.timeseries]]
    [:dimension [:ref ::context.row.value]]
    [:next-unit [:ref ::drill-thru.zoom-in.timeseries.next-unit]]]])
(mr/def ::drill-thru.zoom-in.geographic.column.latitude
  [:merge
   [:ref ::lib.schema.metadata/column]
   [:map
    [:semantic-type [:fn
                     {:error/message "Latitude semantic type"}
                     #(isa? % :type/Latitude)]]]])
(mr/def ::drill-thru.zoom-in.geographic.column.longitude
  [:merge
   [:ref ::lib.schema.metadata/column]
   [:map
    [:semantic-type [:fn
                     {:error/message "Longitude semantic type"}
                     #(isa? % :type/Longitude)]]]])
(mr/def ::drill-thru.zoom-in.geographic.column.county-state-city
  [:merge
   [:ref ::lib.schema.metadata/column]
   [:map
    [:semantic-type [:fn
                     {:error/message "Country/State/City semantic type"}
                     #(some (fn [semantic-type]
                              (isa? % semantic-type))
                            [:type/Country :type/State :type/City])]]]])
(mr/def ::drill-thru.zoom-in.geographic.country-state-city->binned-lat-lon
  [:merge
   ::drill-thru.common
   [:map
    [:type      [:= :drill-thru/zoom-in.geographic]]
    [:subtype   [:= :drill-thru.zoom-in.geographic/country-state-city->binned-lat-lon]]
    [:column    ::drill-thru.zoom-in.geographic.column.county-state-city]
    [:value     some?]
    [:latitude  [:map
                 [:column    [:ref ::drill-thru.zoom-in.geographic.column.latitude]]
                 [:bin-width [:ref ::lib.schema.binning/bin-width]]]]
    [:longitude [:map
                 [:column    [:ref ::drill-thru.zoom-in.geographic.column.longitude]]
                 [:bin-width [:ref ::lib.schema.binning/bin-width]]]]]])
(mr/def ::drill-thru.zoom-in.geographic.binned-lat-lon->binned-lat-lon
  [:merge
   ::drill-thru.common
   [:map
    [:type      [:= :drill-thru/zoom-in.geographic]]
    [:subtype   [:= :drill-thru.zoom-in.geographic/binned-lat-lon->binned-lat-lon]]
    [:latitude  [:map
                 [:column    [:ref ::drill-thru.zoom-in.geographic.column.latitude]]
                 [:bin-width [:ref ::lib.schema.binning/bin-width]]
                 [:min       number?]
                 [:max       number?]]]
    [:longitude [:map
                 [:column    [:ref ::drill-thru.zoom-in.geographic.column.longitude]]
                 [:bin-width [:ref ::lib.schema.binning/bin-width]]
                 [:min       number?]
                 [:max       number?]]]]])
(mr/def ::drill-thru.zoom-in.geographic
  [:and
   [:merge
    ::drill-thru.common
    [:map
     [:type    [:= :drill-thru/zoom-in.geographic]]
     [:subtype keyword?]]]
   [:multi {:dispatch :subtype
            :error/fn (fn [{:keys [value]} _]
                        (str "Invalid zoom-in.geographic drill thru subtype" (pr-str value)))}
    [:drill-thru.zoom-in.geographic/country-state-city->binned-lat-lon
     ::drill-thru.zoom-in.geographic.country-state-city->binned-lat-lon]
    [:drill-thru.zoom-in.geographic/binned-lat-lon->binned-lat-lon
     ::drill-thru.zoom-in.geographic.binned-lat-lon->binned-lat-lon]]])
(mr/def ::drill-thru.zoom-in.binning
  [:merge
   ::drill-thru.common.with-column
   [:map
    [:type        [:= :drill-thru/zoom-in.binning]]
    [:min-value   number?]
    [:max-value   number?]
    [:new-binning ::lib.schema.binning/binning]]])
(mr/def ::drill-thru
  [:and
   ::drill-thru.common
   [:multi {:dispatch :type
            :error/fn (fn [{:keys [value]} _]
                        (str "Invalid drill thru (unknown :type): " (pr-str value)))}
    [:drill-thru/pk                       ::drill-thru.pk]
    [:drill-thru/fk-details               ::drill-thru.fk-details]
    [:drill-thru/zoom                     ::drill-thru.zoom]
    [:drill-thru/quick-filter             ::drill-thru.quick-filter]
    [:drill-thru/fk-filter                ::drill-thru.fk-filter]
    [:drill-thru/distribution             ::drill-thru.distribution]
    [:drill-thru/pivot                    ::drill-thru.pivot]
    [:drill-thru/sort                     ::drill-thru.sort]
    [:drill-thru/summarize-column         ::drill-thru.summarize-column]
    [:drill-thru/summarize-column-by-time ::drill-thru.summarize-column-by-time]
    [:drill-thru/column-filter            ::drill-thru.column-filter]
    [:drill-thru/underlying-records       ::drill-thru.underlying-records]
    [:drill-thru/automatic-insights       ::drill-thru.automatic-insights]
    [:drill-thru/zoom-in.timeseries       ::drill-thru.zoom-in.timeseries]
    [:drill-thru/zoom-in.geographic       ::drill-thru.zoom-in.geographic]
    [:drill-thru/zoom-in.binning          ::drill-thru.zoom-in.binning]]])

Context

There are basically 5 shapes that contexts can come in, see this thread https://metaboat.slack.com/archives/C04CYTEL9N2/p1701898192634679 and https://github.com/metabase/metabase/issues/36253 for more info.

| Drill Context Shape | column | value | row | dimensions | |---------------------|--------|-------|-----|------------| | Column Header | ✔ | | | | | "Raw" Cell | ✔ | ✔ | ✔ | | | "Aggregated" Cell | ✔ | ✔ | ✔ | ✔ | | Pivot Cell | | ✔ | ✔ | ✔ | | Legend Item | | | | ✔ |

(mr/def ::context.row.value
  [:map
   [:column     [:ref ::lib.schema.metadata/column]]
   [:column-ref [:ref ::lib.schema.ref/ref]]
   [:value      [:fn
                 {:error/message ":null should not be used in context row values, only for top-level context value"}
                 #(not= % :null)]]])

Sequence of maps with keys :column, :column-ref, and :value

These are presumably in the same order as the returned columns for the query stage

(mr/def ::context.row
  [:sequential [:ref ::context.row.value]])
(mr/def ::context
  [:map
   [:column     [:maybe [:ref ::lib.schema.metadata/column]]]
   [:column-ref [:maybe [:ref ::lib.schema.ref/ref]]]
   [:value      [:maybe :any]]
   [:row        {:optional true} [:ref ::context.row]]
   [:dimensions {:optional true} [:maybe [:ref ::context.row]]]])
 
(ns metabase.lib.schema.expression
  (:require
   [metabase.lib.dispatch :as lib.dispatch]
   [metabase.lib.hierarchy :as lib.hierarchy]
   [metabase.lib.schema.common :as common]
   [metabase.shared.util.i18n :as i18n]
   [metabase.types]
   [metabase.util.malli :as mu]
   [metabase.util.malli.registry :as mr]))
(comment metabase.types/keep-me)

Impl for [[type-of]]. Use [[type-of]], but implement [[type-of-method]].

For MBQL clauses, try really hard not return an ambiguous set of possible types! Calculate things and determine what the result type will be!

If we don't have enough information to determine the type (e.g. a :field clause that needs a metadata provider to determine the type), return ::expression/type.unknown. This is a temporary workaround until we figure out how to always have type info!

(defmulti type-of-method
  {:arglists '([expr])}
  (fn [x]
    ;; For the fallback case: use the actual type/class name as the dispatch type rather than `:type/*`. This is so we
    ;; can implement support for some platform-specific classes like `BigDecimal` or `java.time.OffsetDateTime`, for
    ;; use inside QP code or whatever. In the future maybe we can add support for JS-specific stuff too.
    (let [dispatch-value (lib.dispatch/dispatch-value x)]
      (if (= dispatch-value :dispatch-type/*)
        (type x)
        dispatch-value)))
  :hierarchy lib.hierarchy/hierarchy)
(defn- mbql-clause? [expr]
  (and (vector? expr)
       (keyword? (first expr))))
(mr/def ::base-type
  [:or
   [:= ::type.unknown]
   ::common/base-type])
(mu/defn type-of :- [:or
                     ::base-type
                     [:set {:min 2} ::base-type]]
  "Determine the type of an MBQL expression. Returns either a type keyword, or if the type is ambiguous, a set of
  possible types."
  [expr]
  (or
   ;; for MBQL clauses with `:effective-type` or `:base-type` in their options: ignore their dumb [[type-of-method]] methods
   ;; and return that type directly. Ignore everything else! Life hack!
   (and (mbql-clause? expr)
        (map? (second expr))
        (or (:effective-type (second expr))
            (:base-type (second expr))))
   (type-of-method expr)))
(defmethod type-of-method :default
  [expr]
  (throw (ex-info (i18n/tru "{0}: Don''t know how to determine the type of {1}" `type-of (pr-str expr))
                  {:expr expr})))

for MBQL clauses whose type is the same as the type of the first arg. Also used for [[metabase.lib.metadata.calculation/type-of-method]].

(defmethod type-of-method :lib.type-of/type-is-type-of-first-arg
  [[_tag _opts expr]]
  (type-of expr))
(defn- is-type? [x y]
  (cond
    (set? x)             (some #(is-type? % y) x)
    (set? y)             (some #(is-type? x %) y)
    (= x ::type.unknown) true
    :else                (isa? x y)))

Whether the [[type-of]] expr isa? [[metabase.types]] base-type.

(defn type-of?
  [expr base-type]
  (let [expr-type (type-of expr)]
    (assert ((some-fn keyword? set?) expr-type)
            (i18n/tru "type-of {0} returned an invalid type {1}" (pr-str expr) (pr-str expr-type)))
    (is-type? expr-type base-type)))

Schema that matches the following rules:

1a. expression is not an MBQL clause, OR

1b. expression is an registered MBQL clause and matches the schema registered with [[metabase.lib.schema.mbql-clause]], AND

  1. expression's [[type-of]] isa? base-type
(defn- expression-schema
  [base-type description]
  [:and
   [:or
    [:fn
     {:error/message "valid MBQL clause"
      :error/fn      (fn [{:keys [value]} _]
                       (str "invalid MBQL clause: " (pr-str value)))}
     (complement mbql-clause?)]
    [:ref :metabase.lib.schema.mbql-clause/clause]]
   [:fn
    {:error/message description}
    #(type-of? % base-type)]])
(mr/def ::boolean
  (expression-schema :type/Boolean "expression returning a boolean"))
(mr/def ::string
  (expression-schema :type/Text "expression returning a string"))
(mr/def ::integer
  (expression-schema :type/Integer "expression returning an integer"))
(mr/def ::non-integer-real
  (expression-schema :type/Float "expression returning a non-integer real number"))
(mr/def ::number
  (expression-schema :type/Number "expression returning a number"))
(mr/def ::date
  (expression-schema :type/Date "expression returning a date"))
(mr/def ::time
  (expression-schema :type/Time "expression returning a time"))
(mr/def ::datetime
  (expression-schema :type/DateTime "expression returning a date time"))
(mr/def ::temporal
  (expression-schema :type/Temporal "expression returning a date, time, or date time"))

Set of base types that are orderable.

(def orderable-types
  #{:type/Text :type/Number :type/Temporal :type/Boolean})
(mr/def ::orderable
  (expression-schema orderable-types
                     "an expression that can be compared with :> or :<"))

Set of base types that can be compared with equality.

(def equality-comparable-types
  ;; TODO: Adding :type/* here was necessary to prevent type errors for queries where a field's type in the DB could not
  ;; be determined better than :type/*. See #36841, where a MySQL enum field gets `:base-type :type/*`, and this check
  ;; would fail on `[:= {} [:field ...] "enum-str"]` without `:type/*` here.
  ;; This typing of each input should be replaced with an alternative scheme that checks that it's plausible to compare
  ;; all the args to an `:=` clause. Eg. comparing `:type/*` and `:type/String` is cool. Comparing `:type/IPAddress` to
  ;; `:type/Boolean` should fail; we can prove it's the wrong thing to do.
   #{:type/Boolean :type/Text :type/Number :type/Temporal :type/IPAddress :type/MongoBSONID :type/Array :type/*})
(mr/def ::emptyable
  [:or
   [:ref ::string]
   (expression-schema :type/MongoBSONID "expression returning a BSONID")])
(mr/def ::equality-comparable
  [:maybe
   (expression-schema equality-comparable-types
                      "an expression that can appear in := or :!=")])

any type of expression.

(mr/def ::expression
  [:maybe (expression-schema :type/* "any type of expression")])

the :expressions definition map as found as a top-level key in an MBQL stage

(mr/def ::expressions
  [:sequential {:min 1} [:and [:ref ::expression]
                         [:cat :any [:map [:lib/expression-name :string]] [:* :any]]]])
 

Arithmetic expressions like :+.

(ns metabase.lib.schema.expression.arithmetic
  (:require
   [malli.core :as mc]
   [medley.core :as m]
   [metabase.lib.hierarchy :as lib.hierarchy]
   [metabase.lib.schema.common :as common]
   [metabase.lib.schema.expression :as expression]
   [metabase.lib.schema.mbql-clause :as mbql-clause]
   [metabase.lib.schema.temporal-bucketing :as temporal-bucketing]
   [metabase.types :as types]
   [metabase.util.malli.registry :as mr]))
(defn- valid-interval-for-type? [[_tag _opts _n unit :as _interval] expr-type]
  (let [unit-schema (cond
                      (isa? expr-type :type/Date)     ::temporal-bucketing/unit.date.interval
                      (isa? expr-type :type/Time)     ::temporal-bucketing/unit.time.interval
                      (isa? expr-type :type/DateTime) ::temporal-bucketing/unit.date-time.interval)]
    (if unit-schema
      (mc/validate unit-schema unit)
      true)))
(mr/def ::args.temporal
  [:and
   [:catn
    [:expr      [:schema [:ref ::expression/temporal]]]
    [:intervals [:+ [:ref :mbql.clause/interval]]]]
   [:fn
    {:error/message "Temporal arithmetic expression with valid interval units for the expression type"}
    (fn [[expr & intervals]]
      (let [expr-type (expression/type-of expr)]
        (every? #(valid-interval-for-type? % expr-type) intervals)))]])
(mr/def ::args.numbers
  [:repeat {:min 2} [:schema [:ref ::expression/number]]])

Validate a :+ or :- expression with temporal args. Return a string describing any errors found, or nil if it looks ok.

(defn- validate-plus-minus-temporal-arithmetic-expression
  [[_tag _opts & exprs]]
  (let [{non-intervals false, intervals true} (group-by #(isa? (expression/type-of %) :type/Interval) exprs)]
    (cond
      (not= (count non-intervals) 1)
      "Temporal arithmetic expression must contain exactly one non-interval value"
      (< (count intervals) 1)
      "Temporal arithmetic expression must contain at least one :interval"
      :else
      (let [expr-type (expression/type-of (first non-intervals))]
        (some (fn [[_tag _opts _n unit :as interval]]
                (when-not (valid-interval-for-type? interval expr-type)
                  (str "Cannot add a " unit " interval to a " expr-type " expression")))
              intervals)))))

Create a schema for :+ or :- with temporal args: ± in any order

(defn- plus-minus-temporal-interval-schema
  [tag]
  [:and
   {:error/message (str tag " clause with a temporal expression and one or more :interval clauses")}
   [:cat
    [:= tag]
    [:schema [:ref ::common/options]]
    [:repeat [:schema [:ref :mbql.clause/interval]]]
    [:schema [:ref ::expression/temporal]]
    [:repeat [:schema [:ref :mbql.clause/interval]]]]
   [:fn
    {:error/fn (fn [{:keys [value]} _]
                 (str "Invalid " tag " clause: " (validate-plus-minus-temporal-arithmetic-expression value)))}
    (complement validate-plus-minus-temporal-arithmetic-expression)]])

Create a schema for :+ or :- with numeric args.

(defn- plus-minus-numeric-schema
  [tag]
  [:cat
   {:error/message (str tag " clause with numeric args")}
   [:= tag]
   [:schema [:ref ::common/options]]
   [:repeat {:min 2} [:schema [:ref ::expression/number]]]])

Given a sequence of args to a numeric arithmetic expression like :+, determine the type returned by the expression by calculating the most-specific common ancestor type of all the args. E.g. [:+ ... 2.0 2.0] has two :type/Float args, and thus the most-specific common ancestor type is :type/Float. [:+ ... 2.0 2] has a :type/Float and a :type/Integer arg; the most-specific common ancestor type is :type/Number. For refs without type information (e.g. :field clauses), assume :type/Number.

(defn- type-of-numeric-arithmetic-args
  [args]
  ;; Okay to use reduce without an init value here since we know we have >= 2 args
  #_{:clj-kondo/ignore [:reduce-without-init]}
  (reduce
   types/most-specific-common-ancestor
   (map (fn [expr]
          (let [expr-type (expression/type-of expr)]
            (if (and (isa? expr-type ::expression/type.unknown)
                     (mc/validate :metabase.lib.schema.ref/ref expr))
              :type/Number
              expr-type)))
        args)))

Given a temporal value plus one or more intervals args passed to an arithmetic expression like :+, determine the overall type returned by the expression. This is the type of the temporal value (the arg that is not an interval), or assume :type/Temporal if it is a ref without type information.

(defn- type-of-temporal-arithmetic-args
  [args]
  (let [first-non-interval-arg-type (m/find-first #(not (isa? % :type/Interval))
                                                  (map expression/type-of args))]
    (if (isa? first-non-interval-arg-type ::expression/type.unknown)
      :type/Temporal
      first-non-interval-arg-type)))

Given a sequence of args to an arithmetic expression like :+, determine the overall type that the expression returns. There are three types of arithmetic expressions:

  • Ones consisting of numbers. See [[type-of-numeric-arithmetic-args]].

  • Ones consisting of a temporal value like a Date plus one or more :interval clauses, in any order. See [[type-of-temporal-arithmetic-args]].

  • Ones consisting of exactly two temporal values being subtracted to produce an :interval. See [[type-of-temporal-arithmetic-args]].

(defn- type-of-arithmetic-args
  [tag args]
  (cond
    ;; temporal value + intervals
    (some #(isa? (expression/type-of %) :type/Interval) args)
    (type-of-temporal-arithmetic-args args)
    ;; the difference of exactly two temporal values
    (and (= tag :-)
         (= (count args) 2)
         (or (every? #(isa? (expression/type-of %) :type/Date) args)
             (every? #(isa? (expression/type-of %) :type/DateTime) args)))
    :type/Interval
    ;; fall back to numeric args
    :else (type-of-numeric-arithmetic-args args)))
(def ^:private temporal-difference-schema
  [:cat
   {:error/message ":- clause taking the difference of two temporal expressions"}
   [:= :-]
   [:schema [:ref ::common/options]]
   [:schema [:ref ::expression/temporal]]
   [:schema [:ref ::expression/temporal]]])
(mbql-clause/define-mbql-clause :+
  [:or
   (plus-minus-temporal-interval-schema :+)
   (plus-minus-numeric-schema :+)])

TODO -- should :- support just a single arg (for numbers)? What about :+?

(mbql-clause/define-mbql-clause :-
  [:or
   (plus-minus-temporal-interval-schema :-)
   temporal-difference-schema
   (plus-minus-numeric-schema :-)])
(mbql-clause/define-catn-mbql-clause :*
  [:args ::args.numbers])

we always do non-integer real division even if all the expressions are integers, e.g.

[:/ 2] => myintfield / 2.0

so the results are 0.5 as opposed to 0. This is what people expect division to do

(mbql-clause/define-catn-mbql-clause :/ :- :type/Float
  [:args ::args.numbers])
(doseq [tag [:+ :- :*]]
  (lib.hierarchy/derive tag :lib.type-of/type-is-type-of-arithmetic-args))

:+, :-, and :* all have the same logic; also used for [[metabase.lib.metadata.calculation/type-of-method]]

(defmethod expression/type-of-method :lib.type-of/type-is-type-of-arithmetic-args
  [[tag _opts & args]]
  (type-of-arithmetic-args tag args))
(mbql-clause/define-tuple-mbql-clause :abs
  [:schema [:ref ::expression/number]])
(lib.hierarchy/derive :abs :lib.type-of/type-is-type-of-first-arg)
(doseq [op [:log :exp :sqrt]]
  (mbql-clause/define-tuple-mbql-clause op :- :type/Float
    [:schema [:ref ::expression/number]]))
(doseq [op [:ceil :floor :round]]
  (mbql-clause/define-tuple-mbql-clause op :- :type/Integer
    [:schema [:ref ::expression/number]]))
(mbql-clause/define-tuple-mbql-clause :power
  #_num [:schema [:ref ::expression/number]]
  #_exp [:schema [:ref ::expression/number]])
(defmethod expression/type-of-method :power
  [[_tag _opts expr exponent]]
  ;; if both expr and exponent are integers, this will return an integer.
  (if (and (isa? (expression/type-of expr) :type/Integer)
           (isa? (expression/type-of exponent) :type/Integer))
    :type/Integer
    ;; otherwise this will return some sort of number with a decimal place. e.g.
    ;;
    ;;    (Math/pow 2 2.1) => 4.2870938501451725
    ;;
    ;; If we don't know the type of `expr` or `exponent` it's safe to assume `:type/Float` anyway, maybe not as
    ;; specific as `:type/Integer` but better than `:type/*` or `::expression/type.unknown`.
    :type/Float))
 

Conditional expressions like :case and :coalesce.

(ns metabase.lib.schema.expression.conditional
  (:require
   [clojure.set :as set]
   [metabase.lib.schema.expression :as expression]
   [metabase.lib.schema.mbql-clause :as mbql-clause]
   [metabase.types :as types]
   [metabase.util.malli.registry :as mr]))

For expressions like :case and :coalesce that can return different possible expressions, determine the best return type given all of the various options.

the logic for calculating the return type of a :case or similar statement is not optimal nor perfect. But it should be ok for now and errors on the side of being permissive. See this Slack thread for more info: https://metaboat.slack.com/archives/C04DN5VRQM6/p1678325996901389

(defn- best-return-type
  [x y]
  (cond
    (nil? x)
    y
    ;; if the type of either x or y is unknown, then the overall type of this has to be unknown as well.
    (or (= x ::expression/type.unknown)
        (= y ::expression/type.unknown))
    ::expression/type.unknown
    ;; if both types are keywords return their most-specific ancestor.
    (and (keyword? x)
         (keyword? y))
    (types/most-specific-common-ancestor x y)
    ;; if one type is a specific type but the other is an ambiguous union of possible types, return the specific
    ;; type. A case can't possibly have multiple different return types, so if one expression has an unambiguous
    ;; type then the whole thing has to have a compatible type.
    (keyword? x)
    x
    (keyword? y)
    y
    ;; if both types are ambiguous unions of possible types then return the intersection of the two. But if the
    ;; intersection is empty, return the union of everything instead. I don't really want to go down a rabbit
    ;; hole of trying to find the intersection between the most-specific common ancestors
    :else
    (or (when-let [intersection (not-empty (set/intersection x y))]
          (if (= (count intersection) 1)
            (first intersection)
            intersection))
        (set/union x y))))

believe it or not, a :case clause really has the syntax [:case {} [[pred1 expr1] [pred2 expr2] ...]]

(mr/def ::case-subclause
  [:tuple
   {:error/message "Valid :case [pred expr] pair"}
   #_pred [:ref ::expression/boolean]
   #_expr [:ref ::expression/expression]])
(mbql-clause/define-catn-mbql-clause :case
  ;; TODO -- we should further constrain this so all of the exprs are of the same type
  [:pred-expr-pairs [:sequential {:min 1} [:ref ::case-subclause]]]
  [:default [:? [:schema [:ref ::expression/expression]]]])
(defmethod expression/type-of-method :case
  [[_tag _opts pred-expr-pairs default]]
  (reduce
   (fn [best-guess [_pred expr]]
     (let [expr-type (expression/type-of expr)]
       (best-return-type best-guess expr-type)))
   (when (some? default)
     (expression/type-of default))
   pred-expr-pairs))

TODO -- add constraint that these types have to be compatible

(mbql-clause/define-catn-mbql-clause :coalesce
  [:exprs [:repeat {:min 2} [:schema [:ref ::expression/expression]]]])
(defmethod expression/type-of-method :coalesce
  [[_tag _opts & exprs]]
  #_{:clj-kondo/ignore [:reduce-without-init]}
  (reduce best-return-type
          (map expression/type-of exprs)))
 
(ns metabase.lib.schema.expression.string
  (:require
    [metabase.lib.schema.expression :as expression]
    [metabase.lib.schema.mbql-clause :as mbql-clause]))
(doseq [op [:trim :ltrim :rtrim :upper :lower]]
  (mbql-clause/define-tuple-mbql-clause op :- :type/Text
    [:schema [:ref ::expression/string]]))
(mbql-clause/define-tuple-mbql-clause :length :- :type/Integer
  [:schema [:ref ::expression/string]])
(doseq [op [:regexextract :regex-match-first]]
  (mbql-clause/define-tuple-mbql-clause op :- :type/Text
    #_str [:schema [:ref ::expression/string]]
    ;; TODO regex type?
    #_regex [:schema [:ref ::expression/string]]))
(mbql-clause/define-tuple-mbql-clause :replace :- :type/Text
  #_str [:schema [:ref ::expression/string]]
  #_find [:schema [:ref ::expression/string]]
  #_replace [:schema [:ref ::expression/string]])
(mbql-clause/define-catn-mbql-clause :substring :- :type/Text
  [:str [:schema [:ref ::expression/string]]]
  [:start [:schema [:ref ::expression/integer]]]
  [:length [:? [:schema [:ref ::expression/integer]]]])
(mbql-clause/define-catn-mbql-clause :concat :- :type/Text
  [:args [:repeat {:min 2} [:schema [:ref ::expression/expression]]]])
 

Schemas for the various types of filter clauses that you'd pass to :filters or use inside something else that takes a boolean expression.

(ns metabase.lib.schema.filter
  (:require
   [metabase.lib.schema.common :as common]
   [metabase.lib.schema.expression :as expression]
   [metabase.lib.schema.mbql-clause :as mbql-clause]
   [metabase.lib.schema.temporal-bucketing :as temporal-bucketing]
   [metabase.util.malli.registry :as mr]))
(doseq [op [:and :or]]
  (mbql-clause/define-catn-mbql-clause op :- :type/Boolean
    [:args [:repeat {:min 2} [:schema [:ref ::expression/boolean]]]]))
(mbql-clause/define-tuple-mbql-clause :not :- :type/Boolean
  [:ref ::expression/boolean])
(doseq [op [:= :!=]]
  (mbql-clause/define-catn-mbql-clause op :- :type/Boolean
    [:args [:repeat {:min 2} [:schema [:ref ::expression/equality-comparable]]]]))
(doseq [op [:< :<= :> :>=]]
  (mbql-clause/define-tuple-mbql-clause op :- :type/Boolean
    #_x [:ref ::expression/orderable]
    #_y [:ref ::expression/orderable]))
(mbql-clause/define-tuple-mbql-clause :between :- :type/Boolean
  ;; TODO -- we should probably enforce additional constraints that the various arg types have to agree, e.g. it makes
  ;; no sense to say something like `[:between {} <date> <[:ref ::expression/string]> <integer>]`
  ;;
  ;; TODO -- should we enforce that min is <= max (for literal number values?)
  #_expr [:ref ::expression/orderable]
  #_min  [:ref ::expression/orderable]
  #_max  [:ref ::expression/orderable])

sugar: a pair of :between clauses

(mbql-clause/define-tuple-mbql-clause :inside :- :type/Boolean
  ;; TODO -- should we enforce that lat-min <= lat-max and lon-min <= lon-max? Should we enforce that -90 <= lat 90
  ;; and -180 <= lon 180 ?? (for literal number values)
  #_lat-expr [:ref ::expression/orderable]
  #_lon-expr [:ref ::expression/orderable]
  #_lat-max  [:ref ::expression/orderable]  ; north
  #_lon-min  [:ref ::expression/orderable]  ; west
  #_lat-min  [:ref ::expression/orderable]  ; south
  #_lon-max  [:ref ::expression/orderable]) ; east

null checking expressions

these are sugar for [:= ... nil] and [:!= ... nil] respectively

(doseq [op [:is-null :not-null]]
  (mbql-clause/define-tuple-mbql-clause op :- :type/Boolean
    [:ref ::expression/expression]))

one-arg [:ref ::expression/string] filter clauses

:is-empty is sugar for [:or [:= ... nil] [:= ... ""]]

:not-empty is sugar for [:and [:!= ... nil] [:!= ... ""]]

(doseq [op [:is-empty :not-empty]]
  (mbql-clause/define-tuple-mbql-clause op :- :type/Boolean
    [:ref ::expression/emptyable]))
(def ^:private string-filter-options
  [:map [:case-sensitive {:optional true} :boolean]]) ; default true

binary [:ref ::expression/string] filter clauses. These also accept a :case-sensitive option

:does-not-contain is sugar for [:not [:contains ...]]:

[:does-not-contain ...] = [:not [:contains ...]]

(doseq [op [:starts-with :ends-with :contains :does-not-contain]]
  (mbql-clause/define-mbql-clause op :- :type/Boolean
    [:tuple
     [:= op]
     [:merge ::common/options string-filter-options]
     #_whole [:ref ::expression/string]
     #_part  [:ref ::expression/string]]))
(def ^:private time-interval-options
  [:map [:include-current {:optional true} :boolean]]) ; default false

SUGAR: rewritten as a filter clause with a relative-datetime value

(mbql-clause/define-mbql-clause :time-interval :- :type/Boolean
  ;; TODO -- we should probably further constrain this so you can't do weird stuff like
  ;;
  ;;    [:time-interval {} <time> :current :year]
  ;;
  ;; using units that don't agree with the expr type
  [:tuple
   [:= :time-interval]
   [:merge ::common/options time-interval-options]
   #_expr [:ref ::expression/temporal]
   #_n    [:or
           [:enum :current :last :next]
           ;; I guess there's no reason you shouldn't be able to do something like 1 + 2 in here
           [:ref ::expression/integer]]
   #_unit [:ref ::temporal-bucketing/unit.date-time.interval]])

segments are guaranteed to return valid filter clauses and thus booleans, right?

(mbql-clause/define-mbql-clause :segment :- :type/Boolean
  [:tuple
   [:= :segment]
   ::common/options
   [:or ::common/positive-int ::common/non-blank-string]])
(mr/def ::operator
  [:map
   [:lib/type [:= :operator/filter]]
   [:short [:enum := :!= :inside :between :< :> :<= :>= :is-null :not-null :is-empty :not-empty :contains :does-not-contain :starts-with :ends-with]]
   ;; this is used for display name and it depends on the arguments to the filter clause itself... e.g.
   ;;
   ;; number_a < number_b
   ;;
   ;; gets a display name of "less than" for the operator, while
   ;;
   ;; timestamp_a < timestamp_b
   ;;
   ;; gets a display name of "before" for the operator. We don't want to encode the display name in the `::operator`
   ;; definition itself, because it forces us to do i18n in the definition itself; it's nicer to have static
   ;; definitions and only add the display name when we call `display-name` or `display-info`.
   [:display-name-variant :keyword]])
 
(ns metabase.lib.schema.id
  (:require
   [metabase.lib.schema.common :as common]
   [metabase.util.malli.registry :as mr]))

these aren't anything special right now, but maybe in the future we can do something special/intelligent with them, e.g. when we start working on the generative stuff

(mr/def ::database
  ::common/positive-int)

The ID used to signify that a database is 'virtual' rather than physical.

A fake integer ID is used so as to minimize the number of changes that need to be made on the frontend -- by using something that would otherwise be a legal ID, nothing need change there, and the frontend can query against this 'database' none the wiser. (This integer ID is negative which means it will never conflict with a real database ID.)

This ID acts as a sort of flag. The relevant places in the middleware can check whether the DB we're querying is this 'virtual' database and take the appropriate actions.

(def saved-questions-virtual-database-id
  -1337)

not sure under what circumstances we actually want to allow this, this is an icky hack. How are we supposed to resolve stuff with a fake Database ID? I guess as far as the schema is concerned we can allow this tho.

EDIT: Sometimes the FE uses this when starting a query based on a Card if it doesn't know the database associated with that Card. The QP will resolve this to the correct Database later.

(mr/def ::saved-questions-virtual-database
  [:= saved-questions-virtual-database-id])
(mr/def ::table
  ::common/positive-int)
(mr/def ::field
  ::common/positive-int)
(mr/def ::card
  ::common/positive-int)
(mr/def ::segment
  ::common/positive-int)
(mr/def ::metric
  ::common/positive-int)
(mr/def ::snippet
  ::common/positive-int)
(mr/def ::dimension
  ::common/positive-int)
 

Schemas for things related to joins.

(ns metabase.lib.schema.join
  (:require
   [metabase.lib.schema.common :as common]
   [metabase.lib.schema.expression :as expression]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util.malli.registry :as mr]))

The Fields to include in the results if a top-level :fields clause is not specified. This can be either :none, :all, or a sequence of Field clauses.

  • :none: no Fields from the joined table or nested query are included (unless indirectly included by breakouts or other clauses). This is the default, and what is used for automatically-generated joins.

  • :all: will include all of the Fields from the joined table or query

  • a sequence of Field clauses: include only the Fields specified. Only :field clauses are allowed here! References to expressions or aggregations in the thing we're joining should use column literal (string column name) :field references. This should be non-empty and all elements should be distinct. The normalizer will automatically remove duplicate fields for you, and replace empty clauses with :none.

Driver implementations: you can ignore this clause. Relevant fields will be added to top-level :fields clause with appropriate aliases.

(mr/def ::fields
  [:or
   [:enum :all :none]
   ;; TODO -- `:fields` is supposed to be distinct (ignoring UUID), e.g. you can't have `[:field {} 1]` in there
   ;; twice. (#32489)
   [:sequential {:min 1} [:ref :mbql.clause/field]]])

The name used to alias the joined table or query. This is usually generated automatically and generally looks like table__via__field. You can specify this yourself if you need to reference a joined field with a :join-alias in the options.

Driver implementations: This is guaranteed to be present after pre-processing.

(mr/def ::alias
  [:or
   {:gen/fmap #(str % "-" (random-uuid))}
   ::common/non-blank-string])
(mr/def ::conditions
  [:sequential {:min 1} [:ref ::expression/boolean]])

valid values for the optional :strategy key in a join. Note that these are only valid if the current Database supports that specific join type; these match 1:1 with the Database :features, e.g. a Database that supports left joins will support the :left-join feature.

When :strategy is not specified, :left-join is the default strategy.

(mr/def ::strategy
  [:enum
   :left-join
   :right-join
   :inner-join
   :full-join])
(mr/def ::join
  [:map
   [:lib/type    [:= :mbql/join]]
   [:lib/options ::common/options]
   [:stages      [:ref :metabase.lib.schema/stages]]
   [:conditions  ::conditions]
   [:alias       ::alias]
   [:fields   {:optional true} ::fields]
   [:strategy {:optional true} ::strategy]])
(mr/def ::joins
  [:and
   [:sequential {:min 1} [:ref ::join]]
   [:fn
    {:error/fn (fn [& _]
                 (i18n/tru "Join aliases must be unique at a given stage of a query"))}
    (fn ensure-unique-join-aliases [joins]
      (if-let [aliases (not-empty (filter some? (map :alias joins)))]
        (apply distinct? aliases)
        true))]])
(mr/def ::strategy.option
  [:map
   [:lib/type [:= :option/join.strategy]]
   [:strategy [:ref ::strategy]]
   [:default {:optional true} :boolean]])
 

JVM-specific literal definitions.

(ns metabase.lib.schema.literal.jvm
  (:require
   [metabase.lib.schema.expression :as expression]
   [metabase.util.malli.registry :as mr]))
(set! *warn-on-reflection* true)

Convenience for defining a Malli schema for an instance of a particular Class.

(defn instance-of
  [^Class klass]
  [:fn {:error/message (str "instance of " (.getName klass))}
   #(instance? klass %)])
(mr/def ::big-integer
  [:or
   (instance-of java.math.BigInteger)
   (instance-of clojure.lang.BigInt)])
(defmethod expression/type-of-method java.math.BigInteger
  [_n]
  :type/BigInteger)
(defmethod expression/type-of-method clojure.lang.BigInt
  [_n]
  :type/BigInteger)
(mr/def ::big-decimal
  (instance-of java.math.BigDecimal))
(defmethod expression/type-of-method java.math.BigDecimal
  [_n]
  :type/Decimal)
(mr/def ::float
  (instance-of Float))
(defmethod expression/type-of-method java.time.LocalDate
  [_t]
  :type/DateTime)
(defmethod expression/type-of-method java.time.LocalTime
  [_t]
  :type/Time)
(defmethod expression/type-of-method java.time.OffsetTime
  [_t]
  :type/TimeWithTZ)
(defmethod expression/type-of-method java.time.LocalDateTime
  [_t]
  :type/DateTime)
(defmethod expression/type-of-method java.time.OffsetDateTime
  [_t]
  :type/DateTimeWithZoneOffset)
(defmethod expression/type-of-method java.time.ZonedDateTime
  [_t]
  :type/DateTimeWithZoneID)
 
(ns metabase.lib.schema.mbql-clause
  (:require
   [malli.core :as mc]
   [metabase.lib.schema.common :as common]
   [metabase.lib.schema.expression :as expression]
   [metabase.types]
   [metabase.util.malli :as mu]
   [metabase.util.malli.registry :as mr]))
(comment metabase.types/keep-me)

Set of all registered MBQL clause tags e.g. #{:starts-with}

(defonce ^:private  tag-registry
  (atom #{}))

Given an MBQL clause tag like :starts-with, return the name of the schema we'll register for it, e.g. :mbql.clause/starts-with.

(defn- tag->registered-schema-name
  [tag]
  (keyword "mbql.clause" (name tag)))

Build the schema for ::clause, a :multi schema that maps MBQL clause tag -> the schema in [[clause-schema-registry]].

(defn- clause-schema
  []
  (into [:multi
         {:dispatch first
          :error/fn (fn [{:keys [value]} _]
                      (if (vector? value)
                        (str "Invalid " (pr-str (first value)) " clause: " (pr-str value))
                        "not an MBQL clause"))}
         [::mc/default [:fn {:error/message "not a known MBQL clause"} (constantly false)]]]
        (map (fn [tag]
               [tag [:ref (tag->registered-schema-name tag)]]))
        @tag-registry))
(defn- update-clause-schema! []
  (mr/def ::clause
    (clause-schema)))

create an initial empty definition of ::clause

(update-clause-schema!)

whenever [[tag-registry]] is updated, update the ::tag and ::clause schemas.

(add-watch tag-registry
           ::update-schemas
           (fn [_key _ref _old-state _new-state]
             (update-clause-schema!)))

Register the schema for an MBQL clause with tag keyword, and update the :metabase.lib.schema.mbql-clause/clause so it knows about this clause. Optionally specify the [[expression/type-of]] that this clause returns, inline, if the clause always returns a certain type; otherwise you can implement [[expression/type-of]] separately.

(define-mbql-clause :is-null :- :type/Boolean [:tuple [:= :is-null] ::common/options [:ref :metabase.lib.schema.expression/expression]])

(mu/defn define-mbql-clause
  ([tag :- simple-keyword?
    schema]
   (let [schema-name (tag->registered-schema-name tag)]
     (mr/def schema-name schema)
     ;; only need to update the registry and calculated schemas if this is the very first time we're defining this
     ;; clause. Otherwise since they're wrapped in `:ref` we don't need to recalculate them. This way we can avoid tons
     ;; of pointless recalculations every time we reload a namespace.
     (when-not (contains? @tag-registry tag)
       (swap! tag-registry conj tag)))
   nil)
  ([tag         :- simple-keyword?
    _arrow      :- [:= :-]
    return-type :- ::expression/base-type
    schema]
   (define-mbql-clause tag schema)
   (defmethod expression/type-of-method tag
     [_clause]
     return-type)
   nil))

TODO -- add more stuff.

Helper intended for use with [[define-mbql-clause]]. Create an MBQL clause schema with :catn. Use this for clauses with variable length. For clauses with fixed argument length, use [[tuple-clause-schema]] instead, since that gives slight better error messages and doesn't love to complain about 'potentially recursive seqexes' when you forget to wrap args in :schema.

(defn catn-clause-schema
  [tag & args]
  {:pre [(simple-keyword? tag)
         (every? vector? args)
         (every? keyword? (map first args))]}
  [:schema
   (into [:catn
          {:error/message (str "Valid " tag " clause")}
          [:tag [:= tag]]
          [:options [:schema [:ref ::common/options]]]]
         args)])

Helper intended for use with [[define-mbql-clause]]. Create a clause schema with :tuple. Use this for fixed-length MBQL clause schemas. Use [[catn-clause-schema]] for variable-length schemas.

(defn tuple-clause-schema
  [tag & args]
  {:pre [(simple-keyword? tag)]}
  (into [:tuple
         {:error/message (str "Valid " tag " clause")}
         [:= tag]
         [:ref ::common/options]]
        args))

Even more convenient functions!

(defn- define-mbql-clause-with-schema-fn [schema-fn tag & args]
  (let [[return-type & args] (if (= (first args) :-)
                               (cons (second args) (drop 2 args))
                               (cons nil args))
        schema               (apply schema-fn tag args)]
    (if return-type
      (define-mbql-clause tag :- return-type schema)
      (define-mbql-clause tag schema))))

Helper. Combines [[define-mbql-clause]] and [[tuple-clause-schema]].

(defn define-tuple-mbql-clause
  [tag & args]
  (apply define-mbql-clause-with-schema-fn tuple-clause-schema tag args))

Helper. Combines [[define-mbql-clause]] and [[catn-clause-schema]].

(defn define-catn-mbql-clause
  [tag & args]
  (apply define-mbql-clause-with-schema-fn catn-clause-schema tag args))

For REPL/test usage: get the definition of the schema associated with an MBQL clause tag.

(defn resolve-schema
  [tag]
  (mr/resolve-schema (tag->registered-schema-name tag)))
 
(ns metabase.lib.schema.metadata
  (:require
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.util.malli.registry :as mr]))

Column vs Field?

Lately I've been using Field to only mean a something that lives in the application database, i.e. something that is associated with row in the Field table and has an :id. I'm using Column as a more generic term that includes not only Fields but also the columns returned by a stage of a query, e.g. SELECT count(*) AS count returns a Column called count, but it's not a Field because it's not associated with an actual Field in the application database.

Column = any column returned by a query or stage of a query Field = a Column that is associated with a capital-F Field in the application database, i.e. has an :id

All Fields are Columns, but not all Columns are Fields.

Also worth a mention: we also have Dimensions, associated with the dimension table in the application database, which can act like psuedo-Fields or affect how we treat normal Fields. For example, Dimensions are used to implement column remapping, e.g. the GUI might display values of categories.name when it presents filter options for venues.category_id -- you can remap a meaningless integer FK column to something more helpful. 'Human readable values' like these can also be entered manually from the GUI, for example for enum columns. How will this affect what MLv2 needs to know or does? Not clear at this point, but we'll probably want to abstract away dealing with Dimensions in the future so the FE QB GUI doesn't need to special case them.

(mr/def ::column-source
  [:enum
   ;; these are for things from some sort of source other than the current stage;
   ;; they must be referenced with string names rather than Field IDs
   :source/card
   :source/native
   :source/previous-stage
   ;; these are for things that were introduced by the current stage of the query; `:field` references should be
   ;; referenced with Field IDs if available.
   ;;
   ;; default columns returned by the `:source-table` for the current stage.
   :source/table-defaults
   ;; specifically introduced by the corresponding top-level clauses.
   :source/fields
   :source/aggregations
   :source/breakouts
   ;; introduced by a join, not necessarily ultimately returned.
   :source/joins
   ;; Introduced by `:expressions`; not necessarily ultimately returned.
   :source/expressions
   ;; Not even introduced, but 'visible' because this column is implicitly joinable.
   :source/implicitly-joinable])

The way FieldValues/remapping works is hella confusing, because it involves the FieldValues table and Dimension table, and the has_field_values column, nobody knows why life is like this TBH. The docstrings in [[metabase.models.field-values]], [[metabase.models.params.chain-filter]], and [[metabase.query-processor.middleware.add-dimension-projections]] explain this stuff in more detail, read those and then maybe you will understand what the hell is going on.

Possible options for column metadata :has-field-values. This is used to determine whether we keep FieldValues for a Field (during sync), and which type of widget should be used to pick values of this Field when filtering by it in the Query Builder. Not otherwise used by MLv2 (except for [[metabase.lib.field/field-values-search-info]], which is a frontend convenience) or QP at the time of this writing. For column remapping purposes in the Query Processor and MLv2 we just ignore has_field_values and only look for FieldValues/Dimension.

(def column-has-field-values-options
  ;; AUTOMATICALLY-SET VALUES, SET DURING SYNC
  ;;
  ;; `nil` -- means infer which widget to use based on logic in [[metabase.lib.field/infer-has-field-values]]; this
  ;; will either return `:search` or `:none`.
  ;;
  ;; This is the default state for Fields not marked `auto-list`. Admins cannot explicitly mark a Field as
  ;; `has_field_values` `nil`. This value is also subject to automatically change in the future if the values of a
  ;; Field change in such a way that it can now be marked `auto-list`. Fields marked `nil` do *not* have FieldValues
  ;; objects.
  ;;
  #{;; The other automatically-set option. Automatically marked as a 'List' Field based on cardinality and other factors
    ;; during sync. Store a FieldValues object; use the List Widget. If this Field goes over the distinct value
    ;; threshold in a future sync, the Field will get switched back to `has_field_values = nil`.
    ;;
    ;; Note that when this comes back from the REST API or [[metabase.lib.field/field-values-search-info]] we always
    ;; return this as `:list` instead of `:auto-list`; this is done by [[metabase.lib.field/infer-has-field-values]].
    ;; I guess this is because the FE isn't supposed to need to care about whether this is `:auto-list` vs `:list`;
    ;; those distinctions are only important for sync I guess.
    :auto-list
    ;;
    ;; EXPLICITLY-SET VALUES, SET BY AN ADMIN
    ;;
    ;; Admin explicitly marked this as a 'Search' Field, which means we should *not* keep FieldValues, and should use
    ;; Search Widget.
    :search
    ;; Admin explicitly marked this as a 'List' Field, which means we should keep FieldValues, and use the List
    ;; Widget. Unlike `auto-list`, if this Field grows past the normal cardinality constraints in the future, it will
    ;; remain `List` until explicitly marked otherwise.
    :list
    ;; Admin explicitly marked that this Field shall always have a plain-text widget, neither allowing search, nor
    ;; showing a list of possible values. FieldValues not kept.
    :none})
(mr/def ::column.has-field-values
  (into [:enum] (sort column-has-field-values-options)))

External remapping (Dimension) for a column. From the [[metabase.models.dimension]] with type = external associated with a Field in the application database. See [[metabase.query-processor.middleware.add-dimension-projections]] for what this means.

(mr/def ::column.remapping.external
  [:map
   [:lib/type [:= :metadata.column.remapping/external]]
   [:id       ::lib.schema.id/dimension]
   ;; from `dimension.name`
   [:name     ::lib.schema.common/non-blank-string]
   ;; `dimension.human_readable_field_id` in the application database. ID of the Field to get human-readable values
   ;; from. e.g. if the column in question is `venues.category-id`, then this would be the ID of `categories.name`
   [:field-id ::lib.schema.id/field]])

Internal remapping (FieldValues) for a column. From [[metabase.models.dimension]] with type = internal and the [[metabase.models.field-values]] associated with a Field in the application database. See [[metabase.query-processor.middleware.add-dimension-projections]] for what this means.

(mr/def ::column.remapping.internal
  [:map
   [:lib/type              [:= :metadata.column.remapping/internal]]
   [:id                    ::lib.schema.id/dimension]
   ;; from `dimension.name`
   [:name                  ::lib.schema.common/non-blank-string]
   ;; From `metabase_fieldvalues.values`. Original values
   [:values                [:sequential :any]]
   ;; From `metabase_fieldvalues.human_readable_values`. Human readable remaps for the values at the same indexes in
   ;; `:values`
   [:human-readable-values [:sequential :any]]])
(mr/def ::column
  [:map
   {:error/message "Valid column metadata"}
   [:lib/type  [:= :metadata/column]]
   ;; column names are allowed to be empty strings in SQL Server :/
   [:name      :string]
   ;; TODO -- ignore `base_type` and make `effective_type` required; see #29707
   [:base-type ::lib.schema.common/base-type]
   [:id             {:optional true} ::lib.schema.id/field]
   [:display-name   {:optional true} [:maybe :string]]
   [:effective-type {:optional true} [:maybe ::lib.schema.common/base-type]]
   ;; if this is a field from another table (implicit join), this is the field in the current table that should be
   ;; used to perform the implicit join. e.g. if current table is `VENUES` and this field is `CATEGORIES.ID`, then the
   ;; `fk_field_id` would be `VENUES.CATEGORY_ID`. In a `:field` reference this is saved in the options map as
   ;; `:source-field`.
   [:fk-field-id {:optional true} [:maybe ::lib.schema.id/field]]
   ;; `metabase_field.fk_target_field_id` in the application database; recorded during the sync process. This Field is
   ;; an foreign key, and points to this Field ID. This is mostly used to determine how to add implicit joins by
   ;; the [[metabase.query-processor.middleware.add-implicit-joins]] middleware.
   [:fk-target-field-id {:optional true} [:maybe ::lib.schema.id/field]]
   ;; Join alias of the table we're joining against, if any. Not really 100% clear why we would need this on top
   ;; of [[metabase.lib.join/current-join-alias]], which stores the same info under a namespaced key. I think we can
   ;; remove it.
   [:source-alias {:optional true} [:maybe ::lib.schema.common/non-blank-string]]
   ;; name of the expression where this column metadata came from. Should only be included for expressions introduced
   ;; at THIS STAGE of the query. If it's included elsewhere, that's an error. Thus this is the definitive way to know
   ;; if a column is "custom" in this stage (needs an `:expression` reference) or not.
   [:lib/expression-name {:optional true} [:maybe ::lib.schema.common/non-blank-string]]
   ;; what top-level clause in the query this metadata originated from, if it is calculated (i.e., if this metadata
   ;; was generated by [[metabase.lib.metadata.calculation/metadata]])
   [:lib/source {:optional true} [:ref ::column-source]]
   ;; ID of the Card this came from, if this came from Card results metadata. Mostly used for creating column groups.
   [:lib/card-id {:optional true} [:maybe ::lib.schema.id/card]]
   ;;
   ;; this stuff is adapted from [[metabase.query-processor.util.add-alias-info]]. It is included in
   ;; the [[metabase.lib.metadata.calculation/metadata]]
   ;;
   ;; the alias that should be used to this clause on the LHS of a `SELECT <lhs> AS <rhs>` or equivalent, i.e. the
   ;; name of this clause as exported by the previous stage, source table, or join.
   [:lib/source-column-alias {:optional true} [:maybe ::lib.schema.common/non-blank-string]]
   ;; the name we should export this column as, i.e. the RHS of a `SELECT <lhs> AS <rhs>` or equivalent. This is
   ;; guaranteed to be unique in each stage of the query.
   [:lib/desired-column-alias {:optional true} [:maybe [:string {:min 1, :max 60}]]]
   ;; when column metadata is returned by certain things
   ;; like [[metabase.lib.aggregation/selected-aggregation-operators]] or [[metabase.lib.field/fieldable-columns]], it
   ;; might include this key, which tells you whether or not that column is currently selected or not already, e.g.
   ;; for [[metabase.lib.field/fieldable-columns]] it means its already present in `:fields`
   [:selected? {:optional true} :boolean]
   ;;
   ;; REMAPPING & FIELD VALUES
   ;;
   ;; See notes above for more info. `:has-field-values` comes from the application database and is used to decide
   ;; whether to sync FieldValues when running sync, and what certain FE QB widgets should
   ;; do. (See [[metabase.lib.field/field-values-search-info]]). Note that all metadata providers may not return this
   ;; column. The JVM provider currently does not, since the QP doesn't need it for anything.
   [:has-field-values {:optional true} [:maybe [:ref ::column.has-field-values]]]
   ;;
   ;; these next two keys are derived by looking at `FieldValues` and `Dimension` instances associated with a `Field`;
   ;; they are used by the Query Processor to add column remappings to query results. To see how this maps to stuff in
   ;; the application database, look at the implementation for fetching a `:metadata/column`
   ;; in [[metabase.lib.metadata.jvm]]. I don't think this is really needed on the FE, at any rate the JS metadata
   ;; provider doesn't add these keys.
   [:lib/external-remap {:optional true} [:maybe [:ref ::column.remapping.external]]]
   [:lib/internal-remap {:optional true} [:maybe [:ref ::column.remapping.internal]]]])

Definition spec for a cached table.

(mr/def ::persisted-info.definition
  [:map
   [:table-name        ::lib.schema.common/non-blank-string]
   [:field-definitions [:maybe [:sequential
                                [:map
                                 [:field-name ::lib.schema.common/non-blank-string]
                                 ;; TODO check (isa? :type/Integer :type/*)
                                 [:base-type  ::lib.schema.common/base-type]]]]]])

Persisted Info = Cached Table (?). See [[metabase.models.persisted-info]]

(mr/def ::persisted-info
  [:map
   [:active     :boolean]
   [:state      ::lib.schema.common/non-blank-string]
   [:table-name ::lib.schema.common/non-blank-string]
   [:definition {:optional true} [:maybe [:ref ::persisted-info.definition]]]
   [:query-hash {:optional true} [:maybe ::lib.schema.common/non-blank-string]]])
(mr/def ::card
  [:map
   {:error/message "Valid Card metadata"}
   [:lib/type    [:= :metadata/card]]
   [:id          ::lib.schema.id/card]
   [:name        ::lib.schema.common/non-blank-string]
   [:database-id ::lib.schema.id/database]
   ;; saved query. This is possibly still a legacy query, but should already be normalized.
   ;; Call [[metabase.lib.convert/->pMBQL]] on it as needed
   [:dataset-query   {:optional true} :map]
   ;; vector of column metadata maps; these are ALMOST the correct shape to be [[ColumnMetadata]], but they're
   ;; probably missing `:lib/type` and probably using `:snake_case` keys.
   [:result-metadata {:optional true} [:maybe [:sequential :map]]]
   ;; whether this Card is a Model or not.
   [:dataset         {:optional true} :boolean]
   ;; Table ID is nullable in the application database, because native queries are not necessarily associated with a
   ;; particular Table (unless they are against MongoDB)... for MBQL queries it should be populated however.
   [:table-id        {:optional true} [:maybe ::lib.schema.id/table]]
   ;;
   ;; PERSISTED INFO: This comes from the [[metabase.models.persisted-info]] model.
   ;;
   [:lib/persisted-info {:optional true} [:maybe [:ref ::persisted-info]]]])
(mr/def ::segment
  [:map
   {:error/message "Valid Segment metadata"}
   [:lib/type   [:= :metadata/segment]]
   [:id         ::lib.schema.id/segment]
   [:name       ::lib.schema.common/non-blank-string]
   [:table-id   ::lib.schema.id/table]
   ;; the MBQL snippet defining this Segment; this may still be in legacy
   ;; format. [[metabase.lib.segment/segment-definition]] handles conversion to pMBQL if needed.
   [:definition [:maybe :map]]
   [:description {:optional true} [:maybe ::lib.schema.common/non-blank-string]]])
(mr/def ::metric
  [:map
   {:error/message "Valid Metric metadata"}
   [:lib/type   [:= :metadata/metric]]
   [:id         ::lib.schema.id/metric]
   [:name       ::lib.schema.common/non-blank-string]
   [:table-id   ::lib.schema.id/table]
   ;; the MBQL snippet defining this Metric; this may still be in legacy
   ;; format. [[metabase.lib.metric/metric-definition]] handles conversion to pMBQL if needed.
   [:definition [:maybe :map]]
   [:description {:optional true} [:maybe ::lib.schema.common/non-blank-string]]])
(mr/def ::table
  [:map
   {:error/message "Valid Table metadata"}
   [:lib/type [:= :metadata/table]]
   [:id       ::lib.schema.id/table]
   [:name     ::lib.schema.common/non-blank-string]
   [:display-name {:optional true} [:maybe ::lib.schema.common/non-blank-string]]
   [:schema       {:optional true} [:maybe ::lib.schema.common/non-blank-string]]])
(mr/def ::database
  [:map
   {:error/message "Valid Database metadata"}
   [:lib/type [:= :metadata/database]]
   [:id ::lib.schema.id/database]
   ;; TODO -- this should validate against the driver features list in [[metabase.driver/driver-features]] if we're in
   ;; Clj mode
   [:dbms-version {:optional true} [:maybe :map]]
   [:details      {:optional true} :map]
   [:engine       {:optional true} :keyword]
   [:features     {:optional true} [:set :keyword]]
   [:is-audit     {:optional true} :boolean]
   [:settings     {:optional true} [:maybe :map]]])
(mr/def ::metadata-provider
  [:fn
   {:error/message "Valid MetadataProvider"}
   #'lib.metadata.protocols/metadata-provider?])
(mr/def ::metadata-providerable
  [:or
   [:ref ::metadata-provider]
   [:map
    {:error/message "map with a MetadataProvider in the key :lib/metadata (i.e. a query)"}
    [:lib/metadata [:ref ::metadata-provider]]]])
 

Schemas for order-by clauses.

(ns metabase.lib.schema.order-by
  (:require
   [metabase.lib.schema.expression :as expression]
   [metabase.lib.schema.mbql-clause :as mbql-clause]
   [metabase.util.malli.registry :as mr]))
(mr/def ::direction
  [:enum :asc :desc])
(mbql-clause/define-tuple-mbql-clause :asc
  [:ref ::expression/orderable])
(mbql-clause/define-tuple-mbql-clause :desc
  [:ref ::expression/orderable])
(mr/def ::order-by
  [:and
   [:ref ::mbql-clause/clause]
   [:fn
    {:error/message ":asc or :desc clause"}
    (fn [[tag]]
      (#{:asc :desc} tag))]])

TODO -- should there be a no-duplicates constraint here?

(mr/def ::order-bys
  [:sequential {:min 1} [:ref ::order-by]])
 

Malli schema for a Field, aggregation, or expression reference (etc.)

(ns metabase.lib.schema.ref
  (:require
   [clojure.string :as str]
   [metabase.lib.dispatch :as lib.dispatch]
   [metabase.lib.hierarchy :as lib.hierarchy]
   [metabase.lib.schema.common :as common]
   [metabase.lib.schema.expression :as expression]
   [metabase.lib.schema.id :as id]
   [metabase.lib.schema.mbql-clause :as mbql-clause]
   [metabase.lib.schema.temporal-bucketing :as temporal-bucketing]
   [metabase.types]
   [metabase.util.malli.registry :as mr]))
(comment metabase.types/keep-me)
(mr/def ::field.options
  [:merge
   ::common/options
   [:map
    [:temporal-unit {:optional true} ::temporal-bucketing/unit]]])
(mr/def ::field.literal.options
  [:merge
   ::field.options
   [:map
    [:base-type ::common/base-type]]])

:field clause

(mr/def ::field.literal
  [:tuple
   [:= :field]
   ::field.literal.options
   ::common/non-blank-string])
(mr/def ::field.id
  [:tuple
   [:= :field]
   ::field.options ; TODO -- we should make `:base-type` required here too
   ::id/field])
(mbql-clause/define-mbql-clause :field
  [:and
   [:tuple
    [:= :field]
    ::field.options
    [:or ::id/field ::common/non-blank-string]]
   [:multi {:dispatch      (fn [clause]
                             ;; apparently it still tries to dispatch when humanizing errors even if the `:tuple`
                             ;; schema above failed, so we need to check that this is actually a tuple here again.
                             (when (sequential? clause)
                               (let [[_field _opts id-or-name] clause]
                                 (lib.dispatch/dispatch-value id-or-name))))
            ;; without this it gives us dumb messages like "Invalid dispatch value" if the dispatch function above
            ;; doesn't return something that matches.
            :error/message "Invalid :field clause ID or name: must be a string or integer"}
    [:dispatch-type/integer ::field.id]
    [:dispatch-type/string ::field.literal]]])
(lib.hierarchy/derive :field ::ref)
(defmethod expression/type-of-method :field
  [[_tag opts _id-or-name]]
  (or ((some-fn :effective-type :base-type) opts)
      ::expression/type.unknown))
(mbql-clause/define-tuple-mbql-clause :expression
  ::common/non-blank-string)
(defmethod expression/type-of-method :expression
  [[_tag opts _expression-name]]
  (or ((some-fn :effective-type :base-type) opts)
      ::expression/type.unknown))
(lib.hierarchy/derive :expression ::ref)
(mr/def ::aggregation-options
  [:merge
   ::common/options
   [:map
    [:name {:optional true} ::common/non-blank-string]
    [:display-name {:optional true} ::common/non-blank-string]]])
(mbql-clause/define-mbql-clause :aggregation
  [:tuple
   [:= :aggregation]
   ::aggregation-options
   :string])
(defmethod expression/type-of-method :aggregation
  [[_tag opts _index]]
  (or ((some-fn :effective-type :base-type) opts)
      ::expression/type.unknown))
(lib.hierarchy/derive :aggregation ::ref)
(mbql-clause/define-tuple-mbql-clause :segment :- :type/Boolean
  #_segment-id [:schema [:ref ::id/segment]])
(lib.hierarchy/derive :segment ::ref)
(mbql-clause/define-tuple-mbql-clause :metric :- ::expression/type.unknown
  #_metric-id [:schema [:ref ::id/metric]])
(lib.hierarchy/derive :metric ::ref)
(mr/def ::ref
  [:and
   ::mbql-clause/clause
   [:fn
    {:error/fn (fn [_ _]
                 (str "Valid reference, must be one of these clauses: "
                      (str/join ", " (sort (descendants @lib.hierarchy/hierarchy ::ref)))))}
    (fn [[tag :as _clause]]
      (lib.hierarchy/isa? tag ::ref))]])
 
(ns metabase.lib.schema.template-tag
  (:require
   [malli.core :as mc]
   [metabase.lib.schema.common :as common]
   [metabase.lib.schema.id :as id]
   [metabase.mbql.schema :as mbql.s]
   [metabase.util.malli.registry :as mr]))

Schema for valid values of :widget-type for a [[TemplateTag:FieldFilter]].

(mr/def ::widget-type
  (into
   [:enum
    ;; this will be a nicer error message than Malli trying to list every single possible allowed type.
    {:error/message "Valid template tag :widget-type"}
    :none]
   (keys mbql.s/parameter-types)))

Schema for valid values of template tag :type.

(mr/def ::type
  [:enum :snippet :card :dimension :number :text :date])

Things required by all template tag types.

(mr/def ::common
  [:map
   [:name         ::common/non-blank-string]
   [:display-name ::common/non-blank-string]
   ;; TODO -- `:id` is actually 100% required but we have a lot of tests that don't specify it because this constraint
   ;; wasn't previously enforced; we need to go in and fix those tests and make this non-optional
   [:id {:optional true} [:or ::common/non-blank-string :uuid]]])

Stuff shared between the Field filter and raw value template tag schemas.

(mr/def ::value.common
  [:merge
   [:ref ::common]
   [:map
    ;; default value for this parameter
    [:default {:optional true} any?]
    ;; whether or not a value for this parameter is required in order to run the query
    [:required {:optional true} :boolean]]])

Example:

{:id "c20851c7-8a80-0ffa-8a99-ae636f0e9539" :name "date" :display-name "Date" :type :dimension, :dimension [:field 4 nil] :widget-type :date/all-options}

(mr/def ::field-filter
  [:merge
   [:ref ::value.common]
   [:map
    [:type        [:= :dimension]]
    [:dimension   [:ref :mbql.clause/field]]
    ;; which type of widget the frontend should show for this Field Filter; this also affects which parameter types
    ;; are allowed to be specified for it.
    [:widget-type [:ref ::widget-type]]
    ;; optional map to be appended to filter clause
    [:options {:optional true} :map]]])

Example:

{:id "c2fc7310-44eb-4f21-c3a0-63806ffb7ddd" :name "snippet: select" :display-name "Snippet: select" :type :snippet :snippet-name "select" :snippet-id 1}

(mr/def ::snippet
  [:merge
   [:ref ::common]
   [:map
    [:type         [:= :snippet]]
    [:snippet-name ::common/non-blank-string]
    [:snippet-id {:optional true} ::id/snippet]
    ;; database to which this Snippet belongs. Doesn't always seem to be specified.
    [:database {:optional true} ::id/database]]])

Example:

{:id "fc5e14d9-7d14-67af-66b2-b2a6e25afeaf" :name "#1635" :display-name "#1635" :type :card :card-id 1635}

(mr/def ::source-query
  [:merge
   [:ref ::common]
   [:map
    [:type    [:= :card]]
    [:card-id ::id/card]]])

Valid values of :type for raw value template tags.

(mr/def ::raw-value.type
  (into [:enum] mbql.s/raw-value-template-tag-types))

Example:

{:id "35f1ecd4-d622-6d14-54be-750c498043cb" :name "id" :display-name "Id" :type :number :required true :default "1"}

(mr/def ::raw-value
  [:merge
   [:ref ::value.common]
   ;; `:type` is used be the FE to determine which type of widget to display for the template tag, and to determine
   ;; which types of parameters are allowed to be passed in for this template tag.
   [:map
    [:type [:ref ::raw-value.type]]]])
(mr/def ::template-tag
  [:and
   [:map
    [:type [:ref ::type]]]
   [:multi {:dispatch :type}
    [:dimension   [:ref ::field-filter]]
    [:snippet     [:ref ::snippet]]
    [:card        [:ref ::source-query]]
    ;; :number, :text, :date
    [::mc/default [:ref ::raw-value]]]])
(mr/def ::template-tag-map
  [:and
   [:map-of ::common/non-blank-string [:ref ::template-tag]]
   ;; make sure people don't try to pass in a `:name` that's different from the actual key in the map.
   [:fn
    {:error/message "keys in template tag map must match the :name of their values"}
    (fn [m]
      (every? (fn [[tag-name tag-definition]]
                (= tag-name (:name tag-definition)))
              m))]])
 

Malli schema for temporal bucketing units and expressions.

(ns metabase.lib.schema.temporal-bucketing
  (:require
   [clojure.set :as set]
   [metabase.util.malli.registry :as mr]))

Units that you can EXTRACT from a date or datetime. These return integers in temporal bucketing expressions. The front end shows the options in this order.

(def ordered-date-extraction-units
  [:day-of-week
   :day-of-month
   :day-of-year
   :week-of-year
   :month-of-year
   :quarter-of-year
   :year
   :year-of-era])

Units that you can EXTRACT from a date or datetime. These return integers in temporal bucketing expressions.

(def date-extraction-units
  (set ordered-date-extraction-units))
(mr/def ::unit.date.extract
  (into [:enum {:error/message "Valid date extraction unit"}] date-extraction-units))

Units that you can TRUNCATE a date or datetime to. In temporal bucketing expressions these return a :type/Date. The front end shows the options in this order.

(def ordered-date-truncation-units
  [:day :week :month :quarter :year])

Units that you can TRUNCATE a date or datetime to. In temporal bucketing expressions these return a :type/Date.

(def date-truncation-units
  (set ordered-date-truncation-units))
(mr/def ::unit.date.truncate
  (into [:enum {:error/message "Valid date truncation unit"}] date-truncation-units))

Valid date or datetime bucketing units for either truncation or extraction operations. The front end shows the options in this order.

(def ordered-date-bucketing-units
  (into [] (distinct) (concat ordered-date-truncation-units ordered-date-extraction-units)))

Valid date or datetime bucketing units for either truncation or extraction operations.

(def date-bucketing-units
  (set ordered-date-bucketing-units))
(mr/def ::unit.date
  (into [:enum {:error/message "Valid date bucketing unit"}] date-bucketing-units))

Units that you can EXTRACT from a time or datetime. These return integers in temporal bucketing expressions. The front end shows the options in this order.

(def ordered-time-extraction-units
  [:second-of-minute
   :minute-of-hour
   :hour-of-day])

Units that you can EXTRACT from a time or datetime. These return integers in temporal bucketing expressions.

(def time-extraction-units
  (set ordered-time-extraction-units))
(mr/def ::unit.time.extract
  (into [:enum {:error/message "Valid time extraction unit"}] time-extraction-units))

Units you can TRUNCATE a time or datetime to. These return the same type as the expression being bucketed in temporal bucketing expressions. The front end shows the options in this order.

(def ordered-time-truncation-units
  [:millisecond :second :minute :hour])

Units you can TRUNCATE a time or datetime to. These return the same type as the expression being bucketed in temporal bucketing expressions.

(def time-truncation-units
  (set ordered-time-truncation-units))
(mr/def ::unit.time.truncate
  (into [:enum {:error/message "Valid time truncation unit"}] time-truncation-units))

Valid time bucketing units for either truncation or extraction operations. The front end shows the options in this order.

(def ordered-time-bucketing-units
  (into []
        (distinct)
        (concat ordered-time-truncation-units ordered-time-extraction-units)))

Valid time bucketing units for either truncation or extraction operations.

(def time-bucketing-units
  (set ordered-time-bucketing-units))
(mr/def ::unit.time
  (into [:enum {:error/message "Valid time bucketing unit"}] time-bucketing-units))

Valid datetime bucketing units for either truncation or extraction operations. The front end shows the options in this order.

(def ordered-datetime-bucketing-units
  (into []
        (distinct)
        (concat ordered-time-truncation-units ordered-date-truncation-units
                ordered-time-extraction-units ordered-date-extraction-units)))

Valid datetime bucketing units for either truncation or extraction operations.

(def datetime-bucketing-units
  (set ordered-datetime-bucketing-units))
(mr/def ::unit.date-time
  (into [:enum {:error/message "Valid datetime bucketing unit"}] ordered-datetime-bucketing-units))

This is the same as [[datetime-bucketing-units]], but also includes :default.

(def temporal-bucketing-units
  (conj datetime-bucketing-units :default))
(mr/def ::unit
  (into [:enum {:error/message "Valid temporal bucketing unit"}] temporal-bucketing-units))

Valid TRUNCATION units for a datetime.

(def datetime-truncation-units
  (set/union date-truncation-units time-truncation-units))
(mr/def ::unit.date-time.truncate
  (into [:enum {:error/message "Valid datetime truncation unit"}] datetime-truncation-units))

Valid EXTRACTION units for a datetime. Extraction units return integers!

(def datetime-extraction-units
  (set/union date-extraction-units time-extraction-units))
(mr/def ::unit.date-time.extract
  (into [:enum {:error/message "Valid datetime extraction unit"}] datetime-extraction-units))

Date units that are valid in intervals or clauses like :datetime-add. This is a superset of [[date-truncation-units]].

(def date-interval-units
  ;; it's the same but also includes `:year`, not normally allowed as a date truncation unit; `:year` is interpreted
  ;; as extraction instead.
  (conj date-truncation-units :year))
(mr/def ::unit.date.interval
  (into [:enum {:error/message "Valid date interval unit"}] date-interval-units))

Time units that are valid in intervals or clauses like :datetime-add. Currently the same as [[time-truncation-units]].

(def time-interval-units
  time-truncation-units)
(mr/def ::unit.time.interval
  (into [:enum {:error/message "Valid time interval unit"}] time-interval-units))

Units valid in intervals or clauses like :datetime-add for datetimes.

(def datetime-interval-units
  (set/union date-interval-units time-interval-units))
(mr/def ::unit.date-time.interval
  (into [:enum {:error/message "Valid datetime interval unit"}] datetime-interval-units))
(mr/def ::option
  [:map
   [:lib/type [:= :option/temporal-bucketing]]
   [:unit ::unit]
   [:default {:optional true} :boolean]])
 
(ns metabase.lib.schema.util
  (:refer-clojure :exclude [ref])
  (:require
   [metabase.lib.options :as lib.options]))
(declare collect-uuids)
(defn- collect-uuids-in-map [m]
  (into (if-let [our-uuid (or (:lib/uuid (lib.options/options m))
                              (:lib/uuid m))]
          [our-uuid]
          [])
        (comp (remove (fn [[k _v]]
                        (#{:lib/metadata :lib/stage-metadata :lib/options} k)))
              (mapcat (fn [[_k v]]
                        (collect-uuids v))))
        m))
(defn- collect-uuids-in-sequence [xs]
  (into [] (mapcat collect-uuids) xs))

Return all the :lib/uuids in a part of an MBQL query (a clause or map) as a sequence. This will be used to ensure there are no duplicates.

(defn collect-uuids
  [x]
  (cond
    (map? x)        (collect-uuids-in-map x)
    (sequential? x) (collect-uuids-in-sequence x)
    :else           nil))
(defn- find-duplicate-uuid [x]
  (transduce
   identity
   (fn
     ([]
      #{})
     ([result]
      (when (string? result)
        result))
     ([seen a-uuid]
      (if (contains? seen a-uuid)
        (reduced a-uuid)
        (conj seen a-uuid))))
   (collect-uuids x)))

True if all the :lib/uuids in something are unique.

(defn unique-uuids?
  [x]
  (not (find-duplicate-uuid x)))

Malli schema for to ensure that all :lib/uuids are unique.

(def UniqueUUIDs
  [:fn
   {:error/message "all :lib/uuids must be unique"
    :error/fn      (fn [{:keys [value]} _]
                     (str "Duplicate :lib/uuid " (pr-str (find-duplicate-uuid value))))}
   #'unique-uuids?])

Remove all the namespaced keys from a map.

(defn remove-namespaced-keys
  [m]
  (into {} (remove (fn [[k _v]] (qualified-keyword? k))) m))

Is a sequence of refs distinct for the purposes of appearing in :fields or :breakouts (ignoring keys that aren't important such as namespaced keys and type info)?

(defn distinct-refs?
  [refs]
  (or
   (< (count refs) 2)
   (apply
    distinct?
    (for [ref refs]
      (lib.options/update-options ref (fn [options]
                                        (-> options
                                            remove-namespaced-keys
                                            (dissoc :base-type :effective-type))))))))
 

A Segment is a saved MBQL query stage snippet with :filter. Segments are always boolean expressions.

(ns metabase.lib.segment
  (:require
   [metabase.lib.filter :as lib.filter]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.lib.options :as lib.options]
   [metabase.lib.ref :as lib.ref]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.util :as lib.util]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util.malli :as mu]))
(defn- resolve-segment [query segment-id]
  (when (integer? segment-id)
    (lib.metadata/segment query segment-id)))
(defmethod lib.ref/ref-method :metadata/segment
  [{:keys [id]}]
  (lib.options/ensure-uuid [:segment {} id]))
(defmethod lib.metadata.calculation/type-of-method :metadata/segment
  [_query _stage-number _metric-metadata]
  :type/Boolean)
(defmethod lib.metadata.calculation/type-of-method :segment
  [_query _stage-number _segment-clause]
  :type/Boolean)
(defn- fallback-display-name []
  (i18n/tru "[Unknown Segment]"))
(defmethod lib.metadata.calculation/display-name-method :metadata/segment
  [_query _stage-number segment-metadata _style]
  (or (:display-name segment-metadata)
      (:name segment-metadata)
      (fallback-display-name)))
(defmethod lib.metadata.calculation/display-name-method :segment
  [query stage-number [_tag _opts segment-id-or-name] style]
  (or (when (integer? segment-id-or-name)
        (when-let [segment-metadata (lib.metadata/segment query segment-id-or-name)]
          (lib.metadata.calculation/display-name query stage-number segment-metadata style)))
      (fallback-display-name)))
(defmethod lib.metadata.calculation/display-info-method :metadata/segment
  [query stage-number {:keys [description filter-positions], :as segment-metadata}]
  (let [default-display-info-method (get-method lib.metadata.calculation/display-info-method :default)
        default-display-info        (default-display-info-method query stage-number segment-metadata)]
    (cond-> default-display-info
      description (assoc :description description)
      filter-positions (assoc :filter-positions filter-positions))))
(defmethod lib.metadata.calculation/display-info-method :segment
  [query stage-number [_tag _opts segment-id-or-name]]
  (if-let [segment-metadata (resolve-segment query segment-id-or-name)]
    (lib.metadata.calculation/display-info query stage-number segment-metadata)
    {:effective-type    :type/Boolean
     :display-name      (fallback-display-name)
     :long-display-name (fallback-display-name)}))
(mu/defn available-segments :- [:maybe [:sequential {:min 1} lib.metadata/SegmentMetadata]]
  "Get a list of Segments that you may consider using as filter for a query. Only Segments that have the same
  `table-id` as the `source-table` for this query will be suggested."
  ([query]
   (available-segments query -1))
  ([query :- ::lib.schema/query
    stage-number :- :int]
   (when (zero? (lib.util/canonical-stage-index query stage-number))
     (when-let [source-table-id (lib.util/source-table-id query)]
       (let [segments (lib.metadata.protocols/segments (lib.metadata/->metadata-provider query) source-table-id)
             segment-filters (into {}
                                   (keep-indexed (fn [index filter-clause]
                                                   (when (lib.util/clause-of-type? filter-clause :segment)
                                                     [(get filter-clause 2) index])))
                                   (lib.filter/filters query 0))]
         (cond
           (empty? segments)        nil
           (empty? segment-filters) (vec segments)
           :else                    (mapv (fn [segment-metadata]
                                            (let [filter-pos (-> segment-metadata :id segment-filters)]
                                              (cond-> segment-metadata
                                                ;; even though at most one filter can reference a given segment
                                                ;; we use plural in order to keep the interface used with
                                                ;; plain filters referencing columns
                                                filter-pos (assoc :filter-positions [filter-pos]))))
                                          segments)))))))
 

Method implementations for a stage of a query.

(ns metabase.lib.stage
  (:require
   [clojure.string :as str]
   [medley.core :as m]
   [metabase.lib.aggregation :as lib.aggregation]
   [metabase.lib.binning :as lib.binning]
   [metabase.lib.breakout :as lib.breakout]
   [metabase.lib.expression :as lib.expression]
   [metabase.lib.field :as lib.field]
   [metabase.lib.hierarchy :as lib.hierarchy]
   [metabase.lib.join :as lib.join]
   [metabase.lib.join.util :as lib.join.util]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.normalize :as lib.normalize]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.lib.temporal-bucket :as lib.temporal-bucket]
   [metabase.lib.util :as lib.util]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util :as u]
   [metabase.util.malli :as mu]))
(lib.hierarchy/derive :mbql.stage/mbql   ::stage)
(lib.hierarchy/derive :mbql.stage/native ::stage)
(defmethod lib.normalize/normalize :mbql.stage/mbql
  [stage]
  (lib.normalize/normalize-map
   stage
   keyword
   {:aggregation (partial mapv lib.normalize/normalize)
    :filters     (partial mapv lib.normalize/normalize)}))
(defmethod lib.metadata.calculation/metadata-method ::stage
  [_query _stage-number _stage]
  ;; not i18n'ed because this shouldn't be developer-facing.
  (throw (ex-info "You can't calculate a metadata map for a stage! Use lib.metadata.calculation/returned-columns-method instead."
                  {})))
(mu/defn ensure-previous-stages-have-metadata :- ::lib.schema/query
  "Recursively calculate the metadata for the previous stages and add it to them, we'll need it for metadata
  calculations for [[lib.metadata.calculation/returned-columns]] and [[lib.metadata.calculation/visible-columns]], and
  we don't want to have to calculate it more than once..."
  [query        :- ::lib.schema/query
   stage-number :- :int]
  (reduce
   (fn [query stage-number]
     (lib.util/update-query-stage query
                                  stage-number
                                  assoc ::cached-metadata
                                  (lib.metadata.calculation/returned-columns query
                                                                             stage-number
                                                                             (lib.util/query-stage query stage-number))))
   query
   (range 0 (lib.util/canonical-stage-index query stage-number))))
(mu/defn ^:private existing-stage-metadata :- [:maybe lib.metadata.calculation/ColumnsWithUniqueAliases]
  "Return existing stage metadata attached to a stage if is already present: return it as-is, but only if this is a
  native stage or a source-Card stage. if it's any other sort of stage then ignore the metadata, it's probably wrong;
  we can recalculate the correct metadata anyway."
  [query        :- ::lib.schema/query
   stage-number :- :int]
  (let [{stage-type :lib/type, :keys [source-card] :as stage} (lib.util/query-stage query stage-number)]
    (or (::cached-metadata stage)
        (when-let [metadata (:lib/stage-metadata stage)]
          (when (or (= stage-type :mbql.stage/native)
                    source-card)
            (let [source-type (case stage-type
                                :mbql.stage/native :source/native
                                :mbql.stage/mbql   :source/card)]
              (not-empty
               (for [col (:columns metadata)]
                 (merge
                  {:lib/source-column-alias  (:name col)
                   :lib/desired-column-alias (:name col)}
                  col
                  {:lib/source source-type})))))))))
(mu/defn ^:private breakouts-columns :- [:maybe lib.metadata.calculation/ColumnsWithUniqueAliases]
  [query          :- ::lib.schema/query
   stage-number   :- :int
   unique-name-fn :- fn?]
  (not-empty
   (for [breakout (lib.breakout/breakouts-metadata query stage-number)]
     (assoc breakout
            :lib/source               :source/breakouts
            :lib/source-column-alias  ((some-fn :lib/source-column-alias :name) breakout)
            :lib/desired-column-alias (unique-name-fn (lib.join.util/desired-alias query breakout))))))
(mu/defn ^:private aggregations-columns :- [:maybe lib.metadata.calculation/ColumnsWithUniqueAliases]
  [query          :- ::lib.schema/query
   stage-number   :- :int
   unique-name-fn :- fn?]
  (not-empty
   (for [ag (lib.aggregation/aggregations-metadata query stage-number)]
     (assoc ag
            :lib/source               :source/aggregations
            :lib/source-column-alias  (:name ag)
            :lib/desired-column-alias (unique-name-fn (:name ag))))))

TODO -- maybe the bulk of this logic should be moved into [[metabase.lib.field]], like we did for breakouts and aggregations above.

(mu/defn ^:private fields-columns :- [:maybe lib.metadata.calculation/ColumnsWithUniqueAliases]
  [query          :- ::lib.schema/query
   stage-number   :- :int
   unique-name-fn :- fn?]
  (when-let [{fields :fields} (lib.util/query-stage query stage-number)]
    (not-empty
     (for [[tag :as ref-clause] fields
           :let                 [source (case tag
                                          ;; you can't have an `:aggregation` reference in `:fields`; anything in
                                          ;; `:aggregations` is returned automatically anyway
                                          ;; by [[aggregations-columns]] above.
                                          :field      :source/fields
                                          :expression :source/expressions)
                                 metadata (lib.metadata.calculation/metadata query stage-number ref-clause)]]
       (assoc metadata
              :lib/source               source
              :lib/source-column-alias  (lib.metadata.calculation/column-name query stage-number metadata)
              :lib/desired-column-alias (unique-name-fn (lib.join.util/desired-alias query metadata)))))))
(mu/defn ^:private summary-columns :- [:maybe lib.metadata.calculation/ColumnsWithUniqueAliases]
  [query          :- ::lib.schema/query
   stage-number   :- :int
   unique-name-fn :- fn?]
  (not-empty
   (into []
         (mapcat (fn [f]
                   (f query stage-number unique-name-fn)))
         [breakouts-columns
          aggregations-columns])))
(mu/defn ^:private previous-stage-metadata :- [:maybe lib.metadata.calculation/ColumnsWithUniqueAliases]
  "Metadata for the previous stage, if there is one."
  [query          :- ::lib.schema/query
   stage-number   :- :int
   unique-name-fn :- fn?]
  (when-let [previous-stage-number (lib.util/previous-stage-number query stage-number)]
    (not-empty
     (for [col  (lib.metadata.calculation/returned-columns query
                                                           previous-stage-number
                                                           (lib.util/query-stage query previous-stage-number))
           :let [source-alias (or ((some-fn :lib/desired-column-alias :lib/source-column-alias) col)
                                  (lib.metadata.calculation/column-name query stage-number col))]]
       (-> (merge
            col
            {:lib/source               :source/previous-stage
             :lib/source-column-alias  source-alias
             :lib/desired-column-alias (unique-name-fn source-alias)}
            (when (:metabase.lib.card/force-broken-id-refs col)
              (select-keys col [:metabase.lib.card/force-broken-id-refs])))
           ;; do not retain `:temporal-unit`; it's not like we're doing a extract(month from <x>) twice, in both
           ;; stages of a query. It's a little hacky that we're manipulating `::lib.field` keys directly here since
           ;; they're presumably supposed to be private-ish, but I don't have a more elegant way of solving this sort
           ;; of problem at this point in time.
           ;;
           ;; also don't retain `:lib/expression-name`, the fact that this column came from an expression in the
           ;; previous stage should be totally irrelevant and we don't want it confusing our code that decides whether
           ;; to generate `:expression` or `:field` refs.
           (dissoc ::lib.field/temporal-unit :lib/expression-name))))))
(mu/defn ^:private saved-question-metadata :- [:maybe lib.metadata.calculation/ColumnsWithUniqueAliases]
  "Metadata associated with a Saved Question, e.g. if we have a `:source-card`"
  [query          :- ::lib.schema/query
   stage-number   :- :int
   card-id        :- [:maybe ::lib.schema.id/card]
   options        :- lib.metadata.calculation/VisibleColumnsOptions]
  (when card-id
    (when-let [card (lib.metadata/card query card-id)]
      (not-empty (lib.metadata.calculation/visible-columns query stage-number card options)))))
(mu/defn ^:private expressions-metadata :- [:maybe lib.metadata.calculation/ColumnsWithUniqueAliases]
  [query           :- ::lib.schema/query
   stage-number    :- :int
   unique-name-fn  :- fn?]
  (not-empty
   (for [expression (lib.expression/expressions-metadata query stage-number)]
     (let [base-type (:base-type expression)]
       (-> (assoc expression
                  :lib/source               :source/expressions
                  :lib/source-column-alias  (:name expression)
                  :lib/desired-column-alias (unique-name-fn (:name expression)))
           (u/assoc-default :effective-type (or base-type :type/*)))))))

Calculate the columns to return if :aggregations/:breakout/:fields are unspecified.

Formula for the so-called 'default' columns is

1a. Columns returned by the previous stage of the query (if there is one), OR

1b. Default 'visible' Fields for our :source-table, OR

1c. Metadata associated with a Saved Question, if we have :source-card (:source-table is a card__<id> string in legacy MBQL), OR

1d. :lib/stage-metadata if this is a :mbql.stage/native stage

PLUS

  1. Expressions (aka calculated columns) added in this stage

PLUS

  1. Columns added by joins at this stage
(mu/defn ^:private previous-stage-or-source-visible-columns :- lib.metadata.calculation/ColumnsWithUniqueAliases
  "Return columns from the previous query stage or source Table/Card."
  [query                                 :- ::lib.schema/query
   stage-number                          :- :int
   {:keys [unique-name-fn], :as options} :- lib.metadata.calculation/VisibleColumnsOptions]
  {:pre [(fn? unique-name-fn)]}
  (mapv
   #(dissoc % ::lib.join/join-alias ::lib.field/temporal-unit ::lib.field/binning :fk-field-id)
   (or
    ;; 1a. columns returned by previous stage
    (previous-stage-metadata query stage-number unique-name-fn)
    ;; 1b or 1c
    (let [{:keys [source-table source-card], :as this-stage} (lib.util/query-stage query stage-number)]
      (or
       ;; 1b: default visible Fields for the source Table
       (when source-table
         (assert (integer? source-table))
         (let [table-metadata (lib.metadata/table query source-table)]
           (lib.metadata.calculation/visible-columns query stage-number table-metadata options)))
       ;; 1c. Metadata associated with a saved Question
       (when source-card
         (saved-question-metadata query stage-number source-card (assoc options :include-implicitly-joinable? false)))
       ;; 1d: `:lib/stage-metadata` for the (presumably native) query
       (for [col (:columns (:lib/stage-metadata this-stage))]
         (assoc col
                :lib/source :source/native
                :lib/source-column-alias  (:name col)
                ;; these should already be unique, but run them thru `unique-name-fn` anyway to make sure anything
                ;; that gets added later gets deduplicated from these.
                :lib/desired-column-alias (unique-name-fn (:name col)))))))))
(mu/defn ^:private existing-visible-columns :- lib.metadata.calculation/ColumnsWithUniqueAliases
  [query        :- ::lib.schema/query
   stage-number :- :int
   {:keys [unique-name-fn include-joined? include-expressions?], :as options} :- lib.metadata.calculation/VisibleColumnsOptions]
  (concat
   ;; 1: columns from the previous stage, source table or query
   (previous-stage-or-source-visible-columns query stage-number options)
   ;; 2: expressions (aka calculated columns) added in this stage
   (when include-expressions?
     (expressions-metadata query stage-number unique-name-fn))
   ;; 3: columns added by joins at this stage
   (when include-joined?
     (lib.join/all-joins-visible-columns query stage-number unique-name-fn))))
(defn- ref-to? [[tag _opts pointer :as clause] column]
  (case tag
    :field (if (or (number? pointer) (string? pointer))
             (= pointer (:id column))
             (throw (ex-info "unknown type of :field ref in lib.stage/ref-to?"
                             {:clause clause
                              :column column})))
    :expression (= pointer (:name column))
    (throw (ex-info "unknown clause in lib.stage/ref-to?"
                    {:clause clause
                     :column column}))))
(defn- mark-selected-breakouts [query stage-number columns]
  (if-let [breakouts (:breakout (lib.util/query-stage query stage-number))]
    (for [column columns]
      (if-let [match (m/find-first #(ref-to? % column) breakouts)]
        (let [binning        (lib.binning/binning match)
              {:keys [unit]} (lib.temporal-bucket/temporal-bucket match)]
          (cond-> column
            binning (lib.binning/with-binning binning)
            unit    (lib.temporal-bucket/with-temporal-bucket unit)))
        column))
    columns))
(defmethod lib.metadata.calculation/visible-columns-method ::stage
  [query stage-number _stage {:keys [unique-name-fn include-implicitly-joinable?], :as options}]
  (let [query            (ensure-previous-stages-have-metadata query stage-number)
        existing-columns (existing-visible-columns query stage-number options)]
    (->> (concat
           existing-columns
           ;; add implicitly joinable columns if desired
           (when (and include-implicitly-joinable?
                      (or (not (:source-card (lib.util/query-stage query stage-number)))
                          (:include-implicitly-joinable-for-source-card? options)))
             (lib.metadata.calculation/implicitly-joinable-columns query stage-number existing-columns unique-name-fn)))
         (mark-selected-breakouts query stage-number))))

Return results metadata about the expected columns in an MBQL query stage. If the query has aggregations/breakouts, then return those and the fields columns. Otherwise if there are fields columns return those and the joined columns. Otherwise return the defaults based on the source Table or previous stage + joins.

(defmethod lib.metadata.calculation/returned-columns-method ::stage
  [query stage-number _stage {:keys [unique-name-fn], :as options}]
  (or
   (existing-stage-metadata query stage-number)
   (let [query        (ensure-previous-stages-have-metadata query stage-number)
         summary-cols (summary-columns query stage-number unique-name-fn)
         field-cols   (fields-columns query stage-number unique-name-fn)]
     ;; ... then calculate metadata for this stage
     (cond
       summary-cols
       (into summary-cols field-cols)

       field-cols
       (do (doall field-cols)           ; force generation of unique names before join columns
           (into []
                 (m/distinct-by #(dissoc % :source-alias :lib/source :lib/source-uuid :lib/desired-column-alias))
                 (concat field-cols
                         (lib.join/all-joins-expected-columns query stage-number options))))

       :else
       ;; there is no `:fields` or summary columns (aggregtions or breakouts) which means we return all the visible
       ;; columns from the source or previous stage plus all the expressions. We return only the `:fields` from any
       ;; joins
       (concat
        ;; we don't want to include all visible joined columns, so calculate that separately
        (previous-stage-or-source-visible-columns query stage-number {:include-implicitly-joinable? false
                                                                      :unique-name-fn               unique-name-fn})
        (expressions-metadata query stage-number unique-name-fn)
        (lib.join/all-joins-expected-columns query stage-number options))))))
(defmethod lib.metadata.calculation/display-name-method :mbql.stage/native
  [_query _stage-number _stage _style]
  (i18n/tru "Native query"))
(def ^:private display-name-source-parts
  [:source-table
   :source-card
   :joins])
(def ^:private display-name-other-parts
  [:aggregation
   :breakout
   :filters
   :order-by
   :limit])
(defmethod lib.metadata.calculation/display-name-method :mbql.stage/mbql
  [query stage-number _stage style]
  (let [query (ensure-previous-stages-have-metadata query stage-number)]
    (or
     (not-empty
      (let [part->description  (into {}
                                     (comp cat
                                           (map (fn [k]
                                                  [k (lib.metadata.calculation/describe-top-level-key query stage-number k)])))
                                     [display-name-source-parts display-name-other-parts])
            source-description (str/join " + " (remove str/blank? (map part->description display-name-source-parts)))
            other-descriptions (map part->description display-name-other-parts)]
        (str/join ", " (remove str/blank? (cons source-description other-descriptions)))))
     (when-let [previous-stage-number (lib.util/previous-stage-number query stage-number)]
       (lib.metadata.calculation/display-name query
                                              previous-stage-number
                                              (lib.util/query-stage query previous-stage-number)
                                              style)))))
(mu/defn append-stage :- ::lib.schema/query
  "Adds a new blank stage to the end of the pipeline"
  [query]
  (update query :stages conj {:lib/type :mbql.stage/mbql}))
(mu/defn drop-stage :- ::lib.schema/query
  "Drops the final stage in the pipeline, will no-op if it is the only stage"
  [query]
  (if (= 1 (count (:stages query)))
    query
    (update query :stages pop)))
(mu/defn drop-stage-if-empty :- ::lib.schema/query
  "Drops the final stage in the pipeline IF the stage is empty of clauses, otherwise no-op"
  [query :- ::lib.schema/query]
  (if (empty? (dissoc (lib.util/query-stage query -1) :lib/type))
    (drop-stage query)
    query))
 
(ns metabase.lib.table
  (:require
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.util :as lib.util]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util :as u]
   [metabase.util.humanization :as u.humanization]))
(defmethod lib.metadata.calculation/display-name-method :metadata/table
  [_query _stage-number table-metadata _style]
  (or (:display-name table-metadata)
      (some->> (:name table-metadata)
               (u.humanization/name->human-readable-name :simple))))
(defmethod lib.metadata.calculation/metadata-method :metadata/table
  [_query _stage-number table-metadata]
  table-metadata)
(defmethod lib.metadata.calculation/describe-top-level-key-method :source-table
  [query stage-number _k]
  (let [{:keys [source-table]} (lib.util/query-stage query stage-number)]
    (when source-table
      (assert (integer? source-table)
              (i18n/tru "Unexpected source table ID {0}" (pr-str source-table)))
      (or (when-let [table-metadata (lib.metadata/table query source-table)]
            (lib.metadata.calculation/display-name query stage-number table-metadata :long))
          (i18n/tru "Table {0}" (pr-str source-table))))))

Remove Fields that shouldn't be visible from the default Fields for a source Table. See [[metabase.query-processor.middleware.add-implicit-clauses/table->sorted-fields*]].

(defn- remove-hidden-default-fields
  [field-metadatas]
  (remove (fn [{:keys [visibility-type], active? :active, :as _field-metadata}]
            (or (false? active?)
                (#{:sensitive :retired} (some-> visibility-type keyword))))
          field-metadatas))

Sort default Fields for a source Table. See [[metabase.models.table/field-order-rule]].

(defn- sort-default-fields
  [field-metadatas]
  (sort-by (fn [{field-name :name, :keys [position], :as _field-metadata}]
             [(or position 0) (u/lower-case-en (or field-name ""))])
           field-metadatas))
(defmethod lib.metadata.calculation/returned-columns-method :metadata/table
  [query _stage-number table-metadata {:keys [unique-name-fn], :as _options}]
  (when-let [field-metadatas (lib.metadata/fields query (:id table-metadata))]
    (->> field-metadatas
         remove-hidden-default-fields
         sort-default-fields
         (map (fn [col]
                (assoc col
                       :lib/source               :source/table-defaults
                       :lib/source-column-alias  (:name col)
                       :lib/desired-column-alias (unique-name-fn (or (:name col) ""))))))))
 
(ns metabase.lib.temporal-bucket
  (:require
   [clojure.string :as str]
   [metabase.lib.dispatch :as lib.dispatch]
   [metabase.lib.hierarchy :as lib.hierarchy]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.temporal-bucketing
    :as lib.schema.temporal-bucketing]
   [metabase.shared.util.i18n :as i18n]
   [metabase.shared.util.time :as shared.ut]
   [metabase.util :as u]
   [metabase.util.malli :as mu]))
(mu/defn describe-temporal-unit :- :string
  "Get a translated description of a temporal bucketing unit."
  ([]
   (describe-temporal-unit 1 nil))
  ([unit]
   (describe-temporal-unit 1 unit))
  ([n    :- :int
    unit :- [:maybe :keyword]]
   (if-not unit
     (let [n (abs n)]
       (case (keyword unit)
         :default         (i18n/trun "Default period"  "Default periods"  n)
         :millisecond     (i18n/trun "Millisecond"     "Milliseconds"     n)
         :second          (i18n/trun "Second"          "Seconds"          n)
         :minute          (i18n/trun "Minute"          "Minutes"          n)
         :hour            (i18n/trun "Hour"            "Hours"            n)
         :day             (i18n/trun "Day"             "Days"             n)
         :week            (i18n/trun "Week"            "Weeks"            n)
         :month           (i18n/trun "Month"           "Months"           n)
         :quarter         (i18n/trun "Quarter"         "Quarters"         n)
         :year            (i18n/trun "Year"            "Years"            n)
         :minute-of-hour  (i18n/trun "Minute of hour"  "Minutes of hour"  n)
         :hour-of-day     (i18n/trun "Hour of day"     "Hours of day"     n)
         :day-of-week     (i18n/trun "Day of week"     "Days of week"     n)
         :day-of-month    (i18n/trun "Day of month"    "Days of month"    n)
         :day-of-year     (i18n/trun "Day of year"     "Days of year"     n)
         :week-of-year    (i18n/trun "Week of year"    "Weeks of year"    n)
         :month-of-year   (i18n/trun "Month of year"   "Months of year"   n)
         :quarter-of-year (i18n/trun "Quarter of year" "Quarters of year" n)
         ;; e.g. :unknown-unit => "Unknown unit"
         (let [[unit & more] (str/split (name unit) #"-")]
           (str/join \space (cons (str/capitalize unit) more))))))))
(def ^:private TemporalIntervalAmount
  [:or [:enum :current :last :next] :int])
(defn- interval-n->int [n]
  (if (number? n)
    n
    (case n
      :current 0
      :next    1
      :last    -1
      0)))
(mu/defn describe-temporal-interval :- ::lib.schema.common/non-blank-string
  "Get a translated description of a temporal bucketing interval. If unit is unspecified, assume `:day`."
  [n    :- TemporalIntervalAmount
   unit :- [:maybe :keyword]]
  (let [n    (interval-n->int n)
        unit (or unit :day)]
    (cond
      (zero? n) (if (= unit :day)
                  (i18n/tru "Today")
                  (i18n/tru "This {0}" (describe-temporal-unit unit)))
      (= n 1)   (if (= unit :day)
                  (i18n/tru "Tomorrow")
                  (i18n/tru "Next {0}" (describe-temporal-unit unit)))
      (= n -1)  (if (= unit :day)
                  (i18n/tru "Yesterday")
                  (i18n/tru "Previous {0}" (describe-temporal-unit unit)))
      (neg? n)  (i18n/tru "Previous {0} {1}" (abs n) (describe-temporal-unit (abs n) unit))
      (pos? n)  (i18n/tru "Next {0} {1}" n (describe-temporal-unit n unit)))))
(mu/defn describe-relative-datetime :- ::lib.schema.common/non-blank-string
  "Get a translated description of a relative datetime interval, ported from
 `frontend/src/metabase-lib/queries/utils/query-time.js`.
  e.g. if the relative interval is `-1 days`, then `n` = `-1` and `unit` = `:day`.
  If `:unit` is unspecified, assume `:day`."
  [n    :- TemporalIntervalAmount
   unit :- [:maybe :keyword]]
  (let [n    (interval-n->int n)
        unit (or unit :day)]
    (cond
      (zero? n)
      (i18n/tru "Now")
      (neg? n)
      ;; this should legitimately be lowercasing in the user locale. I know system locale isn't necessarily the same
      ;; thing, but it might be. This will have to do until we have some sort of user-locale lower-case functionality
      #_ {:clj-kondo/ignore [:discouraged-var]}
      (i18n/tru "{0} {1} ago" (abs n) (str/lower-case (describe-temporal-unit (abs n) unit)))
      :else
      #_ {:clj-kondo/ignore [:discouraged-var]}
      (i18n/tru "{0} {1} from now" n (str/lower-case (describe-temporal-unit n unit))))))

Implementation for [[temporal-bucket]]. Implement this to tell [[temporal-bucket]] how to add a bucket to a particular MBQL clause.

(defmulti with-temporal-bucket-method
  {:arglists '([x unit])}
  (fn [x _unit]
    (lib.dispatch/dispatch-value x))
  :hierarchy lib.hierarchy/hierarchy)

Add a temporal bucketing unit, e.g. :day or :day-of-year, to an MBQL clause or something that can be converted to an MBQL clause. E.g. for a Field or Field metadata or :field clause, this might do something like this:

(temporal some-field :day)

=>

[:field 1 {:temporal-unit :day}]

Pass a nil unit to remove the temporal bucket.

(mu/defn with-temporal-bucket
  [x option-or-unit :- [:maybe [:or
                                ::lib.schema.temporal-bucketing/option
                                ::lib.schema.temporal-bucketing/unit]]]
  (with-temporal-bucket-method x (cond-> option-or-unit
                                   (not (keyword? option-or-unit)) :unit)))

Implementation of [[temporal-bucket]]. Return the current temporal bucketing unit associated with x.

(defmulti temporal-bucket-method
  {:arglists '([x])}
  lib.dispatch/dispatch-value
  :hierarchy lib.hierarchy/hierarchy)
(defmethod temporal-bucket-method :default
  [_x]
  nil)
(mu/defmethod temporal-bucket-method :option/temporal-bucketing :- ::lib.schema.temporal-bucketing/unit
  [option]
  (:unit option))
(mu/defn raw-temporal-bucket :- [:maybe ::lib.schema.temporal-bucketing/unit]
  "Get the raw temporal bucketing `unit` associated with something e.g. a `:field` ref or a ColumnMetadata."
  [x]
  (temporal-bucket-method x))
(mu/defn temporal-bucket :- [:maybe ::lib.schema.temporal-bucketing/option]
  "Get the current temporal bucketing option associated with something, if any."
  [x]
  (when-let [unit (raw-temporal-bucket x)]
    {:lib/type :option/temporal-bucketing
     :unit     unit}))

Options that are technically legal in MBQL, but that should be hidden in the UI.

(def ^:private hidden-bucketing-options
  #{:millisecond
    :second
    :second-of-minute
    :year-of-era})

The temporal bucketing options for time type expressions.

(def time-bucket-options
  (into []
        (comp (remove hidden-bucketing-options)
              (map (fn [unit]
                     (cond-> {:lib/type :option/temporal-bucketing
                              :unit unit}
                       (= unit :hour) (assoc :default true)))))
        lib.schema.temporal-bucketing/ordered-time-bucketing-units))

The temporal bucketing options for date type expressions.

(def date-bucket-options
  (mapv (fn [unit]
          (cond-> {:lib/type :option/temporal-bucketing
                   :unit unit}
            (= unit :day) (assoc :default true)))
        lib.schema.temporal-bucketing/ordered-date-bucketing-units))

The temporal bucketing options for datetime type expressions.

(def datetime-bucket-options
  (into []
        (comp (remove hidden-bucketing-options)
              (map (fn [unit]
                     (cond-> {:lib/type :option/temporal-bucketing
                              :unit unit}
                       (= unit :day) (assoc :default true)))))
        lib.schema.temporal-bucketing/ordered-datetime-bucketing-units))
(defmethod lib.metadata.calculation/display-name-method :option/temporal-bucketing
  [_query _stage-number {:keys [unit]} _style]
  (describe-temporal-unit unit))
(defmethod lib.metadata.calculation/display-info-method :option/temporal-bucketing
  [query stage-number option]
  (merge {:display-name (lib.metadata.calculation/display-name query stage-number option)
          :short-name (u/qualified-name (raw-temporal-bucket option))}
         (select-keys option [:default :selected])))

Implementation for [[available-temporal-buckets]]. Return a set of units from :metabase.lib.schema.temporal-bucketing/unit that are allowed to be used with x.

(defmulti available-temporal-buckets-method
  {:arglists '([query stage-number x])}
  (fn [_query _stage-number x]
    (lib.dispatch/dispatch-value x))
  :hierarchy lib.hierarchy/hierarchy)
(defmethod available-temporal-buckets-method :default
  [_query _stage-number _x]
  #{})
(mu/defn available-temporal-buckets :- [:sequential [:ref ::lib.schema.temporal-bucketing/option]]
  "Get a set of available temporal bucketing units for `x`. Returns nil if no units are available."
  ([query x]
   (available-temporal-buckets query -1 x))
  ([query        :- ::lib.schema/query
    stage-number :- :int
    x]
   (available-temporal-buckets-method query stage-number x)))
(mu/defn describe-temporal-pair :- :string
  "Return a string describing the temporal pair.
   Used when comparing temporal values like `[:!= ... [:field {:temporal-unit :day-of-week} ...] \"2022-01-01\"]`"
  [temporal-column
   temporal-value :- [:or :int :string]]
  (shared.ut/format-unit temporal-value (:unit (temporal-bucket temporal-column))))
 

Ported from frontend/src/metabase-lib/types/utils/isa.js

(ns metabase.lib.types.isa
  (:refer-clojure :exclude [isa? any? boolean? number? string? integer?])
  (:require
   [medley.core :as m]
   [metabase.lib.types.constants :as lib.types.constants]
   [metabase.lib.util :as lib.util]
   [metabase.types]))
(comment metabase.types/keep-me)

Decide if _column is a subtype of the type denoted by the keyword type-kw. Both effective and semantic types are taken into account.

(defn ^:export isa?
  [{:keys [effective-type base-type semantic-type] :as _column} type-kw]
  (or (clojure.core/isa? (or effective-type base-type) type-kw)
      (clojure.core/isa? semantic-type type-kw)))

Returns if column is of category category. The possible categories are the keys in [[metabase.lib.types.constants/type-hierarchies]].

(defn ^:export field-type?
  [category column]
  (let [type-definition (lib.types.constants/type-hierarchies category)
        column          (cond-> column
                          (and (map? column)
                               (not (:effective-type column)))
                          (assoc :effective-type (:base-type column)))]
    (cond
      (nil? column) false
      ;; check field types
      (some (fn [[type-type types]]
              (and (#{:effective-type :semantic-type} type-type)
                   (some #(clojure.core/isa? (type-type column) %) types)))
            type-definition)
      true
      ;; recursively check if it's not an excluded type
      (some #(field-type? % column) (:exclude type-definition))
      false
      ;; recursively check if it's an included type
      (some #(field-type? % column) (:include type-definition))
      true
      :else false)))

Return the category column belongs to. The possible categories are the keys in [[metabase.lib.types.constants/type-hierarchies]].

(defn ^:export field-type
  [column]
  (m/find-first #(field-type? % column)
                [::lib.types.constants/temporal
                 ::lib.types.constants/location
                 ::lib.types.constants/coordinate
                 ::lib.types.constants/foreign_key
                 ::lib.types.constants/primary_key
                 ::lib.types.constants/boolean
                 ::lib.types.constants/string
                 ::lib.types.constants/string_like
                 ::lib.types.constants/number]))

Is column of a temporal type?

(defn ^:export temporal?
  [column]
  (field-type? ::lib.types.constants/temporal column))

Is column of a numeric type?

(defn ^:export numeric?
  [column]
  (field-type? ::lib.types.constants/number column))

Is column of a boolean type?

(defn ^:export boolean?
  [column]
  (field-type? ::lib.types.constants/boolean column))

Is column of a string type?

(defn ^:export string?
  [column]
  (field-type? ::lib.types.constants/string column))

Is column of a summable type?

(defn ^:export summable?
  [column]
  (field-type? ::lib.types.constants/summable column))

Is column of a scope type?

(defn ^:export scope?
  [column]
  (field-type? ::lib.types.constants/scope column))

Is column of a categorical type?

(defn ^:export category?
  [column]
  (field-type? ::lib.types.constants/category column))

Is column of a location type?

(defn ^:export location?
  [column]
  (field-type? ::lib.types.constants/location column))

Is column a description?

(defn ^:export description?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/Description))

Is column a dimension?

(defn ^:export dimension?
  [column]
  (and column
       (not= (:lib/source column) :source/aggregations)
       (not (description? column))))

Is column a metric?

(defn ^:export metric?
  [column]
  (and (not= (:lib/source column) :source/breakouts)
       (summable? column)))

Is column a foreign-key?

(defn ^:export foreign-key?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/FK))

Is column a primary-key?

(defn ^:export primary-key?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/PK))

Is column an entity name?

(defn ^:export entity-name?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/Name))

Is column a title column?

(defn ^:export title?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/Title))

Is column a serialized JSON column?

(defn ^:export json?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/SerializedJSON))

Is column a serialized XML column?

(defn ^:export xml?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/XML))

Is column serialized structured data? (eg. JSON, XML)

(defn ^:export structured?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/Structured))

Is this _column whatever (including nil)?

(defn ^:export any?
  [_column]
  true)

Is column a numneric base type?

(defn ^:export numeric-base-type?
  [column]
  (clojure.core/isa? (:effective-type column) :type/Number))

Is column a date without time?

(defn ^:export date-without-time?
  [column]
  (clojure.core/isa? (:effective-type column) :type/Date))

Is column a creation timestamp column?

(defn ^:export creation-timestamp?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/CreationTimestamp))

Is column a creation date column?

(defn ^:export creation-date?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/CreationDate))

Is column a creation time column?

(defn ^:export creation-time?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/CreationTime))

Is column a number without some other semantic type (like ZIP code)?

ZipCode, ID, etc derive from Number but should not be formatted as numbers

(defn ^:export number?
  [column]
  (and (numeric-base-type? column)
       (let [semantic-type (:semantic-type column)]
         (or (nil? semantic-type)
             ;; this is a precaution, :type/Number is not a semantic type
             (clojure.core/isa? semantic-type :type/Number)))))

Is column a integer column?

(defn ^:export integer?
  [column]
  (field-type? ::lib.types.constants/integer column))

Is column a time?

(defn ^:export time?
  [column]
  (clojure.core/isa? (:effective-type column) :type/Time))

Is column an address?

(defn ^:export address?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/Address))

Is column a city?

(defn ^:export city?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/City))

Is column a state?

(defn ^:export state?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/State))

Is column a zip-code?

(defn ^:export zip-code?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/ZipCode))

Is column a country?

(defn ^:export country?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/Country))

Is column a coordinate?

(defn ^:export coordinate?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/Coordinate))

Is column a latitude?

(defn ^:export latitude?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/Latitude))

Is column a longitude?

(defn ^:export longitude?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/Longitude))

Is column a currency?

(defn ^:export currency?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/Currency))

Is column a comment?

(defn ^:export comment?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/Comment))

Is column an ID?

(defn ^:export id?
  [column]
  (or (clojure.core/isa? (:semantic-type column) :type/FK)
      (clojure.core/isa? (:semantic-type column) :type/PK)))

Is column a URL?

(defn ^:export URL?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/URL))

Is column an email?

(defn ^:export email?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/Email))

Is column an avatar URL?

(defn ^:export avatar-URL?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/AvatarURL))

Is column an image URL?

(defn ^:export image-URL?
  [column]
  (clojure.core/isa? (:semantic-type column) :type/ImageURL))

Does the collection columns contain both a latitude and a longitude column?

(defn ^:export has-latitude-and-longitude?
  [columns]
  (every? #(some % columns) [latitude? longitude?]))

Return a prdicate for checking if a column is a primary key.

(defn ^:export primary-key-pred
  [table-id]
  (fn primary-key-pred-for-table-id [column]
    (let [pk? (primary-key? column)]
      ;; comment from isa.js:
      ;; > FIXME: columns of nested questions at this moment miss table_id value
      ;; > which makes it impossible to match them with their tables that are nested cards
      (if (lib.util/legacy-string-table-id->card-id table-id)
        pk?
        (and pk? (= (:table-id column) table-id))))))

Is this column one that we should show a search widget for (to search its values) in the QB filter UI? If so, we can give it a has-field-values value of :search.

TODO -- This stuff should probably use the constants in [[metabase.lib.types.constants]], however this logic isn't supposed to include things with semantic type = Category which the ::string constant define there includes.

(defn searchable?
  [{:keys [base-type effective-type]}]
  ;; For the time being we will consider something to be "searchable" if it's a text Field since the `starts-with`
  ;; filter that powers the search queries (see [[metabase.api.field/search-values]]) doesn't work on anything else
  (let [column-type (or effective-type base-type)]
    (or (clojure.core/isa? column-type :type/Text)
        (clojure.core/isa? column-type :type/TextLike))))
 

Helpers for getting at "underlying" or "top-level" queries and columns. This logic is shared by a handful of things like drill-thrus.

(ns metabase.lib.underlying
  (:require
   [clojure.set :as set]
   [metabase.lib.aggregation :as lib.aggregation]
   [metabase.lib.breakout :as lib.breakout]
   [metabase.lib.equality :as lib.equality]
   [metabase.lib.field :as lib.field]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.ref :as lib.ref]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.lib.util :as lib.util]
   [metabase.util.malli :as mu]))
(mu/defn ^:private pop-until-aggregation-or-breakout :- [:maybe ::lib.schema/query]
  "Strips off any trailing stages that do not contain aggregations.
  If there are no such stages, returns nil."
  [query :- ::lib.schema/query]
  (if (and (empty? (lib.aggregation/aggregations query -1))
           (empty? (lib.breakout/breakouts query -1)))
    ;; No aggregations or breakouts in the last stage, so pop it off and recur.
    (let [popped (update query :stages pop)]
      (when (seq (:stages popped))
        (recur popped)))
    query))
(mu/defn top-level-query :- ::lib.schema/query
  "Returns the \"top-level\" query for the given query.
  That means dropping any trailing filters, fields, etc. to get back to the last stage that has an aggregation. If there
  are no stages with aggregations, the original query is returned.
  If the database does not support nested queries, this also returns the original."
  [query :- ::lib.schema/query]
  (or (when ((-> query lib.metadata/database :features) :nested-queries)
        (pop-until-aggregation-or-breakout query))
      query))
(mu/defn top-level-column :- ::lib.schema.metadata/column
  "Given a column, returns the \"top-level\" equivalent.
  Top-level means to find the corresponding column in the [[top-level-query]], which requires walking back through the
  stages finding the equivalent column at each one.
  Returns nil if the column can't be traced back to the top-level query."
  [query  :- ::lib.schema/query
   column :- ::lib.schema.metadata/column]
  (let [top-query (top-level-query query)]
    (if (= query top-query)
      column ;; Unchanged if this is already a top-level query. That includes keeping the "superfluous" options!
      (loop [query  query
             column column]
        (if (= query top-query)
          ;; Once we've found it, rename superfluous options, because under normal circumstances you will not need
          ;; them. On the off chance you do need them, they'll still be available.
          (set/rename-keys column {::lib.field/temporal-unit ::temporal-unit
                                   ::lib.field/binning       ::binning})
          (let [prev-cols (lib.metadata.calculation/returned-columns query -2 (lib.util/previous-stage query -1))
                prev-col  (lib.equality/find-matching-column query -2 (lib.ref/ref column) prev-cols)]
            (when prev-col
              (recur (update query :stages pop) prev-col))))))))
 

Configures the logger system for Metabase. Sets up an in-memory logger in a ring buffer for showing in the UI. Other logging options are set in [[metabase.bootstrap]]: the context locator for log4j2 and ensuring log4j2 is the logger that clojure.tools.logging uses.

(ns metabase.logger
  (:require
   [amalloy.ring-buffer :refer [ring-buffer]]
   [clj-time.coerce :as time.coerce]
   [clj-time.format :as time.format]
   [metabase.config :as config]
   [metabase.plugins.classloader :as classloader])
  (:import
   (org.apache.commons.lang3.exception ExceptionUtils)
   (org.apache.logging.log4j LogManager)
   (org.apache.logging.log4j.core Appender LogEvent LoggerContext)
   (org.apache.logging.log4j.core.config LoggerConfig)))
(set! *warn-on-reflection* true)
(def ^:private ^:const max-log-entries 2500)
(defonce ^:private messages* (atom (ring-buffer max-log-entries)))

Get the list of currently buffered log entries, from most-recent to oldest.

(defn messages
  []
  (reverse (seq @messages*)))
(defn- event->log-data [^LogEvent event]
  {:timestamp    (time.format/unparse (time.format/formatter :date-time)
                                      (time.coerce/from-long (.getTimeMillis event)))
   :level        (.getLevel event)
   :fqns         (.getLoggerName event)
   :msg          (.getMessage event)
   :exception    (when-let [throwable (.getThrown event)]
                   (seq (ExceptionUtils/getStackFrames throwable)))
   :process_uuid config/local-process-uuid})
(defn- metabase-appender ^Appender []
  (let [^org.apache.logging.log4j.core.Filter filter                   nil
        ^org.apache.logging.log4j.core.Layout layout                   nil
        ^"[Lorg.apache.logging.log4j.core.config.Property;" properties nil]
    (proxy [org.apache.logging.log4j.core.appender.AbstractAppender]
        ["metabase-appender" filter layout false properties]
      (append [event]
        (swap! messages* conj (event->log-data event))
        nil))))
(defonce ^:private has-added-appender? (atom false))
(when-not *compile-files*
  (when-not @has-added-appender?
    (reset! has-added-appender? true)
    (let [^LoggerContext ctx (LogManager/getContext (classloader/the-classloader) false)
          config             (.getConfiguration ctx)
          appender           (metabase-appender)]
      (.start appender)
      (.addAppender config appender)
      (doseq [[_ ^LoggerConfig logger-config] (.getLoggers config)]
        (.addAppender logger-config appender (.getLevel logger-config) (.getFilter logger-config))
        (.updateLoggers ctx)))))
 

JavaScript-friendly interface to metabase.mbql util functions.

(ns metabase.mbql.js
  (:require
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.util :as u]))

Sometimes JS queries are passed in with a Join or Aggregation clause object instead of a simple Array. These clauses extend Array so Array.isArray(x) is true, but they're treated as opaque by js->clj. This recurses over the whole query, unwrapping these values to their .raw() form.

(defn- unwrap
  [x]
  (cond
    ;; (object? x) only matches for things that are plain objects. eg. `(object? (js/Date.))` is false.
    ;; This matches anything that descends from `Object`, like `Join` clause, and has a `.raw()` method.
    (and x
         (instance? js/Object x)
         (fn? (.-raw x)))        (-> x (.raw) js->clj unwrap)
    (map? x)                     (update-vals x unwrap)
    (sequential? x)              (mapv unwrap x)
    :else                        x))

Normalize an MBQL query, and convert it to the latest and greatest version of MBQL.

Returns the CLJS form of the normalized query. Use [[normalize]] for the JS form.

(defn normalize-cljs
  [query]
  (-> query js->clj unwrap mbql.normalize/normalize))

Normalize an MBQL query, and convert it to the latest and greatest version of MBQL.

Returns the JS form of the normalized query. Use [[normalize-cljs]] for the CLJS form.

(defn ^:export normalize
  [query]
  (-> query normalize-cljs (clj->js :keyword-fn u/qualified-name)))
 

Logic for taking any sort of weird MBQL query and normalizing it into a standardized, canonical form. You can think of this like taking any 'valid' MBQL query and rewriting it as-if it was written in perfect up-to-date MBQL in the latest version. There are four main things done here, done as four separate steps:

NORMALIZING TOKENS

Converting all identifiers to lower-case, lisp-case keywords. e.g. {"SOURCE_TABLE" 10} becomes `{:source-table 10}`.

CANONICALIZING THE QUERY

Rewriting deprecated MBQL 95/98 syntax and other things that are still supported for backwards-compatibility in canonical modern MBQL syntax. For example {:breakout [:count 10]} becomes {:breakout [[:count [:field 10 nil]]]}.

WHOLE-QUERY TRANSFORMATIONS

Transformations and cleanup of the query structure as a whole to fix inconsistencies. Whereas the canonicalization phase operates on a lower-level, transforming invidual clauses, this phase focuses on transformations that affect multiple clauses, such as removing duplicate references to Fields if they are specified in both the :breakout and :fields clauses.

This is not the only place that does such transformations; several pieces of QP middleware perform similar individual transformations, such as reconcile-breakout-and-order-by-bucketing.

REMOVING EMPTY CLAUSES

Removing empty clauses like {:aggregation nil} or {:breakout []}.

Token normalization occurs first, followed by canonicalization, followed by removing empty clauses.

(ns metabase.mbql.normalize
  (:require
   [clojure.set :as set]
   [clojure.walk :as walk]
   [medley.core :as m]
   [metabase.mbql.util :as mbql.u]
   [metabase.mbql.util.match :as mbql.match]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]))

True if x is an MBQL clause (a sequence with a token as its first arg). (This is different from the implementation in mbql.u because it also supports un-normalized clauses. You shouldn't need to use this outside of this namespace.)

(defn- mbql-clause?
  [x]
  (and (sequential? x)
       (not (map-entry? x))
       ((some-fn keyword? string?) (first x))))

Normalize token x, but only if it's a keyword or string.

(defn- maybe-normalize-token
  [x]
  (if ((some-fn keyword? string?) x)
    (mbql.u/normalize-token x)
    x))

If x an MBQL clause, and an instance of clauses defined by keyword(s) k-or-ks?

(is-clause? :count [:count 10]) ; -> true (is-clause? #{:+ :- :* :/} [:+ 10 20]) ; -> true

(This is different from the implementation in mbql.u because it also supports un-normalized clauses. You shouldn't need to use this outside of this namespace.)

(defn is-clause?
  [k-or-ks x]
  (and
   (mbql-clause? x)
   (let [clause-name (maybe-normalize-token (first x))]
     (if (coll? k-or-ks)
       ((set k-or-ks) clause-name)
       (= k-or-ks clause-name)))))

+----------------------------------------------------------------------------------------------------------------+ | NORMALIZE TOKENS | +----------------------------------------------------------------------------------------------------------------+

(declare normalize-tokens)
(defmulti ^:private normalize-mbql-clause-tokens
  (comp maybe-normalize-token first))
(defmethod normalize-mbql-clause-tokens :aggregation
  ;; nil options should be removed from aggregation references (`[:aggregation 0]`).
  [[_ aggregation-index option]]
  (cond-> [:aggregation aggregation-index]
    (some? option) (conj option)))
(defmethod normalize-mbql-clause-tokens :expression
  ;; For expression references (`[:expression \"my_expression\"]`) keep the arg as is but make sure it is a string.
  [[_ expression-name]]
  [:expression (if (keyword? expression-name)
                 (mbql.u/qualified-name expression-name)
                 expression-name)])
(defmethod normalize-mbql-clause-tokens :binning-strategy
  ;; For `:binning-strategy` clauses (which wrap other Field clauses) normalize the strategy-name and recursively
  ;; normalize the Field it bins.
  [[_ field strategy-name strategy-param]]
  (if strategy-param
    (conj (normalize-mbql-clause-tokens [:binning-strategy field strategy-name]) strategy-param)
    [:binning-strategy (normalize-tokens field :ignore-path) (maybe-normalize-token strategy-name)]))
(defmethod normalize-mbql-clause-tokens :field
  [[_ id-or-name opts]]
  (let [opts (normalize-tokens opts :ignore-path)]
    [:field
     id-or-name
     (cond-> opts
       (:base-type opts)     (update :base-type keyword)
       (:temporal-unit opts) (update :temporal-unit keyword)
       (:binning opts)       (update :binning (fn [binning]
                                                (cond-> binning
                                                  (:strategy binning) (update :strategy keyword)))))]))
(defmethod normalize-mbql-clause-tokens :field-literal
  ;; Similarly, for Field literals, keep the arg as-is, but make sure it is a string."
  [[_ field-name field-type]]
  [:field-literal
   (if (keyword? field-name)
     (mbql.u/qualified-name field-name)
     field-name)
   (keyword field-type)])
(defmethod normalize-mbql-clause-tokens :datetime-field
  ;; Datetime fields look like `[:datetime-field <field> <unit>]` or `[:datetime-field <field> :as <unit>]`
  ;; normalize the unit, and `:as` (if present) tokens, and the Field."
  [[_ field as-or-unit maybe-unit]]
  (if maybe-unit
    [:datetime-field (normalize-tokens field :ignore-path) :as (maybe-normalize-token maybe-unit)]
    [:datetime-field (normalize-tokens field :ignore-path) (maybe-normalize-token as-or-unit)]))
(defmethod normalize-mbql-clause-tokens :time-interval
  ;; `time-interval`'s `unit` should get normalized, and `amount` if it's not an integer."
  [[_ field amount unit options]]
  (if options
    (conj (normalize-mbql-clause-tokens [:time-interval field amount unit])
          (normalize-tokens options :ignore-path))
    [:time-interval
     (normalize-tokens field :ignore-path)
     (if (integer? amount)
       amount
       (maybe-normalize-token amount))
     (maybe-normalize-token unit)]))
(defmethod normalize-mbql-clause-tokens :relative-datetime
  ;; Normalize a `relative-datetime` clause. `relative-datetime` comes in two flavors:
  ;;
  ;;   [:relative-datetime :current]
  ;;   [:relative-datetime -10 :day] ; amount & unit"
  [[_ amount unit]]
  (if unit
    [:relative-datetime amount (maybe-normalize-token unit)]
    [:relative-datetime :current]))
(defmethod normalize-mbql-clause-tokens :interval
  [[_ amount unit]]
  [:interval amount (maybe-normalize-token unit)])
(defmethod normalize-mbql-clause-tokens :datetime-add
  [[_ field amount unit]]
  [:datetime-add (normalize-tokens field :ignore-path) amount (maybe-normalize-token unit)])
(defmethod normalize-mbql-clause-tokens :datetime-subtract
  [[_ field amount unit]]
  [:datetime-subtract (normalize-tokens field :ignore-path) amount (maybe-normalize-token unit)])
(defmethod normalize-mbql-clause-tokens :get-week
  [[_ field mode]]
  (if mode
    [:get-week (normalize-tokens field :ignore-path) (maybe-normalize-token mode)]
    [:get-week (normalize-tokens field :ignore-path)]))
(defmethod normalize-mbql-clause-tokens :temporal-extract
  [[_ field unit mode]]
  (if mode
    [:temporal-extract (normalize-tokens field :ignore-path) (maybe-normalize-token unit) (maybe-normalize-token mode)]
    [:temporal-extract (normalize-tokens field :ignore-path) (maybe-normalize-token unit)]))
(defmethod normalize-mbql-clause-tokens :datetime-diff
  [[_ x y unit]]
  [:datetime-diff
   (normalize-tokens x :ignore-path)
   (normalize-tokens y :ignore-path)
   (maybe-normalize-token unit)])
(defmethod normalize-mbql-clause-tokens :value
  ;; The args of a `value` clause shouldn't be normalized.
  ;; See https://github.com/metabase/metabase/issues/23354 for details
  [[_ value info]]
  [:value value info])
(defmethod normalize-mbql-clause-tokens :default
  ;; MBQL clauses by default are recursively normalized.
  ;; This includes the clause name (e.g. `[\"COUNT\" ...]` becomes `[:count ...]`) and args.
  [[clause-name & args]]
  (into [(maybe-normalize-token clause-name)] (map #(normalize-tokens % :ignore-path)) args))
(defn- aggregation-subclause?
  [x]
  (or (when ((some-fn keyword? string?) x)
        (#{:avg :count :cum-count :distinct :stddev :sum :min :max :+ :- :/ :*
           :sum-where :count-where :share :var :median :percentile}
         (maybe-normalize-token x)))
      (when (mbql-clause? x)
        (aggregation-subclause? (first x)))))

For old-style aggregations like {:aggregation :count} make sure we normalize the ag type (:count). Other wacky clauses like {:aggregation [:count :count]} need to be handled as well :(

(defn- normalize-ag-clause-tokens
  [ag-clause]
  (cond
    ;; something like {:aggregations :count}
    ((some-fn keyword? string?) ag-clause)
    (maybe-normalize-token ag-clause)
    ;; named aggregation ([:named <ag> <name>])
    (is-clause? :named ag-clause)
    (let [[_ wrapped-ag & more] ag-clause]
      (into [:named (normalize-ag-clause-tokens wrapped-ag)] more))
    ;; something wack like {:aggregations [:count [:sum 10]]} or {:aggregations [:count :count]}
    (when (mbql-clause? ag-clause)
      (aggregation-subclause? (second ag-clause)))
    (mapv normalize-ag-clause-tokens ag-clause)
    :else
    (normalize-tokens ag-clause :ignore-path)))

For expressions, we don't want to normalize the name of the expression; keep that as is, and make it a string; normalize the definitions as normal.

(defn- normalize-expressions-tokens
  [expressions-clause]
  (into {} (for [[expression-name definition] expressions-clause]
             [(mbql.u/qualified-name expression-name)
              (normalize-tokens definition :ignore-path)])))

Normalize tokens in the order-by clause, which can have different syntax when using MBQL 95 or 98 rules ([<field> :asc] vs [:asc <field>], for example).

(defn- normalize-order-by-tokens
  [clauses]
  (vec (for [subclause clauses]
         (if (mbql-clause? subclause)
           ;; MBQL 98+ [direction field] style: normalize as normal
           (normalize-mbql-clause-tokens subclause)
           ;; otherwise it's MBQL 95 [field direction] style: flip the args and *then* normalize the clause. And then
           ;; flip it back to put it back the way we found it.
           (reverse (normalize-mbql-clause-tokens (reverse subclause)))))))

Get the function that should be used to transform values for normalized key k in a template tag definition.

(defn- template-tag-definition-key->transform-fn
  [k]
  (get {:default     identity
        :type        maybe-normalize-token
        :widget-type maybe-normalize-token}
       k
       ;; if there's not a special transform function for the key in the map above, just wrap the key-value
       ;; pair in a dummy map and let [[normalize-tokens]] take care of it. Then unwrap
       (fn [v]
         (-> (normalize-tokens {k v} :ignore-path)
             (get k)))))

For a template tag definition, normalize all the keys appropriately.

(defn- normalize-template-tag-definition
  [tag-definition]
  (let [tag-def (into
                 {}
                 (map (fn [[k v]]
                        (let [k            (maybe-normalize-token k)
                              transform-fn (template-tag-definition-key->transform-fn k)]
                          [k (transform-fn v)])))
                 tag-definition)]
    ;; `:widget-type` is a required key for Field Filter (dimension) template tags -- see
    ;; [[metabase.mbql.schema/TemplateTag:FieldFilter]] -- but prior to v42 it wasn't usually included by the
    ;; frontend. See #20643. If it's not present, just add in `:category` which will make things work they way they
    ;; did in the past.
    (cond-> tag-def
      (and (= (:type tag-def) :dimension)
           (not (:widget-type tag-def)))
      (assoc :widget-type :category))))

Normalize native-query template tags. Like expressions we want to preserve the original name rather than normalize it.

(defn- normalize-template-tags
  [template-tags]
  (into
   {}
   (map (fn [[tag-name tag-definition]]
          (let [tag-name (mbql.u/qualified-name tag-name)]
            [tag-name
             (-> (normalize-template-tag-definition tag-definition)
                 (assoc :name tag-name))])))
   template-tags))

Normalize a parameter in the query :parameters list.

(defn normalize-query-parameter
  [{:keys [type target id values_source_config], :as param}]
  (cond-> param
    id                   (update :id mbql.u/qualified-name)
    ;; some things that get ran thru here, like dashcard param targets, do not have :type
    type                 (update :type maybe-normalize-token)
    target               (update :target #(normalize-tokens % :ignore-path))
    values_source_config (update-in [:values_source_config :label_field] #(normalize-tokens % :ignore-path))
    values_source_config (update-in [:values_source_config :value_field] #(normalize-tokens % :ignore-path))))
(defn- normalize-source-query [source-query]
  (let [{native? :native, :as source-query} (m/map-keys maybe-normalize-token source-query)]
    (if native?
      (-> source-query
          (set/rename-keys {:native :query})
          (normalize-tokens [:native])
          (set/rename-keys {:query :native}))
      (normalize-tokens source-query [:query]))))
(defn- normalize-join [join]
  ;; path in call to `normalize-tokens` is [:query] so it will normalize `:source-query` as appropriate
  (let [{:keys [strategy fields alias], :as join} (normalize-tokens join :query)]
    (cond-> join
      strategy
      (update :strategy maybe-normalize-token)
      ((some-fn keyword? string?) fields)
      (update :fields maybe-normalize-token)
      alias
      (update :alias mbql.u/qualified-name))))
(declare canonicalize-mbql-clauses)

Normalize the field ref. Ensure it's well-formed mbql, not just json.

(defn normalize-field-ref
  [clause]
  (-> clause normalize-tokens canonicalize-mbql-clauses))

Normalize source/results metadata for a single column.

(defn normalize-source-metadata
  [metadata]
  {:pre [(map? metadata)]}
  (-> (reduce #(m/update-existing %1 %2 keyword) metadata [:base_type :effective_type :semantic_type :visibility_type :source :unit])
      (m/update-existing :field_ref normalize-field-ref)
      (m/update-existing :fingerprint walk/keywordize-keys)))

For native queries, normalize the top-level keys, and template tags, but nothing else.

(defn- normalize-native-query
  [native-query]
  (let [native-query (m/map-keys maybe-normalize-token native-query)]
    (cond-> native-query
      (seq (:template-tags native-query)) (update :template-tags normalize-template-tags))))

Map of special functions that should be used to perform token normalization for a given path. For example, the :expressions key in an MBQL query should preserve the case of the expression names; this custom behavior is defined below.

TODO - why not make this a multimethod of some sort?

(def ^:private path->special-token-normalization-fn
  {:type            maybe-normalize-token
   ;; don't normalize native queries
   :native          normalize-native-query
   :query           {:aggregation     normalize-ag-clause-tokens
                     :expressions     normalize-expressions-tokens
                     :order-by        normalize-order-by-tokens
                     :source-query    normalize-source-query
                     :source-metadata {::sequence normalize-source-metadata}
                     :joins           {::sequence normalize-join}}
   ;; we smuggle metadata for datasets and want to preserve their "database" form vs a normalized form so it matches
   ;; the style in annotate.clj
   :info            {:metadata/dataset-metadata identity}
   :parameters      {::sequence normalize-query-parameter}
   :context         #(some-> % maybe-normalize-token)
   :source-metadata {::sequence normalize-source-metadata}
   :viz-settings    maybe-normalize-token})

Recursively normalize tokens in x.

Every time this function recurses (thru a map value) it adds a new (normalized) key to key path, e.g. path will be [:query :order-by] when we're in the MBQL order-by clause. If we need to handle these top-level clauses in special ways add a function to path->special-token-normalization-fn above.

In some cases, dealing with the path isn't desirable, but we don't want to accidentally trigger normalization functions (such as accidentally normalizing the :type key in something other than the top-level of the query), so by convention please pass :ignore-path to avoid accidentally triggering path functions.

(defn normalize-tokens
  [x & [path]]
  (let [path       (if (keyword? path)
                     [path]
                     (vec path))
        special-fn (when (seq path)
                     (get-in path->special-token-normalization-fn path))]
    (try
      (cond
        (fn? special-fn)
        (special-fn x)
        ;; Skip record types because this query is an `expanded` query, which is not going to play nice here. Hopefully we
        ;; can remove expanded queries entirely soon.
        (record? x)
        x
        ;; maps should just get the keys normalized and then recursively call normalize-tokens on the values.
        ;; Each recursive call appends to the keypath above so we can handle top-level clauses in a special way if needed
        (map? x)
        (into {} (for [[k v] x
                       :let  [k (maybe-normalize-token k)]]
                   [k (normalize-tokens v (conj (vec path) k))]))
        ;; MBQL clauses handled above because of special cases
        (mbql-clause? x)
        (normalize-mbql-clause-tokens x)
        ;; for non-mbql sequential collections (probably something like the subclauses of :order-by or something like
        ;; that) recurse on all the args.
        ;;
        ;; To signify that we're recursing into a sequential collection, this appends `::sequence` to path
        (sequential? x)
        (mapv #(normalize-tokens % (conj (vec path) ::sequence)) x)
        :else
        x)
      (catch #?(:clj Throwable :cljs js/Error) e
        (throw (ex-info (i18n/tru "Error normalizing form: {0}" (ex-message e))
                        {:form x, :path path, :special-fn special-fn}
                        e))))))

+----------------------------------------------------------------------------------------------------------------+ | CANONICALIZE | +----------------------------------------------------------------------------------------------------------------+

Wrap raw integer Field IDs (i.e., those in an implicit 'field' position) in a :field clause if they're not already. Done for MBQL 95 backwards-compatibility. e.g.:

{:filter [:= 10 20]} ; -> {:filter [:= [:field 10 nil] 20]}

(defn- wrap-implicit-field-id
  [field]
  (if (integer? field)
    [:field field nil]
    field))
(defmulti ^:private canonicalize-mbql-clause
  {:arglists '([clause])}
  (fn [clause]
    (when (mbql-clause? clause)
      (first clause))))
(defmethod canonicalize-mbql-clause :default
  [clause]
  clause)

If clause is a raw integer ID wrap it in a :field clause. Either way, canonicalize the resulting clause.

(defn- canonicalize-implicit-field-id
  [clause]
  (canonicalize-mbql-clause (wrap-implicit-field-id clause)))
(defmethod canonicalize-mbql-clause :field
  [[_ id-or-name opts]]
  (if (is-clause? :field id-or-name)
    (let [[_ nested-id-or-name nested-opts] id-or-name]
      (canonicalize-mbql-clause [:field nested-id-or-name (not-empty (merge nested-opts opts))]))
    ;; remove empty stuff from the options map. The `remove-empty-clauses` step will further remove empty stuff
    ;; afterwards
    [:field id-or-name (not-empty opts)]))
(defmethod canonicalize-mbql-clause :aggregation
  [[_tag index opts]]
  (if (empty? opts)
    [:aggregation index]
    [:aggregation index opts]))

legacy Field clauses

(defmethod canonicalize-mbql-clause :field-id
  [[_ id]]
  ;; if someone is dumb and does something like [:field-id [:field-literal ...]] be nice and fix it for them.
  (if (mbql-clause? id)
    (canonicalize-mbql-clause id)
    [:field id nil]))
(defmethod canonicalize-mbql-clause :field-literal
  [[_ field-name base-type]]
  [:field field-name {:base-type base-type}])
(defmethod canonicalize-mbql-clause :fk->
  [[_ field-1 field-2]]
  (let [[_ source _]       (canonicalize-implicit-field-id field-1)
        [_ dest dest-opts] (canonicalize-implicit-field-id field-2)]
    [:field dest (assoc dest-opts :source-field source)]))
(defmethod canonicalize-mbql-clause :joined-field
  [[_ join-alias field]]
  (-> (canonicalize-implicit-field-id field)
      (mbql.u/assoc-field-options :join-alias join-alias)))
(defmethod canonicalize-mbql-clause :datetime-field
  [clause]
  (case (count clause)
    3
    (let [[_ field unit] clause]
      (-> (canonicalize-implicit-field-id field)
          (mbql.u/with-temporal-unit unit)))

    4
    (let [[_ field _ unit] clause]
      (canonicalize-mbql-clause [:datetime-field field unit]))))
(defmethod canonicalize-mbql-clause :binning-strategy
  [[_ field strategy param binning-options]]
  (let [[_ id-or-name opts] (canonicalize-implicit-field-id field)]
    [:field
     id-or-name
     (assoc opts :binning (merge {:strategy strategy}
                                 (when param
                                   {strategy param})
                                 binning-options))]))

filter clauses

For and/or/not compound filters, recurse on the arg(s), then simplify the whole thing.

(defn- canonicalize-compound-filter-clause [[filter-name & args]]
  (mbql.u/simplify-compound-filter
   (into [filter-name]
         ;; we need to canonicalize any other mbql clauses that might show up in args here because
         ;; simplify-compund-filter validates its output :(
         (map canonicalize-mbql-clause args))))
(doseq [clause-name [:and :or :not]]
  (defmethod canonicalize-mbql-clause clause-name
    [clause]
    (canonicalize-compound-filter-clause clause)))
(defmethod canonicalize-mbql-clause :inside
  [[_ field-1 field-2 & coordinates]]
  (into [:inside
         (canonicalize-implicit-field-id field-1)
         (canonicalize-implicit-field-id field-2)]
        coordinates))
(defmethod canonicalize-mbql-clause :time-interval
  [[_ field & args]]
  ;; if you specify a `:temporal-unit` for the Field inside a `:time-interval`, remove it. The unit in
  ;; `:time-interval` takes precedence.
  (let [field (cond-> (canonicalize-implicit-field-id field)
                (mbql.u/is-clause? :field field) (mbql.u/update-field-options dissoc :temporal-unit))]
    (into [:time-interval field] args)))

all the other filter types have an implict field ID for the first arg (e.g. [:= 10 20] gets canonicalized to [:= [:field-id 10] 20]

(defn- canonicalize-simple-filter-clause
  [[filter-name first-arg & other-args]]
  ;; Support legacy expressions like [:> 1 25] where 1 is a field id.
  (into [filter-name (canonicalize-implicit-field-id first-arg)]
        (map canonicalize-mbql-clause other-args)))
(doseq [clause-name [:starts-with :ends-with :contains :does-not-contain
                     := :!= :< :<= :> :>=
                     :is-empty :not-empty :is-null :not-null
                     :between]]
  (defmethod canonicalize-mbql-clause clause-name
    [clause]
    (canonicalize-simple-filter-clause clause)))

aggregations/expression subclauses

Remove :rows type aggregation (long-since deprecated; simpliy means no aggregation) if present

(defmethod canonicalize-mbql-clause :rows
  [_]
  nil)

TODO -- if options is empty, should we just unwrap the clause?

(defmethod canonicalize-mbql-clause :aggregation-options
  [[_ wrapped-aggregation-clause options]]
  [:aggregation-options (canonicalize-mbql-clause wrapped-aggregation-clause) options])

for legacy :named aggregations convert them to a new-style :aggregation-options clause.

99.99% of clauses should have no options, however if they do and :use-as-display-name? is false (default is true) then generate options to change :name rather than :display-name

(defmethod canonicalize-mbql-clause :named
  [[_ wrapped-ag expr-name & more]]
  (canonicalize-mbql-clause
   [:aggregation-options
    (canonicalize-mbql-clause wrapped-ag)
    (let [[{:keys [use-as-display-name?]}] more]
      (if (false? use-as-display-name?)
        {:name expr-name}
        {:display-name expr-name}))]))
(defn- canonicalize-count-clause [[clause-name field]]
  (if field
    [clause-name (canonicalize-implicit-field-id field)]
    [clause-name]))
(doseq [clause-name [:count :cum-count]]
  (defmethod canonicalize-mbql-clause clause-name
    [clause]
    (canonicalize-count-clause clause)))
(defn- canonicalize-simple-aggregation-with-field
  [[clause-name field]]
  [clause-name (canonicalize-implicit-field-id field)])
(doseq [clause-name [:avg :cum-sum :distinct :stddev :sum :min :max :median :var]]
  (defmethod canonicalize-mbql-clause clause-name
    [clause]
    (canonicalize-simple-aggregation-with-field clause)))
(defmethod canonicalize-mbql-clause :percentile
  [[_ field percentile]]
  [:percentile (canonicalize-implicit-field-id field) percentile])
(defn- canonicalize-filtered-aggregation-clause
  [[clause-name filter-subclause]]
  [clause-name (canonicalize-mbql-clause filter-subclause)])
(doseq [clause-name [:share :count-where]]
  (defmethod canonicalize-mbql-clause clause-name
    [clause]
    (canonicalize-filtered-aggregation-clause clause)))
(defmethod canonicalize-mbql-clause :sum-where
  [[_ field filter-subclause]]
  [:sum-where (canonicalize-mbql-clause field) (canonicalize-mbql-clause filter-subclause)])
(defmethod canonicalize-mbql-clause :case
  [[_ clauses options]]
  (if options
    (conj (canonicalize-mbql-clause [:case clauses])
          (normalize-tokens options :ignore-path))
    [:case (vec (for [[pred expr] clauses]
                  [(canonicalize-mbql-clause pred) (canonicalize-mbql-clause expr)]))]))
(defmethod canonicalize-mbql-clause :substring
  [[_ arg start & more]]
  (into [:substring
         (canonicalize-mbql-clause arg)
         ;; 0 indexes were allowed in the past but we are now enforcing this rule in MBQL.
         ;; This allows stored queries with literal 0 in the index to work.
         (if (= 0 start) 1 (canonicalize-mbql-clause start))]
        (map canonicalize-mbql-clause more)))

top-level key canonicalization

Walk an mbql-query an canonicalize non-top-level clauses like :fk->.

(defn- canonicalize-mbql-clauses
  [mbql-query]
  (walk/prewalk
   (fn [x]
     (cond
       (map? x)
       (m/map-vals canonicalize-mbql-clauses x)
       (not (mbql-clause? x))
       x
       :else
       (try
         (canonicalize-mbql-clause x)
         (catch #?(:clj Throwable :cljs js/Error) e
           (log/error (i18n/tru "Invalid clause:") x)
           (throw (ex-info (i18n/tru "Invalid MBQL clause: {0}" (ex-message e))
                           {:clause x}
                           e))))))
   mbql-query))

Convert old MBQL 95 single-aggregations like {:aggregation :count} or {:aggregation [:count]} to MBQL 98+ multiple-aggregation syntax (e.g. {:aggregation [[:count]]}).

(defn- wrap-single-aggregations
  [aggregations]
  (mbql.match/replace aggregations
    seq? (recur (vec &match))
    ;; something like {:aggregations :count} -- MBQL 95 single aggregation
    keyword?
    [[&match]]
    ;; special-case: MBQL 98 multiple aggregations using unwrapped :count or :rows
    ;; e.g. {:aggregations [:count [:sum 10]]} or {:aggregations [:count :count]}
    [(_ :guard (every-pred keyword? (complement #{:named :+ :- :* :/})))
     (_ :guard aggregation-subclause?)
     & _]
    (into [] (mapcat wrap-single-aggregations) aggregations)
    ;; something like {:aggregations [:sum 10]} -- MBQL 95 single aggregation
    [(_ :guard keyword?) & _]
    [&match]
    _
    &match))

Canonicalize subclauses (see above) and make sure :aggregation is a sequence of clauses instead of a single clause.

(defn- canonicalize-aggregations
  [aggregations]
  (->> (wrap-single-aggregations aggregations)
       (keep canonicalize-mbql-clauses)
       vec))
(defn- canonicalize-breakouts [breakouts]
  (if (mbql-clause? breakouts)
    (recur [breakouts])
    (not-empty (mapv wrap-implicit-field-id breakouts))))

Make sure order by clauses like [:asc 10] get :field-id added where appropriate, e.g. [:asc [:field-id 10]]

(defn- canonicalize-order-by
  [clauses]
  (mbql.match/replace clauses
    seq? (recur (vec &match))
    ;; MBQL 95 reversed [<field> <direction>] clause
    [field :asc]        (recur [:asc field])
    [field :desc]       (recur [:desc field])
    [field :ascending]  (recur [:asc field])
    [field :descending] (recur [:desc field])
    ;; MBQL 95 names but MBQL 98+ reversed syntax
    [:ascending field]  (recur [:asc field])
    [:descending field] (recur [:desc field])
    [:asc field]  [:asc  (canonicalize-implicit-field-id field)]
    [:desc field] [:desc (canonicalize-implicit-field-id field)]
    ;; this case should be the first one hit when we come in with a vector of clauses e.g. [[:asc 1] [:desc 2]]
    [& clauses] (vec (distinct (map canonicalize-order-by clauses)))))
(declare canonicalize-inner-mbql-query)
(defn- canonicalize-template-tag [{:keys [dimension], :as tag}]
  (cond-> tag
    dimension (update :dimension canonicalize-mbql-clause)))
(defn- canonicalize-template-tags [tags]
  (into {} (for [[tag-name tag] tags]
             [tag-name (canonicalize-template-tag tag)])))
(defn- canonicalize-native-query [{:keys [template-tags], :as native-query}]
  (cond-> native-query
    template-tags (update :template-tags canonicalize-template-tags)))
(defn- canonicalize-source-query [{native? :native, :as source-query}]
  (cond-> source-query
    (not native?) canonicalize-inner-mbql-query
    native?       canonicalize-native-query))
(defn- non-empty? [x]
  (if (coll? x)
    (seq x)
    (some? x)))

Perform specific steps to canonicalize the various top-level clauses in an MBQL query.

(defn- canonicalize-top-level-mbql-clauses
  [mbql-query]
  (cond-> mbql-query
    (non-empty? (:aggregation  mbql-query)) (update :aggregation  canonicalize-aggregations)
    (non-empty? (:breakout     mbql-query)) (update :breakout     canonicalize-breakouts)
    (non-empty? (:fields       mbql-query)) (update :fields       (partial mapv wrap-implicit-field-id))
    (non-empty? (:order-by     mbql-query)) (update :order-by     canonicalize-order-by)
    (non-empty? (:source-query mbql-query)) (update :source-query canonicalize-source-query)))
(def ^:private ^{:arglists '([query])} canonicalize-inner-mbql-query
  (comp canonicalize-mbql-clauses canonicalize-top-level-mbql-clauses))

In Metabase 0.33.0 :source-metadata about resolved queries is added to the 'inner' MBQL query rather than to the top-level; if we encounter the old style, move it to the appropriate location.

(defn- move-source-metadata-to-mbql-query
  [{:keys [source-metadata], :as query}]
  (-> query
      (dissoc :source-metadata)
      (assoc-in [:query :source-metadata] source-metadata)))

Canonicalize a query [MBQL query], rewriting the query as if you perfectly followed the recommended style guides for writing MBQL. Does things like removes unneeded and empty clauses, converts older MBQL '95 syntax to MBQL '98, etc.

(defn- canonicalize
  [{:keys [query parameters source-metadata native], :as outer-query}]
  (try
    (cond-> outer-query
      source-metadata move-source-metadata-to-mbql-query
      query           (update :query canonicalize-inner-mbql-query)
      parameters      (update :parameters (partial mapv canonicalize-mbql-clauses))
      native          (update :native canonicalize-native-query)
      true            canonicalize-mbql-clauses)
    (catch #?(:clj Throwable :cljs js/Error) e
      (throw (ex-info (i18n/tru "Error canonicalizing query: {0}" (ex-message e))
                      {:query query}
                      e)))))

+----------------------------------------------------------------------------------------------------------------+ | WHOLE-QUERY TRANSFORMATIONS | +----------------------------------------------------------------------------------------------------------------+

Remove any Fields specified in both :breakout and :fields from :fields; it is implied that any breakout Field will be returned, specifying it in both would imply it is to be returned twice, which tends to cause confusion for the QP and drivers. (This is done to work around historic bugs with the way queries were generated on the frontend; I'm not sure this behavior makes sense, but removing it would break existing queries.)

We will remove either exact matches:

{:breakout [[:field-id 10]], :fields [[:field-id 10]]} ; -> {:breakout [[:field-id 10]]}

or unbucketed matches:

{:breakout [[:datetime-field [:field-id 10] :month]], :fields [[:field-id 10]]} ;; -> {:breakout [[:field-id 10]]}

(defn- remove-breakout-fields-from-fields
  [{{:keys [breakout fields]} :query, :as query}]
  (if-not (and (seq breakout) (seq fields))
    query
    ;; get a set of all Field clauses (of any type) in the breakout. For temporal-bucketed fields, we'll include both
    ;; the bucketed `[:datetime-field <field> ...]` clause and the `<field>` clause it wraps
    (let [breakout-fields (into #{} cat (mbql.match/match breakout
                                          [:field id-or-name opts]
                                          [&match
                                           [:field id-or-name (dissoc opts :temporal-unit)]]))]
      ;; now remove all the Fields in `:fields` that match the ones in the set
      (update-in query [:query :fields] (comp vec (partial remove breakout-fields))))))

Perform transformations that operate on the query as a whole, making sure the structure as a whole is logical and consistent.

(defn- perform-whole-query-transformations
  [query]
  (try
    (remove-breakout-fields-from-fields query)
    (catch #?(:clj Throwable :cljs js/Error) e
      (throw (ex-info (i18n/tru "Error performing whole query transformations")
                      {:query query}
                      e)))))

+----------------------------------------------------------------------------------------------------------------+ | REMOVING EMPTY CLAUSES | +----------------------------------------------------------------------------------------------------------------+

(declare remove-empty-clauses)
(defn- remove-empty-clauses-in-map [m path]
  (let [m (into (empty m) (for [[k v] m
                                :let  [v (remove-empty-clauses v (conj path k))]
                                :when (some? v)]
                            [k v]))]
    (when (seq m)
      m)))
(defn- remove-empty-clauses-in-sequence [xs path]
  (let [xs (mapv #(remove-empty-clauses % (conj path ::sequence))
                 xs)]
    (when (some some? xs)
      xs)))
(defn- remove-empty-clauses-in-join [join]
  (remove-empty-clauses join [:query]))
(defn- remove-empty-clauses-in-source-query [{native? :native, :as source-query}]
  (if native?
    (-> source-query
        (set/rename-keys {:native :query})
        (remove-empty-clauses [:native])
        (set/rename-keys {:query :native}))
    (remove-empty-clauses source-query [:query])))
(def ^:private path->special-remove-empty-clauses-fn
  {:native identity
   :query  {:source-query remove-empty-clauses-in-source-query
            :joins        {::sequence remove-empty-clauses-in-join}}
   :viz-settings identity})

Remove any empty or nil clauses in a query.

(defn- remove-empty-clauses
  ([query]
   (remove-empty-clauses query []))
  ([x path]
   (try
     (let [special-fn (when (seq path)
                        (get-in path->special-remove-empty-clauses-fn path))]
       (cond
         (fn? special-fn) (special-fn x)
         (record? x)      x
         (map? x)         (remove-empty-clauses-in-map x path)
         (sequential? x)  (remove-empty-clauses-in-sequence x path)
         :else            x))
     (catch #?(:clj Throwable :cljs js/Error) e
       (throw (ex-info "Error removing empty clauses from form."
                       {:form x, :path path}
                       e))))))

+----------------------------------------------------------------------------------------------------------------+ | PUTTING IT ALL TOGETHER | +----------------------------------------------------------------------------------------------------------------+

Normalize the tokens in a Metabase query (i.e., make them all lisp-case keywords), rewrite deprecated clauses as up-to-date MBQL 2000, and remove empty clauses.

(def ^{:arglists '([outer-query])} normalize
  (let [normalize* (comp remove-empty-clauses
                         perform-whole-query-transformations
                         canonicalize
                         normalize-tokens)]
    (fn [query]
      (try
        (normalize* query)
        (catch #?(:clj Throwable :cljs js/Error) e
          (throw (ex-info (i18n/tru "Error normalizing query: {0}" (ex-message e))
                          {:query query}
                          e)))))))

Normalize just a specific fragment of a query, such as just the inner MBQL part or just a filter clause. path is where this fragment would normally live in a full query.

(normalize-fragment [:query :filter] ["=" 100 200]) ;;-> [:= [:field-id 100] 200]

(mu/defn normalize-fragment
  [path :- [:maybe [:sequential :keyword]]
   x]
  (if-not (seq path)
    (normalize x)
    (get (normalize-fragment (butlast path) {(last path) x}) (last path))))
 

Predicate functions for checking whether something is a valid instance of a given MBQL clause.

(ns metabase.mbql.predicates
  (:require
   [metabase.lib.schema.temporal-bucketing
    :as lib.schema.temporal-bucketing]
   [metabase.mbql.schema :as mbql.s]
   [metabase.util.malli.registry :as mr]))

Is unit a valid datetime bucketing unit?

(def ^{:arglists '([unit])} DateTimeUnit?
  (mr/validator ::lib.schema.temporal-bucketing/unit))

Is this a valid Aggregation clause?

(def ^{:arglists '([ag-clause])} Aggregation?
  (mr/validator mbql.s/Aggregation))

Is this a valid Field clause?

(def ^{:arglists '([field-clause])} Field?
  (mr/validator mbql.s/Field))

Is this a valid :filter clause?

(def ^{:arglists '([filter-clause])} Filter?
  (mr/validator mbql.s/Filter))

Is this a valid DatetimeExpression clause?

(def ^{:arglists '([filter-clause])} DatetimeExpression?
  (mr/validator mbql.s/DatetimeExpression))

Is this a something that is valid as a top-level expression definition?

(def ^{:arglists '([field-clause])} FieldOrExpressionDef?
  (mr/validator mbql.s/FieldOrExpressionDef))
 

Schema for validating a normalized MBQL query. This is also the definitive grammar for MBQL, wow!

(ns metabase.mbql.schema
  (:refer-clojure :exclude [count distinct min max + - / * and or not not-empty = < > <= >= time case concat replace abs])
  (:require
   [clojure.core :as core]
   [clojure.set :as set]
   [malli.core :as mc]
   [malli.error :as me]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.expression.temporal :as lib.schema.expression.temporal]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.lib.schema.literal :as lib.schema.literal]
   [metabase.mbql.schema.helpers :as helpers :refer [is-clause?]]
   [metabase.mbql.schema.macros :refer [defclause one-of]]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util.malli.registry :as mr]))

A NOTE ABOUT METADATA:

Clauses below are marked with the following tags for documentation purposes:

  • Clauses marked ^:sugar are syntactic sugar primarily intended to make generating queries easier on the frontend. These clauses are automatically rewritten as simpler clauses by the desugar or expand-macros middleware. Thus driver implementations do not need to handle these clauses.

  • Clauses marked ^:internal are automatically generated by wrap-value-literals or other middleware from values passed in. They are not intended to be used by the frontend when generating a query. These add certain information that simplify driver implementations. When writing MBQL queries yourself you should pretend these clauses don't exist.

  • Clauses marked ^{:requires-features #{feature+}} require a certain set of features to be used. At some date in the future we will likely add middleware that uses this metadata to automatically validate that a driver has the features needed to run the query in question.

(def ^:private NonBlankString
  [:ref ::lib.schema.common/non-blank-string])
(def ^:private BaseType
  [:ref ::lib.schema.common/base-type])
(def ^:private SemanticOrRelationType
  [:ref ::lib.schema.common/semantic-or-relation-type])
(def ^:private PositiveInt
  [:ref ::lib.schema.common/positive-int])
(def ^:private IntGreaterThanOrEqualToZero
  [:ref ::lib.schema.common/int-greater-than-or-equal-to-zero])
(def ^:private FieldID
  [:ref ::lib.schema.id/field])
(def ^:private CardID
  [:ref ::lib.schema.id/card])
(def ^:private TableID
  [:ref ::lib.schema.id/table])
(def ^:private RawDateLiteral
  [:ref ::lib.schema.literal/date])
(def ^:private RawDateTimeLiteral
  [:ref ::lib.schema.literal/datetime])
(def ^:private RawTimeLiteral
  [:ref ::lib.schema.literal/time])

Set of valid units for bucketing or comparing against a date Field.

:day-of-week depends on the [[metabase.public-settings/start-of-week]] Setting, by default Sunday. 1 = first day of the week (e.g. Sunday) 7 = last day of the week (e.g. Saturday)

(def ^:private date-bucketing-units
  #{:default :day :day-of-week :day-of-month :day-of-year :week :week-of-year
    :month :month-of-year :quarter :quarter-of-year :year})

Set of valid units for bucketing or comparing against a time Field.

(def ^:private time-bucketing-units
  #{:default :millisecond :second :minute :minute-of-hour :hour :hour-of-day})

Set of valid units for bucketing or comparing against a datetime Field.

(def datetime-bucketing-units
  (set/union date-bucketing-units time-bucketing-units))

Valid unit for date bucketing.

(def ^:private DateUnit
  (into [:enum {:error/message "date bucketing unit"}] date-bucketing-units))

Valid unit for time bucketing.

it could make sense to say hour-of-day(field) = hour-of-day("2018-10-10T12:00") but it does not make sense to say month-of-year(field) = month-of-year("08:00:00"), does it? So we'll restrict the set of units a TimeValue can have to ones that have no notion of day/date.

(def ^:private TimeUnit
  (into [:enum {:error/message "time bucketing unit"}] time-bucketing-units))

Valid unit for datetime bucketing.

(def DateTimeUnit
  (into [:enum {:error/message "datetime bucketing unit"}] datetime-bucketing-units))

Valid timezone id.

(def ^:private TimezoneId
  [:ref ::lib.schema.expression.temporal/timezone-id])

Valid units to extract from a temporal.

(def ^:private TemporalExtractUnit
  [:enum
   {:error/message "temporal extract unit"}
   :year-of-era
   :quarter-of-year
   :month-of-year
   :week-of-year-iso
   :week-of-year-us
   :week-of-year-instance
   :day-of-month
   :day-of-week
   :hour-of-day
   :minute-of-hour
   :second-of-minute])

Valid units for a datetime-diff clause.

(def ^:private DatetimeDiffUnit
  [:enum {:error/message "datetime-diff unit"} :second :minute :hour :day :week :month :quarter :year])

Valid modes to extract weeks.

(def ^:private ExtractWeekMode
  [:enum {:error/message "temporal-extract week extraction mode"} :iso :us :instance])
(def ^:private RelativeDatetimeUnit
  [:enum {:error/message "relative-datetime unit"} :default :minute :hour :day :week :month :quarter :year])

TODO - unit is not allowed if n is current

(defclause relative-datetime
  n    [:or [:= :current] :int]
  unit (optional RelativeDatetimeUnit))
(defclause interval
  n    :int
  unit RelativeDatetimeUnit)

This clause is automatically generated by middleware when datetime literals (literal strings or one of the Java types) are encountered. Unit is inferred by looking at the Field the timestamp is compared against. Implemented mostly to convenience driver implementations. You don't need to use this form directly when writing MBQL; datetime literal strings are preferred instead.

example: [:= [:field 10 {:temporal-unit :day}] "2018-10-02"]

becomes: [:= [:field 10 {:temporal-unit :day}] [:absolute-datetime #inst "2018-10-02" :day]]

(mr/def ::absolute-datetime
  [:multi {:error/message "valid :absolute-datetime clause"
           :dispatch      (fn [x]
                            (cond
                              (core/not (is-clause? :absolute-datetime x)) :invalid
                              (mr/validate RawDateLiteral (second x))      :date
                              :else                                        :datetime))}
   [:invalid [:fn
              {:error/message "not an :absolute-datetime clause"}
              (constantly false)]]
   [:date (helpers/clause
           :absolute-datetime
           "date" RawDateLiteral
           "unit" DateUnit)]
   [:datetime (helpers/clause
               :absolute-datetime
               "datetime" RawDateTimeLiteral
               "unit"     DateTimeUnit)]])

Schema for an :absolute-datetime clause.

(def ^:internal ^{:clause-name :absolute-datetime} absolute-datetime
  [:ref ::absolute-datetime])

almost exactly the same as absolute-datetime, but generated in some sitations where the literal in question was clearly a time (e.g. "08:00:00.000") and/or the Field derived from :type/Time and/or the unit was a time-bucketing unit

(defclause ^:internal time
  time RawTimeLiteral
  unit TimeUnit)

Schema for a valid date or datetime literal.

(def ^:private DateOrDatetimeLiteral
  [:or
   {:error/message "date or datetime literal"}
   absolute-datetime
   ;; literal datetime strings and Java types will get transformed to [[absolute-datetime]] clauses automatically by
   ;; middleware so drivers don't need to deal with these directly. You only need to worry about handling
   ;; `absolute-datetime` clauses.
   RawDateTimeLiteral
   RawDateLiteral])
(mr/def ::TimeLiteral
  [:or
   {:error/message "time literal"}
   time
   RawTimeLiteral])

Schema for valid time literals.

(def ^:private TimeLiteral
  [:ref ::TimeLiteral])
(mr/def ::TemporalLiteral
  [:or
   {:error/message "temporal literal"}
   DateOrDatetimeLiteral
   TimeLiteral])

Schema for valid temporal literals.

(def ^:private TemporalLiteral
  [:ref ::TemporalLiteral])
(mr/def ::DateTimeValue
  (one-of absolute-datetime relative-datetime time))

Schema for a datetime value drivers will personally have to handle, either an absolute-datetime form or a relative-datetime form.

(def DateTimeValue
  [:ref ::DateTimeValue])

-------------------------------------------------- Other Values --------------------------------------------------

Type info about a value in a :value clause. Added automatically by wrap-value-literals middleware to values in filter clauses based on the Field in the clause.

(def ^:private ValueTypeInfo
  [:map
   [:database_type {:optional true} [:maybe NonBlankString]]
   [:base_type     {:optional true} [:maybe BaseType]]
   [:semantic_type {:optional true} [:maybe SemanticOrRelationType]]
   [:unit          {:optional true} [:maybe DateTimeUnit]]
   [:name          {:optional true} [:maybe NonBlankString]]])

Arguments to filter clauses are automatically replaced with [:value ] clauses by the wrap-value-literals middleware. This is done to make it easier to implement query processors, because most driver implementations dispatch off of Object type, which is often not enough to make informed decisions about how to treat certain objects. For example, a string compared against a Postgres UUID Field needs to be parsed into a UUID object, since text <-> UUID comparison doesn't work in Postgres. For this reason, raw literals in :filter clauses are wrapped in :value clauses and given information about the type of the Field they will be compared to.

(defclause ^:internal value
  value    :any
  type-info [:maybe ValueTypeInfo])

----------------------------------------------------- Fields -----------------------------------------------------

Expression references refer to a something in the :expressions clause, e.g. something like

[:+ [:field 1 nil] [:field 2 nil]]

As of 0.42.0 :expression references can have an optional options map

(defclause ^{:requires-features #{:expressions}} expression
  expression-name NonBlankString
  options         (optional :map))

Schema for a valid value for the strategy-name param of a [[field]] clause with :binning information.

(def ^:private BinningStrategyName
  [:enum {:error/message "binning strategy"} :num-bins :bin-width :default])
(defn- validate-bin-width [schema]
  [:and
   schema
   [:fn
    {:error/message "You must specify :bin-width when using the :bin-width strategy."}
    (fn [{:keys [strategy bin-width]}]
      (if (core/= strategy :bin-width)
        bin-width
        true))]])
(defn- validate-num-bins [schema]
  [:and
   schema
   [:fn
    {:error/message "You must specify :num-bins when using the :num-bins strategy."}
    (fn [{:keys [strategy num-bins]}]
      (if (core/= strategy :num-bins)
        num-bins
        true))]])

Schema for :binning options passed to a :field clause.

(def ^:private FieldBinningOptions
  (-> [:map
       {:error/message "binning options"}
       [:strategy                   BinningStrategyName]
       [:num-bins {:optional true}  PositiveInt]
       [:bin-width {:optional true} [:and
                                     number?
                                     [:fn
                                      {:error/message "bin width must be >= 0."}
                                      (complement neg?)]]]]
      validate-bin-width
      validate-num-bins))

Whether temporal-unit (e.g. :day) is valid for the given base-type (e.g. :type/Date). If either is nil this will return truthy. Accepts either map of field-options or base-type and temporal-unit passed separately.

(defn valid-temporal-unit-for-base-type?
  ([{:keys [base-type temporal-unit] :as _field-options}]
   (valid-temporal-unit-for-base-type? base-type temporal-unit))
  ([base-type temporal-unit]
   (if-let [units (when (core/and temporal-unit base-type)
                    (condp #(isa? %2 %1) base-type
                      :type/Date     date-bucketing-units
                      :type/Time     time-bucketing-units
                      :type/DateTime datetime-bucketing-units
                      nil))]
     (contains? units temporal-unit)
     true)))
(defn- validate-temporal-unit [schema]
  ;; TODO - consider breaking this out into separate constraints for the three different types so we can generate more
  ;; specific error messages
  [:and
   schema
   [:fn
    {:error/message "Invalid :temporal-unit for the specified :base-type."}
    valid-temporal-unit-for-base-type?]])
(defn- no-binning-options-at-top-level [schema]
  [:and
   schema
   [:fn
    {:error/message "Found :binning keys at the top level of :field options. binning-related options belong under the :binning key."}
    (complement :strategy)]])
(mr/def ::FieldOptions
  (-> [:map
       {:error/message "field options"}
       [:base-type {:optional true} [:maybe BaseType]]
       ;;
       ;; replaces `fk->`
       ;;
       ;; `:source-field` is used to refer to a FieldOrExpression from a different Table you would like IMPLICITLY JOINED to the
       ;; source table.
       ;;
       ;; If both `:source-field` and `:join-alias` are supplied, `:join-alias` should be used to perform the join;
       ;; `:source-field` should be for information purposes only.
       [:source-field {:optional true} [:maybe FieldID]]
       ;;
       ;; `:temporal-unit` is used to specify DATE BUCKETING for a FieldOrExpression that represents a moment in time
       ;; of some sort.
       ;;
       ;; There is no requirement that all `:type/Temporal` derived FieldOrExpressions specify a `:temporal-unit`, but
       ;; for legacy reasons `:field` clauses that refer to `:type/DateTime` FieldOrExpressions will be
       ;; automatically "bucketed" in the `:breakout` and `:filter` clauses, but nowhere else. Auto-bucketing only
       ;; applies to `:filter` clauses when values for comparison are `yyyy-MM-dd` date strings. See the
       ;; `auto-bucket-datetimes` middleware for more details. `:field` clauses elsewhere will not be automatically
       ;; bucketed, so drivers still need to make sure they do any special datetime handling for plain `:field`
       ;; clauses when their FieldOrExpression derives from `:type/DateTime`.
       [:temporal-unit {:optional true} [:maybe DateTimeUnit]]
       ;;
       ;; replaces `joined-field`
       ;;
       ;; `:join-alias` is used to refer to a FieldOrExpression from a different Table/nested query that you are
       ;; EXPLICITLY JOINING against.
       [:join-alias {:optional true} [:maybe NonBlankString]]
       ;;
       ;; replaces `binning-strategy`
       ;;
       ;; Using binning requires the driver to support the `:binning` feature.
       [:binning {:optional true} [:maybe FieldBinningOptions]]]
      validate-temporal-unit
      no-binning-options-at-top-level))
(def ^:private FieldOptions
  [:ref ::FieldOptions])
(defn- require-base-type-for-field-name [schema]
  [:and
   schema
   [:fn
    {:error/message ":field clauses using a string field name must specify :base-type."}
    (fn [[_ id-or-name {:keys [base-type]}]]
      (if (string? id-or-name)
        base-type
        true))]])
(mr/def ::field
  (-> (helpers/clause
       :field
       "id-or-name" [:or FieldID NonBlankString]
       "options"    [:maybe FieldOptions])
      require-base-type-for-field-name))

Schema for a :field clause.

(def ^{:clause-name :field, :added "0.39.0"} field
  [:ref ::field])
(def ^{:clause-name :field, :added "0.39.0"} field:id
  "Schema for a `:field` clause, with the added constraint that it must use an integer Field ID."
  [:and
   field
   [:fn
    {:error/message "Must be a :field with an integer Field ID."}
    (fn [[_ id-or-name]]
      (integer? id-or-name))]])
(mr/def ::Field
  (one-of expression field))

Schema for either a :field clause (reference to a Field) or an :expression clause (reference to an expression).

(def Field
  [:ref ::Field])

aggregate field reference refers to an aggregation, e.g.

{:aggregation [[:count]] :order-by [[:asc [:aggregation 0]]]} ;; refers to the 0th aggregation, :count

Currently aggregate Field references can only be used inside order-by clauses. In the future once we support SQL HAVING we can allow them in filter clauses too

TODO - shouldn't we allow composing aggregations in expressions? e.g.

{:order-by [[:asc [:+ [:aggregation 0] [:aggregation 1]]]]}

TODO - it would be nice if we could check that there's actually an aggregation with the corresponding index, wouldn't it

As of 0.42.0 :aggregation references can have an optional options map.

(defclause aggregation
  aggregation-clause-index :int
  options                  (optional :map))
(mr/def ::Reference
  (one-of aggregation expression field))

Schema for any type of valid Field clause, or for an indexed reference to an aggregation clause.

(def Reference
  [:ref ::Reference])

-------------------------------------------------- Expressions ---------------------------------------------------

Expressions are "calculated column" definitions, defined once and then used elsewhere in the MBQL query.

Functions that return string values. Should match [[StringExpression]].

(def string-functions
  #{:substring :trim :rtrim :ltrim :upper :lower :replace :concat :regex-match-first :coalesce :case})

Schema for the definition of an string expression.

(def ^:private StringExpression
  [:ref ::StringExpression])
(mr/def ::StringExpressionArg
  [:multi
   {:dispatch (fn [x]
                (cond
                  (string? x)                     :string
                  (is-clause? string-functions x) :string-expression
                  (is-clause? :value x)           :value
                  :else                           :else))}
   [:string            :string]
   [:string-expression StringExpression]
   [:value             value]
   [:else              Field]])
(def ^:private StringExpressionArg
  [:ref ::StringExpressionArg])

Functions that return numeric values. Should match [[NumericExpression]].

(def numeric-functions
  #{:+ :- :/ :* :coalesce :length :round :ceil :floor :abs :power :sqrt :log :exp :case :datetime-diff
    ;; extraction functions (get some component of a given temporal value/column)
    :temporal-extract
    ;; SUGAR drivers do not need to implement
    :get-year :get-quarter :get-month :get-week :get-day :get-day-of-week :get-hour :get-minute :get-second})

Functions that return boolean values. Should match [[BooleanExpression]].

(def ^:private boolean-functions
  #{:and :or :not :< :<= :> :>= := :!=})
(def ^:private aggregations
  #{:sum :avg :stddev :var :median :percentile :min :max :cum-count :cum-sum :count-where :sum-where :share :distinct
    :metric :aggregation-options :count})

Functions that return Date or DateTime values. Should match [[DatetimeExpression]].

(def ^:private datetime-functions
  #{:+ :datetime-add :datetime-subtract :convert-timezone :now})

Schema for the definition of a numeric expression. All numeric expressions evaluate to numeric values.

(def ^:private NumericExpression
  [:ref ::NumericExpression])

Schema for the definition of an arithmetic expression.

(def ^:private BooleanExpression
  [:ref ::BooleanExpression])

Schema for the definition of a date function expression.

(def DatetimeExpression
  [:ref ::DatetimeExpression])

Schema for anything that is a valid :aggregation clause.

(def Aggregation
  [:ref ::Aggregation])
(mr/def ::NumericExpressionArg
  [:multi
   {:error/message "numeric expression argument"
    :dispatch      (fn [x]
                     (cond
                       (number? x)                      :number
                       (is-clause? numeric-functions x) :numeric-expression
                       (is-clause? aggregations x)      :aggregation
                       (is-clause? :value x)            :value
                       :else                            :field))}
   [:number             number?]
   [:numeric-expression NumericExpression]
   [:aggregation        Aggregation]
   [:value              value]
   [:field              Field]])
(def ^:private NumericExpressionArg
  [:ref ::NumericExpressionArg])
(mr/def ::DateTimeExpressionArg
  [:multi
   {:error/message "datetime expression argument"
    :dispatch      (fn [x]
                     (cond
                       (is-clause? aggregations x)       :aggregation
                       (is-clause? :value x)             :value
                       (is-clause? datetime-functions x) :datetime-expression
                       :else                             :else))}
   [:aggregation         Aggregation]
   [:value               value]
   [:datetime-expression DatetimeExpression]
   [:else                [:or DateOrDatetimeLiteral Field]]])
(def ^:private DateTimeExpressionArg
  [:ref ::DateTimeExpressionArg])
(mr/def ::ExpressionArg
  [:multi
   {:error/message "expression argument"
    :dispatch      (fn [x]
                     (cond
                       (number? x)                       :number
                       (boolean? x)                      :boolean
                       (is-clause? boolean-functions x)  :boolean-expression
                       (is-clause? numeric-functions x)  :numeric-expression
                       (is-clause? datetime-functions x) :datetime-expression
                       (string? x)                       :string
                       (is-clause? string-functions x)   :string-expression
                       (is-clause? :value x)             :value
                       :else                             :else))}
   [:number              number?]
   [:boolean             :boolean]
   [:boolean-expression  BooleanExpression]
   [:numeric-expression  NumericExpression]
   [:datetime-expression DatetimeExpression]
   [:string              :string]
   [:string-expression   StringExpression]
   [:value               value]
   [:else                Field]])
(def ^:private ExpressionArg
  [:ref ::ExpressionArg])
(mr/def ::NumericExpressionArgOrInterval
  [:or
   {:error/message "numeric expression arg or interval"}
   interval
   NumericExpressionArg])
(def ^:private NumericExpressionArgOrInterval
  [:ref ::NumericExpressionArgOrInterval])
(mr/def ::IntGreaterThanZeroOrNumericExpression
  [:multi
   {:error/message "int greater than zero or numeric expression"
    :dispatch      (fn [x]
                     (if (number? x)
                       :number
                       :else))}
   [:number PositiveInt]
   [:else   NumericExpression]])
(def ^:private IntGreaterThanZeroOrNumericExpression
  [:ref ::IntGreaterThanZeroOrNumericExpression])
(defclause ^{:requires-features #{:expressions}} coalesce
  a ExpressionArg, b ExpressionArg, more (rest ExpressionArg))
(defclause ^{:requires-features #{:expressions}} substring
  s StringExpressionArg, start IntGreaterThanZeroOrNumericExpression, length (optional NumericExpressionArg))
(defclause ^{:requires-features #{:expressions}} length
  s StringExpressionArg)
(defclause ^{:requires-features #{:expressions}} trim
  s StringExpressionArg)
(defclause ^{:requires-features #{:expressions}} rtrim
  s StringExpressionArg)
(defclause ^{:requires-features #{:expressions}} ltrim
  s StringExpressionArg)
(defclause ^{:requires-features #{:expressions}} upper
  s StringExpressionArg)
(defclause ^{:requires-features #{:expressions}} lower
  s StringExpressionArg)
(defclause ^{:requires-features #{:expressions}} replace
  s StringExpressionArg, match :string, replacement :string)
(defclause ^{:requires-features #{:expressions}} concat
  a StringExpressionArg, b StringExpressionArg, more (rest StringExpressionArg))
(defclause ^{:requires-features #{:expressions :regex}} regex-match-first
  s StringExpressionArg, pattern :string)
(defclause ^{:requires-features #{:expressions}} +
  x NumericExpressionArgOrInterval, y NumericExpressionArgOrInterval, more (rest NumericExpressionArgOrInterval))
(defclause ^{:requires-features #{:expressions}} -
  x NumericExpressionArg, y NumericExpressionArgOrInterval, more (rest NumericExpressionArgOrInterval))
(defclause ^{:requires-features #{:expressions}} /, x NumericExpressionArg, y NumericExpressionArg, more (rest NumericExpressionArg))
(defclause ^{:requires-features #{:expressions}} *, x NumericExpressionArg, y NumericExpressionArg, more (rest NumericExpressionArg))
(defclause ^{:requires-features #{:expressions}} floor
  x NumericExpressionArg)
(defclause ^{:requires-features #{:expressions}} ceil
  x NumericExpressionArg)
(defclause ^{:requires-features #{:expressions}} round
  x NumericExpressionArg)
(defclause ^{:requires-features #{:expressions}} abs
  x NumericExpressionArg)
(defclause ^{:requires-features #{:advanced-math-expressions}} power
  x NumericExpressionArg,  y NumericExpressionArg)
(defclause ^{:requires-features #{:advanced-math-expressions}} sqrt
  x NumericExpressionArg)
(defclause ^{:requires-features #{:advanced-math-expressions}} exp
  x NumericExpressionArg)
(defclause ^{:requires-features #{:advanced-math-expressions}} log
  x NumericExpressionArg)

The result is positive if x <= y, and negative otherwise.

Days, weeks, months, and years are only counted if they are whole to the "day". For example, datetimeDiff("2022-01-30", "2022-02-28", "month") returns 0 months.

If the values are datetimes, the time doesn't matter for these units. For example, datetimeDiff("2022-01-01T09:00:00", "2022-01-02T08:00:00", "day") returns 1 day even though it is less than 24 hours.

Hours, minutes, and seconds are only counted if they are whole. For example, datetimeDiff("2022-01-01T01:00:30", "2022-01-01T02:00:29", "hour") returns 0 hours.

(defclause ^{:requires-features #{:datetime-diff}} datetime-diff
  datetime-x DateTimeExpressionArg
  datetime-y DateTimeExpressionArg
  unit       DatetimeDiffUnit)
(defclause ^{:requires-features #{:temporal-extract}} temporal-extract
  datetime DateTimeExpressionArg
  unit     TemporalExtractUnit
  mode     (optional ExtractWeekMode)) ;; only for get-week

only for get-week

SUGAR CLAUSE: get-year, get-month... clauses are all sugars clause that will be rewritten as [:temporal-extract column :year]

(defclause ^{:requires-features #{:temporal-extract}} ^:sugar get-year
  date DateTimeExpressionArg)
(defclause ^{:requires-features #{:temporal-extract}} ^:sugar get-quarter
  date DateTimeExpressionArg)
(defclause ^{:requires-features #{:temporal-extract}} ^:sugar get-month
  date DateTimeExpressionArg)
(defclause ^{:requires-features #{:temporal-extract}} ^:sugar get-week
  date DateTimeExpressionArg
  mode (optional ExtractWeekMode))
(defclause ^{:requires-features #{:temporal-extract}} ^:sugar get-day
  date DateTimeExpressionArg)
(defclause ^{:requires-features #{:temporal-extract}} ^:sugar get-day-of-week
  date DateTimeExpressionArg)
(defclause ^{:requires-features #{:temporal-extract}} ^:sugar get-hour
  datetime DateTimeExpressionArg)
(defclause ^{:requires-features #{:temporal-extract}} ^:sugar get-minute
  datetime DateTimeExpressionArg)
(defclause ^{:requires-features #{:temporal-extract}} ^:sugar get-second
  datetime DateTimeExpressionArg)
(defclause ^{:requires-features #{:convert-timezone}} convert-timezone
  datetime DateTimeExpressionArg
  to       TimezoneId
  from     (optional TimezoneId))
(def ^:private ArithmeticDateTimeUnit
  [:enum {:error/message "datetime arithmetic unit"} :millisecond :second :minute :hour :day :week :month :quarter :year])
(defclause ^{:requires-features #{:date-arithmetics}} datetime-add
  datetime DateTimeExpressionArg
  amount   NumericExpressionArg
  unit     ArithmeticDateTimeUnit)
(defclause ^{:requires-features #{:now}} now)
(defclause ^{:requires-features #{:date-arithmetics}} datetime-subtract
  datetime DateTimeExpressionArg
  amount   NumericExpressionArg
  unit     ArithmeticDateTimeUnit)
(mr/def ::DatetimeExpression
  (one-of + datetime-add datetime-subtract convert-timezone now))

----------------------------------------------------- Filter -----------------------------------------------------

Schema for a valid MBQL :filter clause.

(def Filter
  [:ref ::Filter])
(defclause and
  first-clause  Filter
  second-clause Filter
  other-clauses (rest Filter))
(defclause or
  first-clause  Filter
  second-clause Filter
  other-clauses (rest Filter))
(defclause not, clause Filter)
(def ^:private FieldOrExpressionRefOrRelativeDatetime
  [:multi
   {:error/message ":field or :expression reference or :relative-datetime"
    :error/fn      (constantly ":field or :expression reference or :relative-datetime")
    :dispatch      (fn [x]
                     (if (is-clause? :relative-datetime x)
                       :relative-datetime
                       :else))}
   [:relative-datetime relative-datetime]
   [:else              Field]])
(mr/def ::EqualityComparable
  [:maybe
   {:error/message "equality comparable"}
   [:or
    :boolean
    number?
    :string
    TemporalLiteral
    FieldOrExpressionRefOrRelativeDatetime
    ExpressionArg
    value]])

Schema for things that make sense in a = or != filter, i.e. things that can be compared for equality.

(def ^:private EqualityComparable
  [:ref ::EqualityComparable])
(mr/def ::OrderComparable
  [:multi
   {:error/message "order comparable"
    :dispatch      (fn [x]
                     (if (is-clause? :value x)
                       :value
                       :else))}
   [:value value]
   [:else [:or
           number?
           :string
           TemporalLiteral
           ExpressionArg
           FieldOrExpressionRefOrRelativeDatetime]]])

Schema for things that make sense in a filter like > or <, i.e. things that can be sorted.

(def ^:private OrderComparable
  [:ref ::OrderComparable])

For all of the non-compound Filter clauses below the first arg is an implicit Field ID

These are SORT OF SUGARY, because extra values will automatically be converted a compound clauses. Driver implementations only need to handle the 2-arg forms.

= works like SQL IN with more than 2 args

[:= [:field 1 nil] 2 3] --[DESUGAR]--> [:or [:= [:field 1 nil] 2] [:= [:field 1 nil] 3]]

!= works like SQL NOT IN with more than 2 args

[:!= [:field 1 nil] 2 3] --[DESUGAR]--> [:and [:!= [:field 1 nil] 2] [:!= [:field 1 nil] 3]]

(defclause =,  field EqualityComparable, value-or-field EqualityComparable, more-values-or-fields (rest EqualityComparable))
(defclause !=, field EqualityComparable, value-or-field EqualityComparable, more-values-or-fields (rest EqualityComparable))
(defclause <,  field OrderComparable, value-or-field OrderComparable)
(defclause >,  field OrderComparable, value-or-field OrderComparable)
(defclause <=, field OrderComparable, value-or-field OrderComparable)
(defclause >=, field OrderComparable, value-or-field OrderComparable)

:between is INCLUSIVE just like SQL !!!

(defclause between field OrderComparable, min OrderComparable, max OrderComparable)

SUGAR CLAUSE: This is automatically written as a pair of :between clauses by the :desugar middleware.

(defclause ^:sugar inside
  lat-field OrderComparable
  lon-field OrderComparable
  lat-max   OrderComparable
  lon-min   OrderComparable
  lat-min   OrderComparable
  lon-max   OrderComparable)

SUGAR CLAUSES: These are rewritten as [:= <field> nil] and [:not= <field> nil] respectively

(defclause ^:sugar is-null,  field Field)
(defclause ^:sugar not-null, field Field)

These are rewritten as [:or [:= <field> nil] [:= <field> ""]] and [:and [:not= <field> nil] [:not= <field> ""]]

(defclause ^:sugar is-empty,  field Field)
(defclause ^:sugar not-empty, field Field)
(def ^:private StringFilterOptions
  [:map
   ;; default true
   [:case-sensitive {:optional true} :boolean]])
(defclause starts-with, field StringExpressionArg, string-or-field StringExpressionArg, options (optional StringFilterOptions))
(defclause ends-with,   field StringExpressionArg, string-or-field StringExpressionArg, options (optional StringFilterOptions))
(defclause contains,    field StringExpressionArg, string-or-field StringExpressionArg, options (optional StringFilterOptions))

SUGAR: this is rewritten as [:not [:contains ...]]

(defclause ^:sugar does-not-contain
  field StringExpressionArg, string-or-field StringExpressionArg, options (optional StringFilterOptions))
(def ^:private TimeIntervalOptions
  ;; Should we include partial results for the current day/month/etc? Defaults to `false`; set this to `true` to
  ;; include them.
  [:map
   ;; default false
   [:include-current {:optional true} :boolean]])

Filter subclause. Syntactic sugar for specifying a specific time interval.

Return rows where datetime Field 100's value is in the current month

[:time-interval [:field 100 nil] :current :month]

Return rows where datetime Field 100's value is in the current month, including partial results for the current day

[:time-interval [:field 100 nil] :current :month {:include-current true}]

SUGAR: This is automatically rewritten as a filter clause with a relative-datetime value

(defclause ^:sugar time-interval
  field   Field
  n       [:or
           :int
           [:enum :current :last :next]]
  unit    RelativeDatetimeUnit
  options (optional TimeIntervalOptions))

A segment is a special macro that saves some pre-definied filter clause, e.g. [:segment 1] this gets replaced by a normal Filter clause in MBQL macroexpansion

It can also be used for GA, which looks something like [:segment "gaid::-11"]. GA segments aren't actually MBQL segments and pass-thru to GA.

(def ^:private SegmentID
  [:ref ::lib.schema.id/segment])
(defclause ^:sugar segment
  segment-id [:or SegmentID NonBlankString])
(mr/def ::BooleanExpression
  (one-of and or not < <= > >= = !=))
(mr/def ::Filter
  [:multi
   {:error/message "valid filter expression"
    :dispatch      (fn [x]
                     (cond
                       (is-clause? datetime-functions x) :datetime
                       (is-clause? numeric-functions x)  :numeric
                       (is-clause? string-functions x)   :string
                       (is-clause? boolean-functions x)  :boolean
                       :else                             :else))}
   [:datetime DatetimeExpression]
   [:numeric  NumericExpression]
   [:string   StringExpression]
   [:boolean  BooleanExpression]
   [:else    (one-of
              ;; filters drivers must implement
              and or not = != < > <= >= between starts-with ends-with contains
              ;; SUGAR filters drivers do not need to implement
              does-not-contain inside is-empty not-empty is-null not-null time-interval segment)]])
(def ^:private CaseClause
  [:tuple {:error/message ":case subclause"} Filter ExpressionArg])
(def ^:private CaseClauses
  [:maybe [:sequential CaseClause]])
(def ^:private CaseOptions
  [:map
   {:error/message ":case options"}
   [:default {:optional true} ExpressionArg]])
(defclause ^{:requires-features #{:basic-aggregations}} case
  clauses CaseClauses, options (optional CaseOptions))
(mr/def ::NumericExpression
  (one-of + - / * coalesce length floor ceil round abs power sqrt exp log case datetime-diff
          temporal-extract get-year get-quarter get-month get-week get-day get-day-of-week
          get-hour get-minute get-second))
(mr/def ::StringExpression
  (one-of substring trim ltrim rtrim replace lower upper concat regex-match-first coalesce case))

Schema for anything that is accepted as a top-level expression definition, either an arithmetic expression such as a :+ clause or a :field clause.

(def FieldOrExpressionDef
  [:multi
   {:error/message ":field or :expression reference or expression"
    :dispatch      (fn [x]
                     (cond
                       (is-clause? numeric-functions x)  :numeric
                       (is-clause? string-functions x)   :string
                       (is-clause? boolean-functions x)  :boolean
                       (is-clause? datetime-functions x) :datetime
                       (is-clause? :case x)              :case
                       :else                             :else))}
   [:numeric  NumericExpression]
   [:string   StringExpression]
   [:boolean  BooleanExpression]
   [:datetime DatetimeExpression]
   [:case     case]
   [:else     Field]])

-------------------------------------------------- Aggregations --------------------------------------------------

For all of the 'normal' Aggregations below (excluding Metrics) fields are implicit Field IDs

cum-sum and cum-count are SUGAR because they're implemented in middleware. The clauses are swapped out with count and sum aggregations respectively and summation is done in Clojure-land

(defclause ^{:requires-features #{:basic-aggregations}} ^:sugar count,     field (optional Field))
(defclause ^{:requires-features #{:basic-aggregations}} ^:sugar cum-count, field (optional Field))

technically aggregations besides count can also accept expressions as args, e.g.

[[:sum [:+ [:field 1 nil] [:field 2 nil]]]]

Which is equivalent to SQL:

SUM(field1 + field2)

(defclause ^{:requires-features #{:basic-aggregations}} avg,      field-or-expression FieldOrExpressionDef)
(defclause ^{:requires-features #{:basic-aggregations}} cum-sum,  field-or-expression FieldOrExpressionDef)
(defclause ^{:requires-features #{:basic-aggregations}} distinct, field-or-expression FieldOrExpressionDef)
(defclause ^{:requires-features #{:basic-aggregations}} sum,      field-or-expression FieldOrExpressionDef)
(defclause ^{:requires-features #{:basic-aggregations}} min,      field-or-expression FieldOrExpressionDef)
(defclause ^{:requires-features #{:basic-aggregations}} max,      field-or-expression FieldOrExpressionDef)
(defclause ^{:requires-features #{:basic-aggregations}} sum-where
  field-or-expression FieldOrExpressionDef, pred Filter)
(defclause ^{:requires-features #{:basic-aggregations}} count-where
  pred Filter)
(defclause ^{:requires-features #{:basic-aggregations}} share
  pred Filter)
(defclause ^{:requires-features #{:standard-deviation-aggregations}} stddev
  field-or-expression FieldOrExpressionDef)
(defclause ^{:requires-features #{:standard-deviation-aggregations}} [ag:var var]
  field-or-expression FieldOrExpressionDef)
(defclause ^{:requires-features #{:percentile-aggregations}} median
  field-or-expression FieldOrExpressionDef)
(defclause ^{:requires-features #{:percentile-aggregations}} percentile
  field-or-expression FieldOrExpressionDef, percentile NumericExpressionArg)

Metrics are just 'macros' (placeholders for other aggregations with optional filter and breakout clauses) that get expanded to other aggregations/etc. in the expand-macros middleware

METRICS WITH STRING IDS, e.g. [:metric "ga:sessions"], are Google Analytics metrics, not Metabase metrics! They pass straight thru to the GA query processor.

(def ^:private MetricID
  [:ref ::lib.schema.id/metric])
(defclause metric
  metric-id [:or MetricID NonBlankString])

the following are definitions for expression aggregations, e.g.

[:+ [:sum [:field 10 nil]] [:sum [:field 20 nil]]]

(mr/def ::UnnamedAggregation
  [:multi
   {:error/message "unnamed aggregation clause or numeric expression"
    :dispatch      (fn [x]
                     (if (is-clause? numeric-functions x)
                       :numeric-expression
                       :else))}
   [:numeric-expression NumericExpression]
   [:else (one-of avg cum-sum distinct stddev sum min max metric share count-where
                  sum-where case median percentile ag:var
                  ;; SUGAR clauses
                  cum-count count)]])
(def ^:private UnnamedAggregation
  ::UnnamedAggregation)

Additional options for any aggregation clause when wrapping it in :aggregation-options.

(def ^:private AggregationOptions
  [:map
   {:error/message ":aggregation-options options"}
   ;; name to use for this aggregation in the native query instead of the default name (e.g. `count`)
   [:name         {:optional true} NonBlankString]
   ;; user-facing display name for this aggregation instead of the default one
   [:display-name {:optional true} NonBlankString]])
(defclause aggregation-options
  aggregation UnnamedAggregation
  options     AggregationOptions)
(mr/def ::Aggregation
  [:multi
   {:error/message "aggregation clause or numeric expression"
    :dispatch      (fn [x]
                     (if (is-clause? :aggregation-options x)
                       :aggregation-options
                       :unnamed-aggregation))}
   [:aggregation-options aggregation-options]
   [:unnamed-aggregation UnnamedAggregation]])

---------------------------------------------------- Order-By ----------------------------------------------------

order-by is just a series of [<direction> <field>] clauses like

{:order-by [[:asc [:field 1 nil]], [:desc [:field 2 nil]]]}

Field ID is implicit in these clauses

(defclause asc,  field Reference)
(defclause desc, field Reference)

Schema for an order-by clause subclause.

(def OrderBy
  (one-of asc desc))

+----------------------------------------------------------------------------------------------------------------+ | Queries | +----------------------------------------------------------------------------------------------------------------+

---------------------------------------------- Native [Inner] Query ----------------------------------------------

Template tags are used to specify {{placeholders}} in native queries that are replaced with some sort of value when the query itself runs. There are four basic types of template tag for native queries:

  1. Field filters, which are used like

    SELECT * FROM table WHERE {{field_filter}}

    These reference specific Fields and are replaced with entire conditions, e.g. some_field > 1000

  2. Raw values, which are used like

    SELECT * FROM table WHERE my_field = {{x}}

    These are replaced with raw values.

  3. Native query snippets, which might be used like

    SELECT * FROM ({{snippet: orders}}) source

    These are replaced with NativeQuerySnippets from the application database.

  4. Source query Card IDs, which are used like

    SELECT * FROM ({{#123}}) source

    These are replaced with the query from the Card with that ID.

Field filters and raw values usually have their value specified by :parameters (see [[Parameters]] below).

Schema for valid values of template tag :type.

(def ^:private TemplateTagType
  [:enum :snippet :card :dimension :number :text :date])
(def ^:private TemplateTag:Common
  "Things required by all template tag types."
  [:map
   [:type         TemplateTagType]
   [:name         NonBlankString]
   [:display-name NonBlankString]
   ;; TODO -- `:id` is actually 100% required but we have a lot of tests that don't specify it because this constraint
   ;; wasn't previously enforced; we need to go in and fix those tests and make this non-optional
   [:id {:optional true} NonBlankString]])

Example:

{:id "c2fc7310-44eb-4f21-c3a0-63806ffb7ddd" :name "snippet: select" :display-name "Snippet: select" :type :snippet :snippet-name "select" :snippet-id 1}

(def ^:private TemplateTag:Snippet
  "Schema for a native query snippet template tag."
  [:merge
   TemplateTag:Common
   [:map
    [:type         [:= :snippet]]
    [:snippet-name NonBlankString]
    [:snippet-id   PositiveInt]
    ;; database to which this Snippet belongs. Doesn't always seen to be specified.
    [:database {:optional true} PositiveInt]]])

Example:

{:id "fc5e14d9-7d14-67af-66b2-b2a6e25afeaf" :name "#1635" :display-name "#1635" :type :card :card-id 1635}

(def ^:private TemplateTag:SourceQuery
  "Schema for a source query template tag."
  [:merge
   TemplateTag:Common
   [:map
    [:type    [:= :card]]
    [:card-id PositiveInt]]])
(def ^:private TemplateTag:Value:Common
  "Stuff shared between the Field filter and raw value template tag schemas."
  [:merge
   TemplateTag:Common
   [:map
    ;; default value for this parameter
    [:default  {:optional true} :any]
    ;; whether or not a value for this parameter is required in order to run the query
    [:required {:optional true} :boolean]]])

Schema for valid values of :type for a [[Parameter]].

(def ^:private ParameterType
  [:ref ::ParameterType])

Schema for valid values of :widget-type for a [[TemplateTag:FieldFilter]].

(def ^:private WidgetType
  [:ref ::WidgetType])

Example:

{:id "c20851c7-8a80-0ffa-8a99-ae636f0e9539" :name "date" :display-name "Date" :type :dimension, :dimension [:field 4 nil] :widget-type :date/all-options}

(def ^:private TemplateTag:FieldFilter
  "Schema for a field filter template tag."
  [:merge
   TemplateTag:Value:Common
   [:map
    [:type        [:= :dimension]]
    [:dimension   field]
    ;; which type of widget the frontend should show for this Field Filter; this also affects which parameter types
    ;; are allowed to be specified for it.
    [:widget-type WidgetType]
    ;; optional map to be appended to filter clause
    [:options {:optional true} [:map-of :keyword :any]]]])

Set of valid values of :type for raw value template tags.

(def raw-value-template-tag-types
  #{:number :text :date :boolean})
(def ^:private TemplateTag:RawValue:Type
  "Valid values of `:type` for raw value template tags."
  (into [:enum] raw-value-template-tag-types))

Example:

{:id "35f1ecd4-d622-6d14-54be-750c498043cb" :name "id" :display-name "Id" :type :number :required true :default "1"}

(def ^:private TemplateTag:RawValue
  "Schema for a raw value template tag."
  [:merge
   TemplateTag:Value:Common
   ;; `:type` is used be the FE to determine which type of widget to display for the template tag, and to determine
   ;; which types of parameters are allowed to be passed in for this template tag.
   [:map
    [:type TemplateTag:RawValue:Type]]])

TODO -- if we were using core.spec here I would make this a multimethod-based spec instead and have it dispatch off of :type. Then we could make it possible to add new types dynamically

(mr/def ::TemplateTag
  [:multi
   {:dispatch :type}
   [:dimension   TemplateTag:FieldFilter]
   [:snippet     TemplateTag:Snippet]
   [:card        TemplateTag:SourceQuery]
   [::mc/default TemplateTag:RawValue]])

Schema for a template tag as specified in a native query. There are four types of template tags, differentiated by :type (see comments above).

(def TemplateTag
  [:ref ::TemplateTag])

Schema for the :template-tags map passed in as part of a native query.

(def ^:private TemplateTagMap
  ;; map of template tag name -> template tag definition
  [:and
   [:map-of NonBlankString TemplateTag]
   ;; make sure people don't try to pass in a `:name` that's different from the actual key in the map.
   [:fn
    {:error/message "keys in template tag map must match the :name of their values"}
    (fn [m]
      (every? (fn [[tag-name tag-definition]]
                (core/= tag-name (:name tag-definition)))
              m))]])
(def ^:private NativeQuery:Common
  [:map
   [:template-tags {:optional true} TemplateTagMap]
   ;; collection (table) this query should run against. Needed for MongoDB
   [:collection    {:optional true} [:maybe NonBlankString]]])

Schema for a valid, normalized native [inner] query.

(def NativeQuery
  [:merge
   NativeQuery:Common
   [:map
    [:query :any]]])
(def ^:private NativeSourceQuery
  [:merge
   NativeQuery:Common
   [:map
    [:native :any]]])

----------------------------------------------- MBQL [Inner] Query -----------------------------------------------

Schema for a valid, normalized MBQL [inner] query.

(def MBQLQuery
  [:ref ::MBQLQuery])

Schema for a valid value for a :source-query clause.

(def SourceQuery
  [:multi
   {:dispatch (fn [x]
                (if ((every-pred map? :native) x)
                  :native
                  :mbql))}
   ;; when using native queries as source queries the schema is exactly the same except use `:native` in place of
   ;; `:query` for reasons I do not fully remember (perhaps to make it easier to differentiate them from MBQL source
   ;; queries).
   [:native NativeSourceQuery]
   [:mbql   MBQLQuery]])

Schema for the expected keys for a single column in :source-metadata (:source-metadata is a sequence of these entries), if it is passed in to the query.

This metadata automatically gets added for all source queries that are referenced via the card__id :source-table form; for explicit :source-querys you should usually include this information yourself when specifying explicit :source-querys.

(def SourceQueryMetadata
  ;; TODO - there is a very similar schema in `metabase.sync.analyze.query-results`; see if we can merge them
  [:map
   [:name         NonBlankString]
   [:base_type    BaseType]
   ;; this is only used by the annotate post-processing stage, not really needed at all for pre-processing, might be
   ;; able to remove this as a requirement
   [:display_name NonBlankString]
   [:semantic_type {:optional true} [:maybe SemanticOrRelationType]]
   ;; you'll need to provide this in order to use BINNING
   [:fingerprint   {:optional true} [:maybe :map]]])

Pattern that matches card__id strings that can be used as the :source-table of MBQL queries.

(def source-table-card-id-regex
  #"^card__[1-9]\d*$")

Schema for a valid value for the :source-table clause of an MBQL query.

(def ^:private SourceTable
  [:or
   TableID
   [:re
    {:error/message "'card__<id>' string Table ID"}
    source-table-card-id-regex]])

Valid values of the :strategy key in a join map.

(def join-strategies
  #{:left-join :right-join :inner-join :full-join})

Strategy that should be used to perform the equivalent of a SQL JOIN against another table or a nested query. These correspond 1:1 to features of the same name in driver features lists; e.g. you should check that the current driver supports :full-join before generating a Join clause using that strategy.

(def ^:private JoinStrategy
  (into [:enum] join-strategies))

Schema for valid values of the MBQL :fields clause.

(def Fields
  [:ref ::Fields])
(def ^:private JoinFields
  [:or
   {:error/message "Valid join `:fields`: `:all`, `:none`, or a sequence of `:field` clauses that have `:join-alias`."}
   [:enum :all :none]
   Fields])
(mr/def ::Join
  [:and
   [:map
    ;; *What* to JOIN. Self-joins can be done by using the same `:source-table` as in the query where this is specified.
    ;; YOU MUST SUPPLY EITHER `:source-table` OR `:source-query`, BUT NOT BOTH!
    [:source-table {:optional true} SourceTable]

    [:source-query {:optional true} SourceQuery]
    ;;
    ;; The condition on which to JOIN. Can be anything that is a valid `:filter` clause. For automatically-generated
    ;; JOINs this is always
    ;;
    ;;    [:= <source-table-fk-field> [:field <dest-table-pk-field> {:join-alias <join-table-alias>}]]
    ;;
    [:condition Filter]
    ;;
    ;; Defaults to `:left-join`; used for all automatically-generated JOINs
    ;;
    ;; Driver implementations: this is guaranteed to be present after pre-processing.
    [:strategy {:optional true} JoinStrategy]
    ;;
    ;; The Field to include in the results *if* a top-level `:fields` clause *is not* specified. This can be either
    ;; `:none`, `:all`, or a sequence of Field clauses.
    ;;
    ;; * `:none`: no Fields from the joined table or nested query are included (unless indirectly included by
    ;;    breakouts or other clauses). This is the default, and what is used for automatically-generated joins.
    ;;
    ;; *  `:all`: will include all of the Field from the joined table or query
    ;;
    ;; * a sequence of Field clauses: include only the Fields specified. Valid clauses are the same as the top-level
    ;;   `:fields` clause. This should be non-empty and all elements should be distinct. The normalizer will
    ;;   automatically remove duplicate fields for you, and replace empty clauses with `:none`.
    ;;
    ;; Driver implementations: you can ignore this clause. Relevant fields will be added to top-level `:fields` clause
    ;; with appropriate aliases.
    [:fields {:optional true} JoinFields]
    ;;
    ;; The name used to alias the joined table or query. This is usually generated automatically and generally looks
    ;; like `table__via__field`. You can specify this yourself if you need to reference a joined field with a
    ;; `:join-alias` in the options.
    ;;
    ;; Driver implementations: This is guaranteed to be present after pre-processing.
    [:alias {:optional true} NonBlankString]
    ;;
    ;; Used internally, only for annotation purposes in post-processing. When a join is implicitly generated via a
    ;; `:field` clause with `:source-field`, the ID of the foreign key field in the source Table will
    ;; be recorded here. This information is used to add `fk_field_id` information to the `:cols` in the query
    ;; results; I believe this is used to facilitate drill-thru? :shrug:
    ;;
    ;; Don't set this information yourself. It will have no effect.
    [:fk-field-id {:optional true} [:maybe FieldID]]
    ;;
    ;; Metadata about the source query being used, if pulled in from a Card via the `:source-table "card__id"` syntax.
    ;; added automatically by the `resolve-card-id-source-tables` middleware.
    [:source-metadata {:optional true} [:maybe [:sequential SourceQueryMetadata]]]]
   [:fn
    {:error/message "Joins must have either a `source-table` or `source-query`, but not both."}
    (every-pred
     (some-fn :source-table :source-query)
     (complement (every-pred :source-table :source-query)))]])

Perform the equivalent of a SQL JOIN with another Table or nested :source-query. JOINs are either explicitly specified in the incoming query, or implicitly generated when one uses a :field clause with :source-field.

In the top-level query, you can reference Fields from the joined table or nested query by including :source-field in the :field options (known as implicit joins); for explicit joins, you must specify :join-alias yourself; in the :field options, e.g.

;; for joins against other Tables/MBQL source queries [:field 1 {:join-alias "myjoinalias"}]

;; for joins against native queries [:field "myfield" {:base-type :field/Integer, :join-alias "myjoin_alias"}]

(def Join
  [:ref ::Join])
(mr/def ::Joins
  [:and
   (helpers/non-empty [:sequential Join])
   [:fn
    {:error/message "All join aliases must be unique."}
    #(helpers/empty-or-distinct? (filter some? (map :alias %)))]])

Schema for a valid sequence of Joins. Must be a non-empty sequence, and :alias, if specified, must be unique.

(def ^:private Joins
  [:ref ::Joins])
(mr/def ::Fields
  [:schema
   {:error/message "Distinct, non-empty sequence of Field clauses"}
   (helpers/distinct [:sequential {:min 1} Field])])
(def ^:private Page
  [:map
   [:page  PositiveInt]
   [:items PositiveInt]])
(mr/def ::MBQLQuery
  [:and
   [:map
    [:source-query    {:optional true} SourceQuery]
    [:source-table    {:optional true} SourceTable]
    [:aggregation     {:optional true} [:sequential {:min 1} Aggregation]]
    [:breakout        {:optional true} [:sequential {:min 1} Field]]
    [:expressions     {:optional true} [:map-of NonBlankString FieldOrExpressionDef]]
    [:fields          {:optional true} Fields]
    [:filter          {:optional true} Filter]
    [:limit           {:optional true} IntGreaterThanOrEqualToZero]
    [:order-by        {:optional true} (helpers/distinct [:sequential {:min 1} OrderBy])]
    ;; page = page num, starting with 1. items = number of items per page.
    ;; e.g.
    ;; {:page 1, :items 10} = items 1-10
    ;; {:page 2, :items 10} = items 11-20
    [:page            {:optional true} Page]
    ;;
    ;; Various bits of middleware add additonal keys, such as `fields-is-implicit?`, to record bits of state or pass
    ;; info to other pieces of middleware. Everyone else can ignore them.
    [:joins           {:optional true} Joins]
    ;;
    ;; Info about the columns of the source query. Added in automatically by middleware. This metadata is primarily
    ;; used to let power things like binning when used with Field Literals instead of normal Fields
    [:source-metadata {:optional true} [:maybe [:sequential SourceQueryMetadata]]]]
   ;;
   ;; CONSTRAINTS
   ;;
   [:fn
    {:error/message "Query must specify either `:source-table` or `:source-query`, but not both."}
    (fn [query]
      (core/= 1 (core/count (select-keys query [:source-query :source-table]))))]
   [:fn
    {:error/message "Fields specified in `:breakout` should not be specified in `:fields`; this is implied."}
    (fn [{:keys [breakout fields]}]
      (empty? (set/intersection (set breakout) (set fields))))]])

----------------------------------------------------- Params -----------------------------------------------------

:parameters specify the values of parameters previously definied for a Dashboard or Card (native query template tag parameters.) See [[TemplateTag]] above for more information on the later.

There are three things called 'type' in play when we talk about parameters and template tags.

Two are used when the parameters are specified/declared, in a [[TemplateTag]] or in a Dashboard parameter:

  1. Dashboard parameter/template tag :type -- :dimension (for a Field filter parameter), otherwise :text, :number, :boolean, or :date

  2. :widget-type -- only specified for Field filter parameters (where type is :dimension). This tells the FE what type of widget to display, and also tells us what types of parameters we should allow. Examples: :date/all-options, :category, etc.

One type is used in the [[Parameter]] list (:parameters):

  1. Parameter :type -- specifies the type of the value being passed in. e.g. :text or :string/!=

Note that some types that makes sense as widget types (e.g. :date/all-options) but not as actual value types are currently still allowed for backwards-compatibility purposes -- currently the FE client will just parrot back the :widget-type in some cases. In these cases, the backend is just supposed to infer the actual type of the parameter value.

Map of parameter-type -> info. Info is a map with the following keys:

`:type`

The general type of this parameter. :numeric, :string, :boolean, or :date, if applicable. Some parameter types like :id and :category don't have a particular :type. This is offered mostly so we can group stuff together or determine things like whether a given parameter is a date parameter.

`:operator`

Signifies this is one of the new 'operator' parameter types added in 0.39.0 or so. These parameters can only be used for [[TemplateTag:FieldFilter]]s or for Dashboard parameters mapped to MBQL queries. The value of this key is the arity for the parameter, either :unary, :binary, or :variadic. See the [[metabase.driver.common.parameters.operators]] namespace for more information.

`:allowed-for`

[[Parameter]]s with this :type may be supplied for [[TemplateTag]]s with these :types (or :widget-type if :type is :dimension) types. Example: it is ok to pass a parameter of type :date/range for template tag with :widget-type :date/all-options; but it is NOT ok to pass a parameter of type :date/range for a template tag with a widget type :date. Why? It's a potential security risk if someone creates a Card with an "exact-match" Field filter like :date or :text and you pass in a parameter like string/!= NOTHING_WILL_MATCH_THIS. Non-exact-match parameters can be abused to enumerate all the rows in a table when the parameter was supposed to lock the results down to a single row or set of rows.

(def parameter-types
  {;; the basic raw-value types. These can be used with [[TemplateTag:RawValue]] template tags as well as
   ;; [[TemplateTag:FieldFilter]] template tags.
   :number  {:type :numeric, :allowed-for #{:number :number/= :id :category :location/zip_code}}
   :text    {:type :string,  :allowed-for #{:text :string/= :id :category
                                            :location/city :location/state :location/zip_code :location/country}}
   :date    {:type :date,    :allowed-for #{:date :date/single :date/all-options :id :category}}
   ;; I don't think `:boolean` is actually used on the FE at all.
   :boolean {:type :boolean, :allowed-for #{:boolean :id :category}}
   ;; as far as I can tell this is basically just an alias for `:date`... I'm not sure what the difference is TBH
   :date/single {:type :date, :allowed-for #{:date :date/single :date/all-options :id :category}}
   ;; everything else can't be used with raw value template tags -- they can only be used with Dashboard parameters
   ;; for MBQL queries or Field filters in native queries
   ;; `:id` and `:category` conceptually aren't types in a "the parameter value is of this type" sense, but they are
   ;; widget types. They have something to do with telling the frontend to show FieldValues list/search widgets or
   ;; something like that.
   ;;
   ;; Apparently the frontend might still pass in parameters with these types, in which case we're supposed to infer
   ;; the actual type of the parameter based on the Field we're filtering on. Or something like that. Parameters with
   ;; these types are only allowed if the widget type matches exactly, but you can also pass in something like a
   ;; `:number/=` for a parameter with widget type `:category`.
   ;;
   ;; TODO FIXME -- actually, it turns out the the FE client passes parameter type `:category` for parameters in
   ;; public Cards. Who knows why! For now, we'll continue allowing it. But we should fix it soon. See
   ;; [[metabase.api.public-test/execute-public-card-with-parameters-test]]
   :id       {:allowed-for #{:id}}
   :category {:allowed-for #{:category #_FIXME :number :text :date :boolean}}
   ;; Like `:id` and `:category`, the `:location/*` types are primarily widget types. They don't really have a meaning
   ;; as a parameter type, so in an ideal world they wouldn't be allowed; however it seems like the FE still passed
   ;; these in as parameter type on occasion anyway. In this case the backend is just supposed to infer the actual
   ;; type -- which should be `:text` and, in the case of ZIP code, possibly `:number`.
   ;;
   ;; As with `:id` and `:category`, it would be preferable to just pass in a parameter with type `:text` or `:number`
   ;; for these widget types, but for compatibility we'll allow them to continue to be used as parameter types for the
   ;; time being. We'll only allow that if the widget type matches exactly, however.
   :location/city     {:allowed-for #{:location/city}}
   :location/state    {:allowed-for #{:location/state}}
   :location/zip_code {:allowed-for #{:location/zip_code}}
   :location/country  {:allowed-for #{:location/country}}
   ;; date range types -- these match a range of dates
   :date/range        {:type :date, :allowed-for #{:date/range :date/all-options}}
   :date/month-year   {:type :date, :allowed-for #{:date/month-year :date/all-options}}
   :date/quarter-year {:type :date, :allowed-for #{:date/quarter-year :date/all-options}}
   :date/relative     {:type :date, :allowed-for #{:date/relative :date/all-options}}
   ;; Like `:id` and `:category` above, `:date/all-options` is primarily a widget type. It means that we should allow
   ;; any date option above.
   :date/all-options {:type :date, :allowed-for #{:date/all-options}}
   ;; "operator" parameter types.
   :number/!=               {:type :numeric, :operator :variadic, :allowed-for #{:number/!=}}
   :number/<=               {:type :numeric, :operator :unary, :allowed-for #{:number/<=}}
   :number/=                {:type :numeric, :operator :variadic, :allowed-for #{:number/= :number :id :category
                                                                                 :location/zip_code}}
   :number/>=               {:type :numeric, :operator :unary, :allowed-for #{:number/>=}}
   :number/between          {:type :numeric, :operator :binary, :allowed-for #{:number/between}}
   :string/!=               {:type :string, :operator :variadic, :allowed-for #{:string/!=}}
   :string/=                {:type :string, :operator :variadic, :allowed-for #{:string/= :text :id :category
                                                                                :location/city :location/state
                                                                                :location/zip_code :location/country}}
   :string/contains         {:type :string, :operator :unary, :allowed-for #{:string/contains}}
   :string/does-not-contain {:type :string, :operator :unary, :allowed-for #{:string/does-not-contain}}
   :string/ends-with        {:type :string, :operator :unary, :allowed-for #{:string/ends-with}}
   :string/starts-with      {:type :string, :operator :unary, :allowed-for #{:string/starts-with}}})
(mr/def ::ParameterType
  (into [:enum {:error/message "valid parameter type"}] (keys parameter-types)))
(mr/def ::WidgetType
  (into [:enum {:error/message "valid template tag widget type"} :none] (keys parameter-types)))

the next few clauses are used for parameter :target... this maps the parameter to an actual template tag in a native query or Field for MBQL queries.

examples:

{:target [:dimension [:template-tag "my_tag"]]} {:target [:dimension [:template-tag {:id "mytagid"}]]} {:target [:variable [:template-tag "another_tag"]]} {:target [:variable [:template-tag {:id "anothertagid"}]]} {:target [:dimension [:field 100 nil]]} {:target [:field 100 nil]}

I'm not 100% clear on which situations we'll get which version. But I think the following is generally true:

  • Things are wrapped in :dimension when we're dealing with Field filter template tags
  • Raw value template tags wrap things in :variable instead
  • Dashboard parameters are passed in with plain Field clause targets.

One more thing to note: apparently :expression... is allowed below as well. I'm not sure how this is actually supposed to work, but we have test #18747 that attempts to set it. I'm not convinced this should actually be allowed.

this is the reference like [:template-tag ], not the [[TemplateTag]] schema for when it's declared in :template-tags

(defclause template-tag
  tag-name [:or
            NonBlankString
            [:map
             [:id NonBlankString]]])
(defclause dimension
  target [:or Field template-tag])
(defclause variable
  target template-tag)

Schema for the value of :target in a [[Parameter]].

(def ^:private ParameterTarget
  ;; not 100% sure about this but `field` on its own comes from a Dashboard parameter and when it's wrapped in
  ;; `dimension` it comes from a Field filter template tag parameter (don't quote me on this -- working theory)
  [:or
   Field
   (one-of dimension variable)])

Schema for the value of a parameter (e.g. a Dashboard parameter or a native query template tag) as passed in as part of the :parameters list in a query.

(def Parameter
  [:map
   [:type ParameterType]
   ;; TODO -- these definitely SHOULD NOT be optional but a ton of tests aren't passing them in like they should be.
   ;; At some point we need to go fix those tests and then make these keys required
   [:id      {:optional true} NonBlankString]
   [:target  {:optional true} ParameterTarget]
   ;; not specified if the param has no value. TODO - make this stricter; type of `:value` should be validated based
   ;; on the [[ParameterType]]
   [:value   {:optional true} :any]
   ;; the name of the parameter we're trying to set -- this is actually required now I think, or at least needs to get
   ;; merged in appropriately
   [:name    {:optional true} NonBlankString]
   ;; The following are not used by the code in this namespace but may or may not be specified depending on what the
   ;; code that constructs the query params is doing. We can go ahead and ignore these when present.
   [:slug    {:optional true} NonBlankString]
   [:default {:optional true} :any]])

Schema for a list of :parameters as passed in to a query.

(def ParameterList
  [:maybe [:sequential Parameter]])

---------------------------------------------------- Options -----------------------------------------------------

Options that tweak the behavior of the query processor.

(def ^:private Settings
  [:map
   ;; The timezone the query should be ran in, overriding the default report timezone for the instance.
   [:report-timezone {:optional true} TimezoneId]])

Additional constraints added to a query limiting the maximum number of rows that can be returned. Mostly useful because native queries don't support the MBQL :limit clause. For MBQL queries, if :limit is set, it will override these values.

(def ^:private Constraints
  [:and
   [:map
    ;; maximum number of results to allow for a query with aggregations. If `max-results-bare-rows` is unset, this
    ;; applies to all queries
    [:max-results           {:optional true} IntGreaterThanOrEqualToZero]
    ;; maximum number of results to allow for a query with no aggregations.
    ;; If set, this should be LOWER than `:max-results`
    [:max-results-bare-rows {:optional true} IntGreaterThanOrEqualToZero]]
   [:fn
    {:error/message "max-results-bare-rows must be less or equal to than max-results"}
    (fn [{:keys [max-results max-results-bare-rows]}]
      (if-not (core/and max-results max-results-bare-rows)
        true
        (core/>= max-results max-results-bare-rows)))]])

Additional options that can be used to toggle middleware on or off.

(def ^:private MiddlewareOptions
  [:map
   ;; should we skip adding results_metadata to query results after running the query? Used by
   ;; [[metabase.query-processor.middleware.results-metadata]]; default `false`
   [:skip-results-metadata? {:optional true} :boolean]
   ;; should we skip converting datetime types to ISO-8601 strings with appropriate timezone when post-processing
   ;; results? Used by [[metabase.query-processor.middleware.format-rows]]; default `false`
   [:format-rows? {:optional true} :boolean]
   ;; disable the MBQL->native middleware. If you do this, the query will not work at all, so there are no cases where
   ;; you should set this yourself. This is only used by the [[metabase.query-processor/preprocess]] function to get
   ;; the fully pre-processed query without attempting to convert it to native.
   [:disable-mbql->native? {:optional true} :boolean]
   ;; Disable applying a default limit on the query results. Handled in the `add-default-limit` middleware.
   ;; If true, this will override the `:max-results` and `:max-results-bare-rows` values in [[Constraints]].
   [:disable-max-results? {:optional true} :boolean]
   ;; Userland queries are ones ran as a result of an API call, Pulse, or the like. Special handling is done in the
   ;; `process-userland-query` middleware for such queries -- results are returned in a slightly different format, and
   ;; QueryExecution entries are normally saved, unless you pass `:no-save` as the option.
   [:userland-query? {:optional true} [:maybe :boolean]]
   ;; Whether to add some default `max-results` and `max-results-bare-rows` constraints. By default, none are added,
   ;; although the functions that ultimately power most API endpoints tend to set this to `true`. See
   ;; `add-constraints` middleware for more details.
   [:add-default-userland-constraints? {:optional true} [:maybe :boolean]]
   ;; Whether to process a question's visualization settings and include them in the result metadata so that they can
   ;; incorporated into an export. Used by `metabase.query-processor.middleware.visualization-settings`; default `false`.
   [:process-viz-settings? {:optional true} [:maybe :boolean]]])

------------------------------------------------------ Info ------------------------------------------------------

This stuff is used for informational purposes, primarily to record QueryExecution entries when a query is ran. Pass them along if applicable when writing code that creates queries, but when working on middleware and the like you can most likely ignore this stuff entirely.

Schema for info.context; used for informational purposes to record how a query was executed.

(def Context
  [:enum
   :action
   :ad-hoc
   :collection
   :map-tiles
   :pulse
   :dashboard
   :question
   :csv-download
   :xlsx-download
   :json-download
   :public-dashboard
   :public-question
   :embedded-dashboard
   :embedded-question
   :embedded-csv-download
   :embedded-xlsx-download
   :embedded-json-download])
(def ^:private Hash
  #?(:clj bytes?
     :cljs :any))

Schema for query :info dictionary, which is used for informational purposes to record information about how a query was executed in QueryExecution and other places. It is considered bad form for middleware to change its behavior based on this information, don't do it!

TODO - this schema is somewhat misleading because if you use a function like qp/process-query-and-save-with-max-results-constraints! some of these keys (e.g. :context) are in fact required

(def ^:private Info
  [:map
   ;; These keys are nice to pass in if you're running queries on the backend and you know these values. They aren't
   ;; used for permissions checking or anything like that so don't try to be sneaky
   [:context                   {:optional true} [:maybe Context]]
   [:executed-by               {:optional true} [:maybe PositiveInt]]
   [:action-id                 {:optional true} [:maybe PositiveInt]]
   [:card-id                   {:optional true} [:maybe CardID]]
   [:card-name                 {:optional true} [:maybe NonBlankString]]
   [:dashboard-id              {:optional true} [:maybe PositiveInt]]
   [:alias/escaped->original   {:optional true} [:maybe [:map-of :any :any]]]
   [:pulse-id                  {:optional true} [:maybe PositiveInt]]
   ;; Metadata for datasets when querying the dataset. This ensures that user edits to dataset metadata are blended in
   ;; with runtime computed metadata so that edits are saved.
   [:metadata/dataset-metadata {:optional true} [:maybe [:sequential [:map-of :any :any]]]]
   ;; `:hash` gets added automatically by `process-query-and-save-execution!`, so don't try passing
   ;; these in yourself. In fact, I would like this a lot better if we could take these keys out of `:info` entirely
   ;; and have the code that saves QueryExceutions figure out their values when it goes to save them
   [:query-hash                {:optional true} [:maybe Hash]]])

--------------------------------------------- Metabase [Outer] Query ---------------------------------------------

The ID used to signify that a database is 'virtual' rather than physical.

A fake integer ID is used so as to minimize the number of changes that need to be made on the frontend -- by using something that would otherwise be a legal ID, nothing need change there, and the frontend can query against this 'database' none the wiser. (This integer ID is negative which means it will never conflict with a real database ID.)

This ID acts as a sort of flag. The relevant places in the middleware can check whether the DB we're querying is this 'virtual' database and take the appropriate actions.

(def saved-questions-virtual-database-id
  lib.schema.id/saved-questions-virtual-database-id)

To the reader: yes, this seems sort of hacky, but one of the goals of the Nested Query Initiative™ was to minimize if not completely eliminate any changes to the frontend. After experimenting with several possible ways to do this implementation seemed simplest and best met the goal. Luckily this is the only place this "magic number" is defined and the entire frontend can remain blissfully unaware of its value.

Schema for a valid :database ID, in the top-level 'outer' query. Either a positive integer (referring to an actual Database), or the saved questions virtual ID, which is a placeholder used for queries using the :source-table "card__id" shorthand for a source query resolved by middleware (since clients might not know the actual DB for that source query.)

(def DatabaseID
  [:or
   {:error/message "valid Database ID"}
   [:ref ::lib.schema.id/saved-questions-virtual-database]
   [:ref ::lib.schema.id/database]])

Make sure we have the combo of query :type and :native/:query

(defn- check-keys-for-query-type
  [schema]
  [:and
   schema
   [:fn
    {:error/message "Query must specify either `:native` or `:query`, but not both."}
    (every-pred
     (some-fn :native :query)
     (complement (every-pred :native :query)))]
   [:fn
    {:error/message "Native queries must specify `:native`; MBQL queries must specify `:query`."}
    (fn [{native :native, mbql :query, query-type :type}]
      (core/case query-type
        :native native
        :query  mbql))]])

:source-metadata is added to queries when card__id source queries are resolved. It contains info about the columns in the source query.

Where this is added was changed in Metabase 0.33.0 -- previously, when card__id source queries were resolved, the middleware would add :source-metadata to the top-level; to support joins against source queries, this has been changed so it is always added at the same level the resolved :source-query is added.

This should automatically be fixed by normalize; if we encounter it, it means some middleware is not functioning properly.

(defn- check-query-does-not-have-source-metadata
  [schema]
  [:and
   schema
   [:fn
    {:error/message "`:source-metadata` should be added in the same level as `:source-query` (i.e., the 'inner' MBQL query.)"}
    (complement :source-metadata)]])

Schema for an [outer] query, e.g. the sort of thing you'd pass to the query processor or save in Card.dataset_query.

(def Query
  [:ref ::Query])
(mr/def ::Query
  (-> [:map
       [:database DatabaseID]
       ;; Type of query. `:query` = MBQL; `:native` = native. TODO - consider normalizing `:query` to `:mbql`
       [:type [:enum :query :native]]
       [:native     {:optional true} NativeQuery]
       [:query      {:optional true} MBQLQuery]
       [:parameters {:optional true} ParameterList]
       ;;
       ;; OPTIONS
       ;;
       ;; These keys are used to tweak behavior of the Query Processor.
       ;; TODO - can we combine these all into a single `:options` map?
       ;;
       [:settings    {:optional true} [:maybe Settings]]
       [:constraints {:optional true} [:maybe Constraints]]
       [:middleware  {:optional true} [:maybe MiddlewareOptions]]
       ;;
       ;; INFO
       ;;
       ;; Used when recording info about this run in the QueryExecution log; things like context query was ran in and
       ;; User who ran it
       [:info {:optional true} [:maybe Info]]]
      ;;
      ;; CONSTRAINTS
      check-keys-for-query-type
      check-query-does-not-have-source-metadata))

Is this a valid outer query? (Pre-compling a validator is more efficient.)

(def ^{:arglists '([query])} valid-query?
  (mr/validator Query))

Validator for an outer query; throw an Exception explaining why the query is invalid if it is.

(def ^{:arglists '([query])} validate-query
  (let [explainer (mr/explainer Query)]
    (fn [query]
      (if (valid-query? query)
        query
        (let [error     (explainer query)
              humanized (me/humanize error)]
          (throw (ex-info (i18n/tru "Invalid query: {0}" (pr-str humanized))
                          {:error    humanized
                           :original error})))))))
 
(ns metabase.mbql.schema.helpers
  (:refer-clojure :exclude [distinct])
  (:require
   [clojure.string :as str]
   [metabase.types]
   [metabase.util.malli.registry :as mr]))
(comment metabase.types/keep-me)

--------------------------------------------------- defclause ----------------------------------------------------

(defn- wrap-clause-arg-schema [arg-schema]
  [:schema (if (qualified-keyword? arg-schema)
             [:ref arg-schema]
             arg-schema)])
(defn- clause-arg-schema [arg-schema]
  ;; for things like optional schemas
  (if-not (vector? arg-schema)
    (wrap-clause-arg-schema arg-schema)
    (let [[option arg-schema :as vector-arg-schema] arg-schema]
      (case option
        :optional [:? [:maybe (wrap-clause-arg-schema arg-schema)]]
        :rest     [:* (wrap-clause-arg-schema arg-schema)]
        (wrap-clause-arg-schema vector-arg-schema)))))

If x an MBQL clause, and an instance of clauses defined by keyword(s) k-or-ks?

(is-clause? :count [:count 10]) ; -> true (is-clause? #{:+ :- :* :/} [:+ 10 20]) ; -> true

TODO - this is a copy of the one in the [[metabase.mbql.util]] namespace. We need to reorganize things a bit so we can use the same fn and avoid circular refs

(defn is-clause?
  [k-or-ks x]
  (and
   (vector? x)
   (keyword? (first x))
   (if (coll? k-or-ks)
     ((set k-or-ks) (first x))
     (= k-or-ks (first x)))))

Impl of [[metabase.mbql.schema.macros/defclause]] macro. Creates a Malli schema.

(defn clause
  [tag & arg-schemas]
  [:and
   [:fn
    {:error/message (str "not a " tag " clause")}
    (partial is-clause? tag)]
   (into
    [:catn
     ["tag" [:= tag]]]
    (for [[arg-name arg-schema] (partition 2 arg-schemas)]
      [arg-name (clause-arg-schema arg-schema)]))])
(defn- clause-tag [clause]
  (when (and (vector? clause)
             (keyword? (first clause)))
    (first clause)))

Interal impl of one-of macro.

(defn one-of*
  [& tags+schemas]
  (into
   [:multi {:dispatch      clause-tag
            :error/message (str "valid instance of one of these MBQL clauses: " (str/join ", " (map first tags+schemas)))}]
   (for [[tag schema] tags+schemas]
     [tag (if (qualified-keyword? schema)
            [:ref schema]
            schema)])))

Schema for any keyword or string.

(def KeywordOrString
  [:or :keyword :string])

Add an addditonal constraint to schema (presumably an array) that requires it to be non-empty (i.e., it must satisfy seq).

(defn non-empty
  [schema]
  (if (and (sequential? schema)
           (= (first schema) :sequential))
    (let [[_sequential & args] schema
          [options & args]     (if (map? (first args))
                                 args
                                 (cons nil args))]
      (into [:sequential (assoc options :min 1)] args))
    [:and
     schema
     [:fn
      {:error/message "non-empty"}
      seq]]))

True if coll is either empty or distinct.

(defn empty-or-distinct?
  [coll]
  (if (seq coll)
    (apply distinct? coll)
    true))
(mr/def ::distinct
  [:fn
   {:error/message "distinct"}
   empty-or-distinct?])

Add an additional constraint to schema (presumably an array) that requires all elements to be distinct.

(defn distinct
  [schema]
  [:and schema [:ref ::distinct]])
 
(ns metabase.mbql.schema.macros
  (:require
   [metabase.mbql.schema.helpers :as metabase.mbql.schema.helpers]
   [metabase.util.malli.registry :as mr]))
(defn- stringify-names [arg-names-and-schemas]
  (into []
        (comp (partition-all 2)
              (mapcat (fn [[arg-name schema]]
                        [(name arg-name) (if (and (list? schema)
                                                  (#{:optional :rest} (keyword (first schema))))
                                           (vec (cons (keyword (first schema)) (rest schema)))
                                           schema)])))
        arg-names-and-schemas))

Define a new MBQL clause.

(defclause field-id, id su/IntGreaterThanZero)

The first arg is the name of the clause, and should be followed by pairs of arg name, arg schema. Arg schemas may optionally be wrapped in optional or rest to signify that the arg is optional, or to accept varargs:

(defclause count, field (optional Field)) (defclause and, filters (rest Filter))

Since there are some cases where clauses should be parsed differently in MBQL (such as expressions in the expressions clause vs in aggregations), you can give the actual symbol produced by this macro a different name as follows:

(defclause [ag:+ +] ...) ; define symbol ag:+ to be used for a [:+ ...] clause

(defmacro defclause
  [clause-name & arg-names-and-schemas]
  (let [[symb-name clause-name] (if (vector? clause-name)
                                  clause-name
                                  [clause-name (or (:clause-name (meta clause-name)) clause-name)])
        clause-registry-name    (keyword "metabase.mbql.schema" (name symb-name))]
    `(do
       (mr/register! ~clause-registry-name
                     (metabase.mbql.schema.helpers/clause ~(keyword clause-name) ~@(stringify-names arg-names-and-schemas)))
       (def ~(vary-meta symb-name assoc
                        :clause-name (keyword clause-name)
                        :clause-form (into [(keyword clause-name)]
                                           (mapcat (fn [[arg schema]]
                                                     [(keyword arg) `'~schema])
                                                   (partition 2 arg-names-and-schemas)))
                        :doc         (format "Schema for a valid %s clause." clause-name))
         [:ref ~clause-registry-name]))))

Define a schema that accepts one of several different MBQL clauses.

(one-of field-id field-literal)

(defmacro one-of
  [& clauses]
  `(metabase.mbql.schema.helpers/one-of*
    ~@(for [clause clauses]
        [`(or (:clause-name (meta (resolve '~clause)))
              '~clause)
         clause])))
 
(ns metabase.mbql.schema.macros
  (:require-macros
   [metabase.mbql.schema.macros]))
(comment metabase.mbql.schema.macros/keep-me)
 
(ns metabase.mbql.util.match
  (:refer-clojure :exclude [replace])
  (:require
   [clojure.core.match]
   [metabase.mbql.util.match.impl])
  (:require-macros [metabase.mbql.util.match]))
(comment clojure.core.match/keep-me
         metabase.mbql.util.match/keep-me
         metabase.mbql.util.match.impl/keep-me)
 

Internal implementation of the MBQL match and replace macros. Don't use these directly.

(ns metabase.mbql.util.match
  (:refer-clojure :exclude [replace])
  (:require
   [clojure.core.match]
   [clojure.walk :as walk]
   [metabase.mbql.util.match.impl :as metabase.mbql.util.match.impl]
   [net.cgrand.macrovich :as macros]))

Generate a single approprate pattern for use with core.match based on the pattern input passed into match or replace.

(defn- generate-pattern
  [pattern]
  (cond
    (keyword? pattern)
    [[pattern '& '_]]
    (and (set? pattern) (every? keyword? pattern))
    [[`(:or ~@pattern) '& '_]]
    ;; special case for `_`, we'll let you match anything with that
    (= pattern '_)
    [pattern]
    (symbol? pattern)
    `[(~'_ :guard (metabase.mbql.util.match.impl/match-with-pred-or-class ~pattern))]
    :else
    [pattern]))
(defn- recur-form? [form]
  (and (seq? form)
       (= 'recur (first form))))

Replace any recur forms with ones that include the implicit &parents arg.

(defn- rewrite-recurs
  [fn-name result-form]
  (walk/postwalk
   (fn [form]
     (if (recur-form? form)
       ;; we *could* use plain `recur` here, but `core.match` cannot apply code size optimizations if a `recur` form
       ;; is present. Instead, just do a non-tail-call-optimized call to the pattern fn so `core.match` can generate
       ;; efficient code.
       ;;
       ;; (recur [:new-clause ...]) ; -> (match-123456 &parents [:new-clause ...])
       `(~fn-name ~'&parents ~@(rest form))
       form))
   result-form))

Generate the core.match patterns and results given the input to our macros.

wrap-result-forms? will wrap the results parts of the pairs in a vector, so we do something like (reduce concat) on all of the results to return a sequence of matches for match.

(defn- generate-patterns-and-results
  [fn-name patterns-and-results & {:keys [wrap-result-forms?]}]
  (mapcat (fn [[pattern result]]
            [(generate-pattern pattern) (let [result (rewrite-recurs fn-name result)]
                                          (if (or (not wrap-result-forms?)
                                                  (and (seq? result)
                                                       (= fn-name (first result))))
                                            result
                                            [result]))])
          (partition 2 2 ['&match] patterns-and-results)))

If the last pattern passed in was _, we can skip generating the default :else clause, because it will never match.

(defn- skip-else-clause?
  ;; TODO - why don't we just let people pass their own `:else` clause instead?
  [patterns-and-results]
  (= '_ (second (reverse patterns-and-results))))
(defmethod clojure.core.match/emit-pattern-for-syntax [:isa? :default]
  [[_ parent]] {:clojure.core.match/tag ::isa? :parent parent})
(defmethod clojure.core.match/to-source ::isa?
  [{parent :parent} ocr]
  `(isa? ~ocr ~parent))

Internal impl for match and replace macros.

(defmacro match**
  [& args]
  (macros/case
    :clj  `(clojure.core.match/match ~@args)
    :cljs `(cljs.core.match/match ~@args)))

Internal impl for match. Generate a pattern-matching function using core.match, and call it with form.

(defmacro match*
  [form patterns-and-results]
  (let [match-fn-symb (gensym "match-")]
    `(seq
      (filter
       some?
       ((fn ~match-fn-symb [~'&parents ~'&match]
          (match** [~'&match]
                   ~@(generate-patterns-and-results match-fn-symb patterns-and-results, :wrap-result-forms? true)
                   ~@(when-not (skip-else-clause? patterns-and-results)
                       [:else `(metabase.mbql.util.match.impl/match-in-collection ~match-fn-symb ~'&parents ~'&match)])))
        []
        ~form)))))

Return a sequence of things that match a pattern or patterns inside x, presumably a query, returning nil if there are no matches. Recurses through maps and sequences. pattern can be one of several things:

  • Keyword name of an MBQL clause
  • Set of keyword names of MBQL clauses. Matches any clauses with those names
  • A core.match pattern
  • A symbol naming a class.
  • A symbol naming a predicate function
  • _, which will match anything

Examples:

;; keyword pattern (match {:fields [[:field 10 nil]]} :field) ; -> [[:field 10 nil]]

;; set of keywords (match some-query #{:field :expression}) ; -> [[:field 10 nil], [:expression "wow"], ...]

;; core.match patterns: ;; match any :field clause with two args (which should be all of them) (match some-query [:field _ _]) ;; match any :field clause with integer ID > 100 (match some-query [:field (_ :guard (every-pred integer? #(> % 100)))]) ; -> [[:field 200 nil], ...]

;; symbol naming a Class ;; match anything that is an instance of that class (match some-query java.util.Date) ; -> [[#inst "2018-10-08", ...]

;; symbol naming a predicate function ;; match anything that satisfies that predicate (match some-query (every-pred integer? even?)) ; -> [2 4 6 8]

;; match anything with _ (match 100 _) ; -> 100

Using `core.match` patterns

See core.match documentation for more details.

Pattern-matching works almost exactly the way it does when using core.match** directly, with a few differences:

  • mbql.util/match returns a sequence of everything that matches, rather than the first match it finds

  • patterns are automatically wrapped in vectors for you when appropriate

  • things like keywords and classes are automatically converted to appropriate patterns for you

  • this macro automatically recurses through sequences and maps as a final :else clause. If you don't want to automatically recurse, use a catch-all pattern (such as _). Our macro implementation will optimize out this :else clause if the last pattern is _

Returing something other than the exact match with result body

By default, match returns whatever matches the pattern you pass in. But what if you only want to return part of the match? You can, using core.match binding facilities. Bind relevant things in your pattern and pass in the optional result body. Whatever result body returns will be returned by match:

;; just return the IDs of Field ID clauses (match some-query [:field (id :guard integer?) _] id) ; -> [1 2 3]

You can also use result body to filter results; any nil values will be skipped:

(match some-query [:field (id :guard integer?) _] (when (even? id) id)) ;; -> [2 4 6 8]

Of course, it's more efficient to let core.match compile an efficient matching function, so prefer using patterns with :guard where possible.

You can also call recur inside result bodies, to use the same matching logic against a different value.

`&match` and `&parents` anaphors

For more advanced matches, like finding a :field clauses nested anywhere inside another clause, match binds a pair of anaphors inside the result body for your convenience. &match is bound to the entire match, regardless of how you may have destructured it; &parents is bound to a sequence of keywords naming the parent top-level keys and clauses of the match.

(mbql.u/match {:filter [:time-interval [:field 1 nil] :current :month]} :field ;; &parents will be [:filter :time-interval] (when (contains? (set &parents) :time-interval) &match)) ;; -> [[:field 1 nil]]

(defmacro match
  {:style/indent 1}
  [x & patterns-and-results]
  ;; Actual implementation of these macros is in `mbql.util.match`. They're in a seperate namespace because they have
  ;; lots of other functions and macros they use for their implementation (which means they have to be public) that we
  ;; would like to discourage you from using directly.
  `(match* ~x ~patterns-and-results))

Like match but returns a single match rather than a sequence of matches.

(defmacro match-one
  {:style/indent 1}
  [x & patterns-and-results]
  `(first (match* ~x ~patterns-and-results)))

TODO - it would be ultra handy to have a match-all function that could handle clauses with recursive matches, e.g. with a query like

{:query {:source-table 1, :joins [{:source-table 2, ...}]}}

it would be useful to be able to do

;; get all the source tables (mbql.u/match-all query (&match :guard (every-pred map? :source-table)) (:source-table &match))

Internal implementation for replace. Generate a pattern-matching function with core.match, and use it to replace matching values in form.

(defmacro replace*
  [form patterns-and-results]
  (let [replace-fn-symb (gensym "replace-")]
    `((fn ~replace-fn-symb [~'&parents ~'&match]
        (match** [~'&match]
                 ~@(generate-patterns-and-results replace-fn-symb patterns-and-results, :wrap-result-forms? false)
                 ~@(when-not (skip-else-clause? patterns-and-results)
                     [:else `(metabase.mbql.util.match.impl/replace-in-collection ~replace-fn-symb ~'&parents ~'&match)])))
      []
      ~form)))

Like match, but replace matches in x with the results of result body. The same pattern options are supported, and &parents and &match anaphors are available in the same way. (&match is particularly useful here if you want to use keywords or sets of keywords as patterns.)

(defmacro replace
  {:style/indent 1}
  [x & patterns-and-results]
  ;; as with `match` actual impl is in `match` namespace to discourage you from using the constituent functions and
  ;; macros that power this macro directly
  `(replace* ~x ~patterns-and-results))

Like replace, but only replaces things in the part of x in the keypath ks (i.e. the way to update-in works.)

(defmacro replace-in
  {:style/indent 2}
  [x ks & patterns-and-results]
  `(metabase.mbql.util.match.impl/update-in-unless-empty ~x ~ks (fn [x#] (replace* x# ~patterns-and-results))))

TODO - it would be useful to have something like a replace-all function as well

 

Internal implementation of the MBQL match and replace macros. Don't use these directly.

(ns metabase.mbql.util.match.impl)

Return a function to use for pattern matching via core.match's :guard functionality based on the value of a pred-or-class passed in as a pattern to match or replace.

(Class-based matching currently only works in Clojure. For ClojureScript, only predicate function matching works.)

have to do this at runtime because we don't know if a symbol is a class or pred or whatever when we compile the macro

(defn match-with-pred-or-class
  [pred-or-class]
  (cond
    ;; TODO -- FIXME -- Figure out how to make this work in JS
    #?@(:clj [(class? pred-or-class)
              (partial instance? pred-or-class)])
    (fn? pred-or-class)
    pred-or-class
    :else
    ;; this is dev-specific so we don't need to localize it
    (throw (ex-info "Invalid pattern: don't know how to handle symbol." {:symbol pred-or-class}))))

Internal impl for match. If form is a collection, call match-fn to recursively look for matches in it.

(defn match-in-collection
  [match-fn clause-parents form]
  {:pre [(fn? match-fn) (vector? clause-parents)]}
  (cond
    (map? form)
    (mapcat (fn [[k v]]
              (match-fn (conj clause-parents k) v))
            form)
    (sequential? form)
    (mapcat (partial match-fn (if (keyword? (first form))
                                (conj clause-parents (first form))
                                clause-parents))
            form)))

Inernal impl for replace. Recursively replace values in a collection using a replace-fn.

(defn replace-in-collection
  [replace-fn clause-parents form]
  (cond
    (map? form)
    (into form (for [[k v] form]
                 [k (replace-fn (conj clause-parents k) v)]))
    (sequential? form)
    (mapv (partial replace-fn (if (keyword? (first form))
                                (conj clause-parents (first form))
                                clause-parents))
          form)
    :else              form))

Like update-in, but only updates in the existing value is non-empty.

(defn update-in-unless-empty
  [m ks f & args]
  (if-not (seq (get-in m ks))
    m
    (apply update-in m ks f args)))
 

The core metabot namespace. Consists primarily of functions named infer-X, where X is the thing we want to extract from the bot response.

(ns metabase.metabot
  (:require
   [cheshire.core :as json]
   [metabase.lib.native :as lib-native]
   [metabase.metabot.client :as metabot-client]
   [metabase.metabot.settings :as metabot-settings]
   [metabase.metabot.util :as metabot-util]
   [metabase.models :refer [Table]]
   [metabase.util.log :as log]
   [toucan2.core :as t2]))

Determine an 'interesting' visualization for this data.

(defn infer-viz
  [{sql :sql :as context}]
  (log/infof "Metabot is inferring visualization for sql '%s'." sql)
  (if (metabot-settings/is-metabot-enabled)
    (if (metabot-util/select-all? sql)
      ;; A SELECT * query just short-circuits to a tabular display
      {:template {:display                :table
                  :visualization_settings {}}}
      ;; More interesting SQL merits a more interesting display
      (let [{:keys [prompt_template version] :as prompt} (metabot-util/create-prompt context)]
        {:template                (metabot-util/find-result
                                   (fn [message]
                                     (metabot-util/response->viz
                                      (json/parse-string message keyword)))
                                   (metabot-client/invoke-metabot prompt))
         :prompt_template_version (format "%s:%s" prompt_template version)}))
    (log/warn "Metabot is not enabled")))

Given a model and prompt, attempt to generate a native dataset.

(defn infer-sql
  [{:keys [model user_prompt] :as context}]
  (log/infof "Metabot is inferring sql for model '%s' with prompt '%s'." (:id model) user_prompt)
  (if (metabot-settings/is-metabot-enabled)
    (let [{:keys [prompt_template version] :as prompt} (metabot-util/create-prompt context)
          {:keys [database_id inner_query]} model]
      (if-some [bot-sql (metabot-util/find-result
                         metabot-util/extract-sql
                         (metabot-client/invoke-metabot prompt))]
        (let [final-sql     (metabot-util/bot-sql->final-sql model bot-sql)
              _             (log/infof "Inferred sql for model '%s' with prompt '%s':\n%s"
                                       (:id model)
                                       user_prompt
                                       final-sql)
              template-tags (lib-native/extract-template-tags inner_query)
              dataset       {:dataset_query          {:database database_id
                                                      :type     "native"
                                                      :native   {:query         final-sql
                                                                 :template-tags template-tags}}
                             :display                :table
                             :visualization_settings {}}]
          {:card                     dataset
           :prompt_template_versions (vec
                                      (conj
                                       (:prompt_template_versions model)
                                       (format "%s:%s" prompt_template version)))
           :bot-sql                  bot-sql})
        (log/infof "No sql inferred for model '%s' with prompt '%s'." (:id model) user_prompt)))
    (log/warn "Metabot is not enabled")))

Find the model in the db that best matches the prompt using embedding matching.

(defn match-best-model
  [{{database-id :id :keys [models]} :database :keys [user_prompt]}]
  (log/infof "Metabot is inferring model for database '%s' with prompt '%s'." database-id user_prompt)
  (if (metabot-settings/is-metabot-enabled)
    (let [models (->> models
                      (map (fn [{:keys [create_table_ddl] :as model}]
                             (let [{:keys [prompt embedding tokens]} (metabot-client/create-embedding create_table_ddl)]
                               (assoc model
                                      :prompt prompt
                                      :embedding embedding
                                      :tokens tokens)))))]
      (if-some [{best-mode-name :name
                 best-model-id  :id
                 :as            model} (metabot-util/best-prompt-object models user_prompt)]
        (do
          (log/infof "Metabot selected best model for database '%s' with prompt '%s' as '%s' (%s)."
                     database-id user_prompt best-model-id best-mode-name)
          model)
        (log/infof "No model inferred for database '%s' with prompt '%s'." database-id user_prompt)))
    (log/warn "Metabot is not enabled")))

Find the model in the db that best matches the prompt. Return nil if no good model found.

(defn infer-model
  [{{database-id :id :keys [models]} :database :keys [user_prompt] :as context}]
  (log/infof "Metabot is inferring model for database '%s' with prompt '%s'." database-id user_prompt)
  (if (metabot-settings/is-metabot-enabled)
    (let [{:keys [prompt_template version] :as prompt} (metabot-util/create-prompt context)
          ids->models   (zipmap (map :id models) models)
          candidates    (set (keys ids->models))
          best-model-id (metabot-util/find-result
                         (fn [message]
                           (some->> message
                                    (re-seq #"\d+")
                                    (map parse-long)
                                    (some candidates)))
                         (metabot-client/invoke-metabot prompt))]
      (if-some [model (ids->models best-model-id)]
        (do
          (log/infof "Metabot selected best model for database '%s' with prompt '%s' as '%s'."
                     database-id user_prompt best-model-id)
          (update model
                  :prompt_template_versions
                  (fnil conj [])
                  (format "%s:%s" prompt_template version)))
        (log/infof "No model inferred for database '%s' with prompt '%s'." database-id user_prompt)))
    (log/warn "Metabot is not enabled")))

Given a database and user prompt, determine a sql query to answer my question.

(defn infer-native-sql-query
  [{{database-id :id} :database
    :keys             [user_prompt prompt_template_versions] :as context}]
  (log/infof "Metabot is inferring sql for database '%s' with prompt '%s'." database-id user_prompt)
  (if (metabot-settings/is-metabot-enabled)
    (let [prompt-objects (->> (t2/select [Table :name :schema :id] :db_id database-id)
                              (map metabot-util/memoized-create-table-embedding)
                              (filter identity))
          ddl            (metabot-util/generate-prompt prompt-objects user_prompt)
          context        (assoc-in context [:database :create_database_ddl] ddl)
          {:keys [prompt_template version] :as prompt} (metabot-util/create-prompt context)]
      (if-some [sql (metabot-util/find-result
                     metabot-util/extract-sql
                     (metabot-client/invoke-metabot prompt))]
        {:sql                      sql
         :prompt_template_versions (conj
                                    (vec prompt_template_versions)
                                    (format "%s:%s" prompt_template version))}
        (log/infof "No sql inferred for database '%s' with prompt '%s'." database-id user_prompt)))
    (log/warn "Metabot is not enabled")))
 
(ns metabase.metabot.client
  (:require
   [cheshire.core :as json]
   [metabase.metabot.settings :as metabot-settings]
   [metabase.util.log :as log]
   [wkok.openai-clojure.api :as openai.api]))
(set! *warn-on-reflection* true)

Wrap our openai calls with a standard set of exceptions that will percolate up any issues to the UI as meaningful error messages.

(defn- wrap-openai-exceptions
  [openai-fn]
  (fn openai-call [params options]
    (try
      (openai-fn params options)
      (catch Exception e
        (log/warnf "Exception when calling invoke-metabot: %s" (.getMessage e))
        (throw
          ;; If we have ex-data, we'll assume were intercepting an openai.api/create-chat-completion response
         (if-some [status (:status (ex-data e))]
           (let [{:keys [body]} (ex-data e)
                 {:keys [error]} (json/parse-string body keyword)
                 {error-type :type :keys [message code]} error]
             (case (int status)
               400 (do
                     (log/warnf "%s: %s" code message)
                     (ex-info
                      message
                      {:message     message
                       :status-code 400}))
               401 (ex-info
                    "Bot credentials are incorrect or not set.\nCheck with your administrator that the correct API keys are set."
                    {:message     "Bot credentials are incorrect or not set.\nCheck with your administrator that the correct API keys are set."
                       ;; Don't actually produce a 401 because you'll get redirect do the home page.
                     :status-code 400})
               429 (if (= error-type "insufficient_quota")
                     (ex-info
                      "You exceeded your current OpenAI billing quota, please check your OpenAI plan and billing details."
                      {:message     "You exceeded your current OpenAI billing quota, please check your OpenAI plan and billing details."
                       :status-code status})
                     (ex-info
                      "The bot server is under heavy load and cannot process your request at this time.\nPlease try again."
                      {:message     "The bot server is under heavy load and cannot process your request at this time.\nPlease try again."
                       :status-code status}))
                ;; Just re-throw it until we get a better handle on
               (ex-info
                "Error calling remote bot server.\nPlease try again."
                {:message     "The bot server is under heavy load and cannot process your request at this time.\nPlease try again."
                 :status-code 500})))
            ;; If there's no ex-data, we'll assume it's some other issue and generate a 400
           (ex-info
            (ex-message e)
            {:exception-data (ex-data e)
             :status-code    400})))))))

OpenAI is the default completion endpoint

(defn- default-chat-completion-endpoint
  [params options]
  (openai.api/create-chat-completion
   (select-keys params [:model :n :messages])
   options))

The endpoint used to invoke the remote LLM

(def ^:dynamic ^{:arglists '([params options])}
  *create-chat-completion-endpoint*
  default-chat-completion-endpoint)

Call the bot and return the response. Takes messages to be used as instructions and a function that will find the first valid result from the messages.

(defn invoke-metabot
  [{:keys [messages] :as prompt}]
  {:pre [messages]}
  ((wrap-openai-exceptions *create-chat-completion-endpoint*)
   (merge
    {:model (metabot-settings/openai-model)
     :n     (metabot-settings/num-metabot-choices)}
    prompt)
   {:api-key      (metabot-settings/openai-api-key)
    :organization (metabot-settings/openai-organization)}))

OpenAI is the default completion endpoint"

(defn- default-embedding-endpoint
  [params options]
  (log/debugf "Creating embedding...")
  (openai.api/create-embedding
   (select-keys params [:model :input])
   options))

Default embeddings endpoint is both dynamic and memoized.

(def ^:dynamic ^{:arglists '([params options])}
  *create-embedding-endpoint*
  default-embedding-endpoint)

Create an embedding vector from the given prompt. This response with the original prompt, the embedding vector, and the token count of the embeddings. The token count can be used to provide best fit queries for prompts requiring large amounts of data.

(defn create-embedding
  ([model prompt]
   (let [{[{:keys [embedding]}]   :data
          {:keys [prompt_tokens]} :usage} ((wrap-openai-exceptions *create-embedding-endpoint*)
                                           {:model model
                                            :input prompt}
                                           {:api-key      (metabot-settings/openai-api-key)
                                            :organization (metabot-settings/openai-organization)})]
     {:prompt    prompt
      :embedding embedding
      :tokens    prompt_tokens}))
  ([prompt]
   (create-embedding (metabot-settings/metabot-default-embedding-model) prompt)))
 
(ns metabase.metabot.feedback
  (:require [cheshire.core :as json]
            [clj-http.client :as http]
            [metabase.analytics.snowplow :as snowplow]
            [metabase.api.common :as api]
            [metabase.metabot.settings :as metabot-settings]))
(def ^:private snowplow-keys [:entity_type :prompt_template_versions :feedback_type])
(def ^:private feedback-keys (into snowplow-keys [:prompt :sql]))

Store feedback details, including the original prompt and generated sql.

(defn- store-detailed-feedback
  [feedback]
  (let [feedback (select-keys feedback feedback-keys)
        {:keys [status body]} (http/request
                               {:url              (metabot-settings/metabot-feedback-url)
                                :method           :post
                                :body             (json/generate-string
                                                   feedback
                                                   {:pretty true})
                                :throw-exceptions false
                                :as               :json
                                :accept           :json
                                :content-type     :json})]
    (when (= 200 status) body)))

Store user-generated feedback as both a concise value in snowplow and more detailed values in a separate endpoint.

(defn submit-feedback
  [feedback]
  (let [snowplow-feedback (select-keys feedback snowplow-keys)]
    (snowplow/track-event!
     ::snowplow/metabot-feedback-received api/*current-user-id*
     snowplow-feedback)
    (store-detailed-feedback feedback)))
 
(ns metabase.metabot.settings
  (:require
   [clojure.core.memoize :as memoize]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru]]
   [metabase.util.log :as log]
   [wkok.openai-clojure.api :as openai.api]))
(defsetting openai-model
  (deferred-tru "The OpenAI Model (e.g. 'gpt-4', 'gpt-3.5-turbo')")
  :visibility :settings-manager
  :default "gpt-4")
(defsetting openai-api-key
  (deferred-tru "The OpenAI API Key.")
  :visibility :settings-manager)
(defsetting openai-organization
  (deferred-tru "The OpenAI Organization ID.")
  :visibility :settings-manager)
(defsetting metabot-default-embedding-model
  (deferred-tru "The default embeddings model to be used for metabot.")
  :visibility :internal
  :default "text-embedding-ada-002")
(defsetting metabot-get-prompt-templates-url
  (deferred-tru "The URL in which metabot versioned prompt templates are stored.")
  :visibility :settings-manager
  :default "https://stkxezsr2kcnkhusi3fgcc5nqm0ttgfx.lambda-url.us-east-1.on.aws/")
(defsetting metabot-feedback-url
  (deferred-tru "The URL to which metabot feedback is posted.")
  :visibility :settings-manager
  :default "https://amtix3l3qvitb2qxstaqtcoqby0monuf.lambda-url.us-east-1.on.aws/")
(defsetting is-metabot-enabled
  (deferred-tru "Is Metabot enabled?")
  :type :boolean
  :visibility :public
  :getter  (fn []
             (boolean (setting/env-var-value :is-metabot-enabled)))
  :default false)
(defsetting num-metabot-choices
  (deferred-tru "Number of potential responses metabot will request. The first valid response is selected.")
  :type :integer
  :visibility :internal
  :default 1)

Downselect the available openai models to only the latest version of each GPT family.

(defn- select-models
  [models]
  (->> models
       (map (fn [{:keys [id] :as m}]
              (when-some [[_ v r] (re-matches #"gpt-([\d\.]+)(.*)"
                                              (u/lower-case-en id))]
                (let [version (parse-double v)]
                  (assoc m
                    :version version
                    :version-string v
                    :generation (int version)
                    :details r)))))
       ;; Drop anything that doesn't match
       (filter identity)
       ;; Order by generation (asc), version (desc),
       ;; length of details string (asc), length of version string (desc)
       (sort-by (juxt :generation
                      (comp - :version)
                      (comp count :details)
                      (comp - count :version-string)))
       ;; Split out each generation
       (partition-by :generation)
       ;; Take the top item in each partition and select what we want
       (map (comp #(select-keys % [:id :owned_by]) first))
       reverse))
(def ^:private memoized-fetch-openai-models
  (memoize/ttl
   ^{::memoize/args-fn (fn [[api-key organization]] [api-key organization])}
   (fn [api-key organization]
     (try
       (->> (openai.api/list-models
             {:api-key      api-key
              :organization organization})
            :data
            select-models)
       (catch Exception _
         (log/warn "Unable to fetch openai models.")
         [])))
   :ttl/threshold (* 1000 60 60 24)))
(defsetting openai-available-models
  (deferred-tru "List available openai models.")
  :visibility :settings-manager
  :type :json
  :setter :none
  :getter (fn []
            (if (and
                 (is-metabot-enabled)
                 (openai-api-key)
                 (openai-organization))
              (memoized-fetch-openai-models
               (openai-api-key)
               (openai-organization))
              [])))
(defsetting enum-cardinality-threshold
  (deferred-tru "Enumerated field values with cardinality at or below this point are treated as enums in the pseudo-ddl used in some model prompts.")
  :type :integer
  :visibility :internal
  :default 60)
(defsetting metabot-prompt-generator-token-limit
  (deferred-tru "When attempting to assemble prompts, the threshold at which prompt will no longer be appended to.")
  :type :integer
  :visibility :internal
  :default 6000)
 

Functions for denormalizing input, prompt input generation, and sql handing. If this grows much, we might want to split these out into separate nses.

(ns metabase.metabot.util
  (:require
   [cheshire.core :as json]
   [clojure.core.memoize :as memoize]
   [clojure.string :as str]
   [honey.sql :as sql]
   [metabase.db.query :as mdb.query]
   [metabase.mbql.util :as mbql.u]
   [metabase.metabot.client :as metabot-client]
   [metabase.metabot.settings :as metabot-settings]
   [metabase.models :refer [Card Field FieldValues Table]]
   [metabase.query-processor :as qp]
   [metabase.query-processor.reducible :as qp.reducible]
   [metabase.query-processor.util.add-alias-info :as add]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [toucan2.core :as t2]))

Is metabot supported for the given database.

(defn supported?
  [db-id]
  (let [q "SELECT 1 FROM (SELECT 1 AS ONE) AS TEST"]
    (try
      (some?
       (qp/process-query {:database db-id
                          :type     "native"
                          :native   {:query q}}))
      (catch Exception _ false))))

Input Denormalization ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Normalize model and column names to SLUG_CASE. The current bot responses do a terrible job of creating all kinds of SQL from a table or column name. Example: 'Created At', CREATED_AT, "created at" might all come back in the response. Standardization of names produces dramatically better results.

(defn normalize-name
  [s]
  (some-> s
          u/upper-case-en
          (str/replace #"[^\p{Alnum}]+" " ")
          str/trim
          (str/replace #" " "_")))

Add the aliases generated by the query processor to each results metadata field.

(defn- add-qp-column-aliases
  [{:keys [dataset_query] :as model}]
  (let [fields           (let [qp (qp.reducible/combine-middleware
                                   (vec qp/around-middleware)
                                   (fn [query _rff _context]
                                     (add/add-alias-info
                                      (#'qp/preprocess* query))))]
                           (get-in (qp dataset_query nil nil) [:query :fields]))
        field-ref->alias (reduce
                          (fn [acc [_f _id-or-name m :as field-ref]]
                            (if-let [alias (::add/desired-alias m)]
                              (assoc acc (mbql.u/remove-namespaced-options field-ref) alias)
                              acc))
                          {}
                          fields)]
    (update model :result_metadata
            (fn [result_metadata]
              (map
               (fn [{:keys [field_ref] :as rsmd}]
                 (assoc rsmd :qp_column_name (field-ref->alias field_ref)))
               result_metadata)))))

Produce a SELECT * over the parameterized model with columns aliased to normalized display names. Add this result to the input model along with the generated column aliases. This can be used in a CTE such that an outer query can be called on this query.

(defn- add-inner-query
  [{:keys [id result_metadata] :as model}]
  (let [column-aliases (or
                        (some->> result_metadata
                                 (map (comp
                                       (fn [[column_name column_alias]]
                                         (cond
                                           (and column_name column_alias) (format "\"%s\" AS %s" column_name column_alias)
                                           column_alias column_alias
                                           :else nil))
                                       (juxt :qp_column_name :sql_name)))
                                 (filter identity)
                                 seq
                                 (str/join ", "))
                        "*")]
    (assoc model
           :column_aliases column-aliases
           :inner_query
           (mdb.query/format-sql
            (format "SELECT %s FROM {{#%s}} AS INNER_QUERY" column-aliases id)))))

Create a 'denormalized' version of the field which is optimized for querying and prompt engineering. Add in enumerated values (if a low-cardinality field), and remove fields unused in prompt engineering.

(defn- denormalize-field
  ([{:keys [id base_type] :as field} enum-cardinality-threshold]
   (let [field-vals (when
                     (and
                      (not= :type/Boolean base_type)
                      (< 0
                         (get-in field [:fingerprint :global :distinct-count] 0)
                         (inc enum-cardinality-threshold)))
                      (t2/select-one-fn :values FieldValues :field_id id))]
     (-> (cond-> field
           (seq field-vals)
           (assoc :possible_values (vec field-vals)))
         (dissoc :field_ref :id))))
  ([field]
   (denormalize-field
    field
    (metabot-settings/enum-cardinality-threshold))))

Create the postgres enum for any item in result_metadata that has enumerated/low cardinality values.

(defn- model->enum-ddl
  [{:keys [result_metadata]}]
  (into {}
        (for [{:keys [display_name sql_name possible_values]} result_metadata
              :when (seq possible_values)
              :let [ddl-str (format "create type %s_t as enum %s;"
                                    sql_name
                                    (str/join ", " (map (partial format "'%s'") possible_values)))
                    nchars  (count ddl-str)]]
          (do
            (log/tracef "Pseudo-ddl for field '%s' enumerates %s possible values contains %s chars (~%s tokens)."
                        display_name
                        (count possible_values)
                        nchars
                        (quot nchars 4))
            [sql_name ddl-str]))))

Create an equivalent DDL for this model

(defn- model->pseudo-ddl
  [{model-name :name model-id :id :keys [sql_name result_metadata] :as model}]
  (log/debugf "Creating pseudo-ddl for model '%s'(%s):"
              model-name
              model-id)
  (let [enums   (model->enum-ddl model)
        [ddl] (sql/format
               {:create-table sql_name
                :with-columns (for [{:keys [sql_name base_type]} result_metadata
                                    :let [k sql_name]]
                                [k (if (enums k)
                                     (format "%s_t" k)
                                     base_type)])}
               {:dialect :ansi})
        ddl-str (str/join "\n\n" (conj (vec (vals enums)) (mdb.query/format-sql ddl)))
        nchars  (count ddl-str)]
    (log/debugf "Pseudo-ddl for model '%s'(%s) describes %s enum fields and contains %s chars (~%s tokens)."
                model-name
                model-id
                (count enums)
                nchars
                (quot nchars 4))
    ddl-str))
(defn- add-create-table-ddl [model]
  (assoc model :create_table_ddl (model->pseudo-ddl model)))

Given a seq of names that are potentially the same, provide a seq of tuples of original name to a non-ambiguous version of the name.

(defn- disambiguate
  [names]
  (let [uniquifier (mbql.u/unique-name-generator)
        [_ new-names] (reduce
                       (fn [[taken acc] n]
                         (let [candidate (uniquifier n)]
                           (if (taken candidate)
                             (recur [(conj taken candidate) acc] n)
                             [(conj taken candidate) (conj acc candidate)])))
                       [#{} []] names)]
    (map vector names new-names)))

Add a distinct SCREAMINGSNAKECASE sql name to each field in the result_metadata.

(defn- add-sql-names
  [{:keys [result_metadata] :as model}]
  (update model :result_metadata
          #(->> %
                (map (comp normalize-name :display_name))
                disambiguate
                (map (fn [rsmd [_ disambiguated-name]]
                       (assoc rsmd :sql_name disambiguated-name)) result_metadata))))

Create a 'denormalized' version of the model which is optimized for querying. All foreign keys are resolved as data, sql-friendly names are added, and an inner_query is added that is a 'plain sql' query of the data (with sql friendly column names) that can be used to query this model.

(defn denormalize-model
  [{model-name :name :as model}]
  (-> model
      add-qp-column-aliases
      add-sql-names
      add-inner-query
      (update :result_metadata #(mapv denormalize-field %))
      (assoc :sql_name (normalize-name model-name))
      add-create-table-ddl
      (dissoc :creator_id :dataset_query :table_id :collection_position)))

Convert a map of {:models ...} to a json string summary of these models. This is used as a summary of the database in prompt engineering.

(defn- models->json-summary
  [{:keys [models]}]
  (let [json-str (json/generate-string
                  {:tables
                   (for [{model-name :name model-id :id :keys [result_metadata] :as _model} models]
                     {:table-id     model-id
                      :table-name   model-name
                      :column-names (mapv :display_name result_metadata)})}
                  {:pretty true})
        nchars   (count json-str)]
    (log/debugf "Database json string descriptor contains %s chars (~%s tokens)."
                nchars
                (quot nchars 4))
    json-str))
(defn- add-model-json-summary [database]
  (assoc database :model_json_summary (models->json-summary database)))

For a field, create a potential enumerated type string. Returns nil if there are no field values or the cardinality is too high.

(defn- field->pseudo-enums
  ([{table-name :name} {field-name :name field-id :id :keys [base_type]} enum-cardinality-threshold]
   (when-let [values (and
                      (not= :type/Boolean base_type)
                      (t2/select-one-fn :values FieldValues :field_id field-id))]
     (when (<= (count values) enum-cardinality-threshold)
       (let [ddl-str (format "create type %s_%s_t as enum %s;"
                             table-name
                             field-name
                             (str/join ", " (map (partial format "'%s'") values)))
             nchars  (count ddl-str)]
         (log/debugf "Pseudo-ddl for field enum %s describes %s values and contains %s chars (~%s tokens)."
                     field-name
                     (count values)
                     nchars
                     (quot nchars 4))
         ddl-str))))
  ([table field]
   (field->pseudo-enums table field (metabot-settings/enum-cardinality-threshold))))

Create an 'approximate' ddl to represent how this table might be created as SQL. This can be very expensive if performed over an entire database, so memoization is recommended. Memoization currently happens in create-table-embedding.

(defn table->pseudo-ddl
  ([{table-name :name schema-name :schema table-id :id :as table} enum-cardinality-threshold]
   (let [fields       (t2/select [Field
                                  :base_type
                                  :database_required
                                  :database_type
                                  :fk_target_field_id
                                  :id
                                  :name
                                  :semantic_type]
                        :table_id table-id)
         enums        (reduce
                       (fn [acc {field-name :name :as field}]
                         (if-some [enums (field->pseudo-enums table field enum-cardinality-threshold)]
                           (assoc acc field-name enums)
                           acc))
                       {}
                       fields)
         columns      (vec
                       (for [{column-name :name :keys [database_required database_type]} fields]
                         (cond-> [column-name
                                  (if (enums column-name)
                                    (format "%s_%s_t" table-name column-name)
                                    database_type)]
                           database_required
                           (conj [:not nil]))))
         primary-keys [[(into [:primary-key]
                              (comp (filter (comp #{:type/PK} :semantic_type))
                                    (map :name))
                              fields)]]
         foreign-keys (for [{field-name :name :keys [semantic_type fk_target_field_id]} fields
                            :when (= :type/FK semantic_type)
                            :let [{fk-field-name :name fk-table-id :table_id} (t2/select-one [Field :name :table_id]
                                                                                :id fk_target_field_id)
                                  {fk-table-name :name fk-table-schema :schema} (t2/select-one [Table :name :schema]
                                                                                  :id fk-table-id)]]
                        [[:foreign-key field-name]
                         [:references (cond->>
                                       fk-table-name
                                        fk-table-schema
                                        (format "%s.%s" fk-table-schema))
                          fk-field-name]])
         create-sql   (->
                       (sql/format
                        {:create-table (keyword schema-name table-name)
                         :with-columns (reduce into columns [primary-keys foreign-keys])}
                        {:dialect :ansi :pretty true})
                       first
                       mdb.query/format-sql)
         ddl-str      (str/join "\n\n" (conj (vec (vals enums)) create-sql))
         nchars       (count ddl-str)]
     (log/debugf "Pseudo-ddl for table '%s.%s'(%s) describes %s fields, %s enums, and contains %s chars (~%s tokens)."
                 schema-name
                 table-name
                 table-id
                 (count fields)
                 (count enums)
                 nchars
                 (quot nchars 4))
     ddl-str))
  ([table]
   (table->pseudo-ddl table (metabot-settings/enum-cardinality-threshold))))

Create a 'denormalized' version of the database which is optimized for querying. Adds in denormalized models, sql-friendly names, and a json summary of the models appropriate for prompt engineering.

(defn denormalize-database
  [{database-name :name db_id :id :as database}]
  (let [models (t2/select Card :database_id db_id :dataset true)]
    (-> database
        (assoc :sql_name (normalize-name database-name))
        (assoc :models (mapv denormalize-model models))
        add-model-json-summary)))

Pseudo-ddls -> Embeddings ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Given a table (and an optional threshold to downsize the generated table enums) will compute relevant embedding information: - prompt: The prompt encoded for the table (a pseudo create table ddl) - embedding: A vector of doubles that encodes the prompt for embedding comparison - tokens: The number of tokens used to encode the prompt

This function will recursively try to create an embedding for the table pseudo-ddl starting with the default enum cardinality (distinct fields at or below this count are turned into DDL enums).

If the creation fails, will try again with the enum threshold divided by 2 until either a result is generated or the operation fails (returning nil). Although returning nil (vs throwing) may mask the fact that a particular table isn't present in the final embeddings set, this allows for queries over the rest of the database, which is preferred. Anything so large (the table name, column names, and base column types have to exceed the token limit) is probably going to be problematic and a model would be a better fit anyways.

(defn create-table-embedding
  ([{table-name :name table-id :id :as table} enum-cardinality-threshold]
   (log/debugf
    "Creating embedding for table '%s'(%s) with cardinality threshold '%s'."
    table-name
    table-id
    enum-cardinality-threshold)
   (try
     (let [ddl (table->pseudo-ddl table enum-cardinality-threshold)
           {:keys [prompt embedding tokens]} (metabot-client/create-embedding ddl)]
       {:prompt    prompt
        :embedding embedding
        :tokens    tokens})
     ;; The most likely case of throwing here is that the ddl is too big.
     ;; When this happens, we'll try again with 1/2 the cardinality selected.
     ;; This will reduce the number of fields that become enumerated.
     ;; In the extreme case (= enum-cardinality-threshold 0), no enums are created.
     ;; The only way this would fail to create an embedding would be if the number
     ;; of columns were so huge that just that list of columns and types exceeded
     ;; the embedding token limit.
     (catch Exception e
       (let [{:keys [status-code message]} (ex-data e)]
         (if (and (pos? enum-cardinality-threshold)
                  (= 400 status-code))
           (let [new-enum-cardinality-threshold (quot enum-cardinality-threshold 2)]
             (log/debugf
              (str
               "Embedding creation for table '%s'(%s) with cardinality threshold '%s' failed. "
               "Retrying again with cardinality threshold '%s'.")
              table-name
              table-id
              enum-cardinality-threshold
              new-enum-cardinality-threshold)
             (create-table-embedding table new-enum-cardinality-threshold))
           ;; Instead of throwing an exception, we are going to try to recover and
           ; ignore the problematic table. This is likely a massive table with too
           ;; many columns and would be a better candidate for a model.
           (log/warnf
            (str/join
             " "
             ["Embeddings for table '%s'(%s) could not be generated."
              "It could be that this table has too many columns."
              "You might want to create a model for this table instead."
              "Error message: %s"])
            table-name
            table-id
            message))))))
  ([table]
   (create-table-embedding table (metabot-settings/enum-cardinality-threshold))))

Memoized version of create-table-embedding. Generally embeddings are small, so this is a reasonable tradeoff, especially when the number of tables in a db is large. Should probably have the same threshold as metabot-client/memoized-create-embedding.

(def memoized-create-table-embedding
  (memoize/ttl
   ^{::memoize/args-fn (fn [[{table-id :id} enum-cardinality-threshold]]
                         [table-id enum-cardinality-threshold])}
   create-table-embedding
    ;; 24-hour ttl
   :ttl/threshold (* 1000 60 60 24)))

Prompt Input ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Given a prompt template and a context, fill the template messages in with the appropriate values to create the actual submitted messages.

(defn- prompt-template->messages
  [{:keys [messages]} context]
  (letfn [(update-contents [s]
            (str/replace s #"%%([^%]+)%%"
                         (fn [[_ path]]
                           (let [kw (->> (str/split path #":")
                                         (mapv (comp keyword u/lower-case-en)))]
                             (or (get-in context kw)
                                 (let [message (format "No value found in context for key path '%s'" kw)]
                                   (throw (ex-info
                                           message
                                           {:message     message
                                            :status-code 400}))))))))]
    (map (fn [prompt] (update prompt :content update-contents)) messages)))

Retrieve prompt templates from the metabot-get-prompt-templates-url.

(defn- default-prompt-templates
  []
  (log/info "Refreshing metabot prompt templates.")
  (let [all-templates (-> (metabot-settings/metabot-get-prompt-templates-url)
                          slurp
                          (json/parse-string keyword))]
    (-> (group-by (comp keyword :prompt_template) all-templates)
        (update-vals
         (fn [templates]
           (let [ordered (vec (sort-by :version templates))]
             {:latest    (peek ordered)
              :templates ordered}))))))

Return a map of prompt templates with keys of template type and values which are objects containing keys 'latest' (the latest template version) and 'templates' (all template versions).

(def ^:private ^:dynamic *prompt-templates*
  (memoize/ttl
   default-prompt-templates
    ;; Check for updates every hour
   :ttl/threshold (* 1000 60 60)))

Create a prompt by looking up the latest template for the prompt_task type of the context interpolating all values from the template. The returned value is the template object with the prompt contained in the ':prompt' key.

(defn create-prompt
  [{:keys [prompt_task] :as context}]
  (if-some [{:keys [messages] :as template} (get-in (*prompt-templates*) [prompt_task :latest])]
    (let [prompt (assoc template
                        :message_templates messages
                        :messages (prompt-template->messages template context))]
      (let [nchars (count (mapcat :content messages))]
        (log/debugf "Prompt running with %s chars (~%s tokens)." nchars (quot nchars 4)))
      prompt)
    (throw
     (ex-info
      (format "No prompt inference template found for prompt type: %s" prompt_task)
      {:prompt_type prompt_task}))))

Results Processing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Is this a simple SELECT * query?

(defn select-all?
  [sql]
  (some? (re-find #"(?i)^select\s*\*" sql)))

Given a set of choices returned from the bot, find the first one returned by the supplied message-fn.

(defn find-result
  [message-fn {:keys [choices]}]
  (or
   (some
    (fn [{:keys [message]}]
      (when-some [res (message-fn (:content message))]
        res))
    choices)
   (log/infof
    "Unable to find appropriate result for user prompt in responses:\n\t%s"
    (str/join "\n\t" (map (fn [m] (get-in m [:message :content])) choices)))))

Search a provided string for a SQL block

(defn extract-sql
  [s]
  (let [sql (if (str/starts-with? (u/upper-case-en (str/trim s)) "SELECT")
              ;; This is just a raw SQL statement
              s
              ;; It looks like markdown
              (let [[_pre sql _post] (str/split s #"```(sql|SQL)?")]
                sql))]
    (mdb.query/format-sql sql)))

Produce the final query usable by the UI but converting the model to a CTE and calling the bot sql on top of it.

(defn bot-sql->final-sql
  [{:keys [inner_query sql_name] :as _denormalized-model} outer-query]
  (format "WITH %s AS (%s) %s" sql_name inner_query outer-query))

Given a response from the LLM, map this to visualization settings. Default to a table.

(defn response->viz
  [{:keys [display description visualization_settings]}]
  (let [display (keyword display)
        {:keys [x-axis y-axis]} visualization_settings]
    (case display
      (:line :bar :area :waterfall) {:display                display
                                     :name                   description
                                     :visualization_settings {:graph.dimensions [x-axis]
                                                              :graph.metrics    y-axis}}
      :scalar {:display                display
               :name                   description
               :visualization_settings {:graph.metrics    y-axis
                                        :graph.dimensions []}}
      {:display                :table
       :name                   description
       :visualization_settings {:title description}})))

Embedding Selection ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Given a set of 'prompt objects' (a seq of items with keys :embedding :tokens :prompt), and a prompt will add the :prompt and :prompt_match to each object.

(defn score-prompt-embeddings
  [prompt-objects user-prompt]
  (let [dot (fn dot [a b] (reduce + (map * a b)))
        {prompt-embedding :embedding} (metabot-client/create-embedding user-prompt)]
    (map
     (fn [{:keys [embedding] :as prompt-object}]
       (assoc prompt-object
              :user_prompt user-prompt
              :prompt_match (dot prompt-embedding embedding)))
     prompt-objects)))

Given a set of 'prompt objects' (a seq of items with keys :embedding :tokens :prompt), will determine the set of prompts that best match the given prompt whose token sum does not exceed the token limit.

(defn generate-prompt
  ([prompt-objects prompt token-limit]
   (->> (score-prompt-embeddings prompt-objects prompt)
        (sort-by (comp - :prompt_match))
        (reduce
         (fn [{:keys [total-tokens] :as acc} {:keys [prompt tokens]}]
           (if (> (+ tokens total-tokens) token-limit)
             (reduced acc)
             (-> acc
                 (update :total-tokens + tokens)
                 (update :prompts conj prompt))))
         {:total-tokens 0 :prompts []})
        :prompts
        (str/join "\n")))
  ([prompt-objects prompt]
   (generate-prompt prompt-objects prompt (metabot-settings/metabot-prompt-generator-token-limit))))

Given a set of 'prompt objects' (a seq of items with keys :embedding :tokens :prompt), will return the item that best matches the input prompt.

(defn best-prompt-object
  ([prompt-objects prompt]
   (some->> (score-prompt-embeddings prompt-objects prompt)
            seq
            (apply max-key :prompt_match))))
 
(ns metabase.models
  (:require
   [metabase.models.action :as action]
   [metabase.models.activity :as activity]
   [metabase.models.application-permissions-revision :as a-perm-revision]
   [metabase.models.bookmark :as bookmark]
   [metabase.models.card :as card]
   [metabase.models.collection :as collection]
   [metabase.models.collection-permission-graph-revision
    :as c-perm-revision]
   [metabase.models.dashboard :as dashboard]
   [metabase.models.dashboard-card :as dashboard-card]
   [metabase.models.dashboard-card-series :as dashboard-card-series]
   [metabase.models.dashboard-tab :as dashboard-tab]
   [metabase.models.database :as database]
   [metabase.models.dimension :as dimension]
   [metabase.models.field :as field]
   [metabase.models.field-values :as field-values]
   [metabase.models.login-history :as login-history]
   [metabase.models.metric :as metric]
   [metabase.models.metric-important-field :as metric-important-field]
   [metabase.models.model-index :as model-index]
   [metabase.models.moderation-review :as moderation-review]
   [metabase.models.native-query-snippet :as native-query-snippet]
   [metabase.models.parameter-card :as parameter-card]
   [metabase.models.permissions :as perms]
   [metabase.models.permissions-group :as perms-group]
   [metabase.models.permissions-group-membership
    :as perms-group-membership]
   [metabase.models.permissions-revision :as perms-revision]
   [metabase.models.persisted-info :as persisted-info]
   [metabase.models.pulse :as pulse]
   [metabase.models.pulse-card :as pulse-card]
   [metabase.models.pulse-channel :as pulse-channel]
   [metabase.models.pulse-channel-recipient :as pulse-channel-recipient]
   [metabase.models.query-cache :as query-cache]
   [metabase.models.query-execution :as query-execution]
   [metabase.models.revision :as revision]
   [metabase.models.secret :as secret]
   [metabase.models.segment :as segment]
   [metabase.models.session :as session]
   [metabase.models.setting :as setting]
   [metabase.models.table :as table]
   [metabase.models.table-privileges]
   [metabase.models.task-history :as task-history]
   [metabase.models.timeline :as timeline]
   [metabase.models.timeline-event :as timeline-event]
   [metabase.models.user :as user]
   [metabase.models.view-log :as view-log]
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.util :as u]
   [methodical.core :as methodical]
   [potemkin :as p]
   [toucan2.model :as t2.model]))

Fool the linter

(comment action/keep-me
         activity/keep-me
         card/keep-me
         bookmark/keep-me
         collection/keep-me
         c-perm-revision/keep-me
         dashboard/keep-me
         dashboard-card/keep-me
         dashboard-card-series/keep-me
         dashboard-tab/keep-me
         database/keep-me
         dimension/keep-me
         field/keep-me
         field-values/keep-me
         a-perm-revision/keep-me
         login-history/keep-me
         metric/keep-me
         moderation-review/keep-me
         metric-important-field/keep-me
         native-query-snippet/keep-me
         parameter-card/keep-me
         perms-group-membership/keep-me
         perms-group/keep-me
         perms-revision/keep-me
         perms/keep-me
         persisted-info/keep-me
         pulse-card/keep-me
         pulse-channel-recipient/keep-me
         pulse-channel/keep-me
         pulse/keep-me
         query-cache/keep-me
         query-execution/keep-me
         revision/keep-me
         secret/keep-me
         segment/keep-me
         session/keep-me
         setting/keep-me
         table/keep-me
         task-history/keep-me
         timeline-event/keep-me
         timeline/keep-me
         user/keep-me
         view-log/keep-me)
(p/import-vars
 [action Action HTTPAction ImplicitAction QueryAction]
 [activity Activity]
 [bookmark CardBookmark]
 [bookmark DashboardBookmark]
 [bookmark CollectionBookmark]
 [bookmark BookmarkOrdering]
 [card Card]
 [collection Collection]
 [c-perm-revision CollectionPermissionGraphRevision]
 [dashboard Dashboard]
 [dashboard-card DashboardCard]
 [dashboard-card-series DashboardCardSeries]
 [database Database]
 [dimension Dimension]
 [field Field]
 [field-values FieldValues]
 [login-history LoginHistory]
 [metric Metric]
 [moderation-review ModerationReview]
 [model-index ModelIndex ModelIndexValue]
 [metric-important-field MetricImportantField]
 [native-query-snippet NativeQuerySnippet]
 [parameter-card ParameterCard]
 [perms Permissions]
 [perms-group PermissionsGroup]
 [perms-group-membership PermissionsGroupMembership]
 [perms-revision PermissionsRevision]
 [a-perm-revision ApplicationPermissionsRevision]
 [persisted-info PersistedInfo]
 [pulse Pulse]
 [pulse-card PulseCard]
 [pulse-channel PulseChannel]
 [pulse-channel-recipient PulseChannelRecipient]
 [query-cache QueryCache]
 [query-execution QueryExecution]
 [revision Revision]
 [secret Secret]
 [segment Segment]
 [session Session]
 [setting Setting]
 [table Table]
 [task-history TaskHistory]
 [timeline Timeline]
 [timeline-event TimelineEvent]
 [user User]
 [view-log ViewLog])

OSS version; no-op.

(defenterprise resolve-enterprise-model
  metabase-enterprise.models
  [x]
  x)
(methodical/defmethod t2.model/resolve-model :before :default
  "Ensure the namespace for given model is loaded.
  This is a safety mechanism as we are moving to toucan2 and we don't need to require the model namespaces in order to use it."
  [x]
  (when (and (keyword? x)
             (= (namespace x) "model")
             ;; Don't try to require if it's already registered as a :metabase/model, since that means it has already
             ;; been required
             (not (isa? x :metabase/model)))
    (try
      (let [model-namespace (str "metabase.models." (u/->kebab-case-en (name x)))]
        ;; use `classloader/require` which is thread-safe and plays nice with our plugins system
        (classloader/require model-namespace))
      (catch clojure.lang.ExceptionInfo _
        (resolve-enterprise-model x))))
  x)
(methodical/defmethod t2.model/resolve-model :around clojure.lang.Symbol
  "Handle models deriving from :metabase/model."
  [symb]
  (or
    (when (simple-symbol? symb)
      (let [metabase-models-keyword (keyword "model" (name symb))]
        (when (isa? metabase-models-keyword :metabase/model)
          metabase-models-keyword)))
    (next-method symb)))
 
(ns metabase.models.action
  (:require
   [cheshire.core :as json]
   [medley.core :as m]
   [metabase.models.card :refer [Card]]
   [metabase.models.interface :as mi]
   [metabase.models.query :as query]
   [metabase.models.serialization :as serdes]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

-------------------------------------------- Entity & Life Cycle ----------------------------------------------

(methodical/defmethod t2/table-name :model/Action [_model] :action)
(methodical/defmethod t2/table-name :model/QueryAction [_model] :query_action)
(methodical/defmethod t2/table-name :model/HTTPAction [_model] :http_action)
(methodical/defmethod t2/table-name :model/ImplicitAction [_model] :implicit_action)

Action model

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the Actions symbol in our codebase.

QueryAction model

HTTPAction model

ImplicitAction model

(def Action                  :model/Action)
(def QueryAction        :model/QueryAction)
(def HTTPAction          :model/HTTPAction)
(def ImplicitAction  :model/ImplicitAction)
(def ^:private action-sub-models [:model/QueryAction :model/HTTPAction :model/ImplicitAction])
(doto :model/Action
  (derive :metabase/model)
  ;;; You can read/write an Action if you can read/write its model (Card)
  (derive ::mi/read-policy.full-perms-for-perms-set)
  (derive ::mi/write-policy.full-perms-for-perms-set)
  (derive :hook/entity-id)
  (derive :hook/timestamped?))
(doseq [model action-sub-models]
  (derive model :metabase/model))
(methodical/defmethod t2/primary-keys :model/QueryAction    [_model] [:action_id])
(methodical/defmethod t2/primary-keys :model/HTTPAction     [_model] [:action_id])
(methodical/defmethod t2/primary-keys :model/ImplicitAction [_model] [:action_id])
(def ^:private transform-action-visualization-settings
  {:in  mi/json-in
   :out (comp (fn [viz-settings]
                ;; the keys of :fields should be strings, not keywords
                (m/update-existing viz-settings :fields update-keys name))
              mi/json-out-with-keywordization)})
(t2/deftransforms :model/Action
  {:type                   mi/transform-keyword
   :parameter_mappings     mi/transform-parameters-list
   :parameters             mi/transform-parameters-list
   :visualization_settings transform-action-visualization-settings})
(t2/deftransforms :model/QueryAction
  ;; shouldn't this be mi/transform-metabase-query?
  {:dataset_query mi/transform-json})
(def ^:private transform-json-with-nested-parameters
  {:in  (comp mi/json-in
              (fn [template]
                (u/update-if-exists template :parameters mi/normalize-parameters-list)))
   :out (comp (fn [template]
                (u/update-if-exists template :parameters (mi/catch-normalization-exceptions mi/normalize-parameters-list)))
              mi/json-out-with-keywordization)})
(t2/deftransforms :model/HTTPAction
  {:template transform-json-with-nested-parameters})
(mi/define-simple-hydration-method model
  :model
  "Return the Card this action uses as a model."
  [{:keys [model_id]}]
  (t2/select-one Card :id model_id))
(defn- check-model-is-not-a-saved-question
  [model-id]
  (when-not (t2/select-one-fn :dataset Card :id model-id)
    (throw (ex-info (tru "Actions must be made with models, not cards.")
                    {:status-code 400}))))
(t2/define-before-insert :model/Action
  [{model-id :model_id, :as action}]
  (u/prog1 action
    (check-model-is-not-a-saved-question model-id)))
(t2/define-before-update :model/Action
  [{archived? :archived, id :id, model-id :model_id, :as changes}]
  (u/prog1 changes
    (if archived?
      (t2/delete! :model/DashboardCard :action_id id)
      (check-model-is-not-a-saved-question model-id))))
(defmethod mi/perms-objects-set :model/Action
  [instance read-or-write]
  (mi/perms-objects-set (t2/select-one Card :id (:model_id instance)) read-or-write))

The columns that are common to all Action types.

(def action-columns
  [:archived :created_at :creator_id :description :entity_id :made_public_by_id :model_id :name :parameter_mappings
   :parameters :public_uuid :type :updated_at :visualization_settings])

Returns the model from an action type. action-type can be a string or a keyword.

(defn type->model
  [action-type]
  (case action-type
    :http     :model/HTTPAction
    :implicit :model/ImplicitAction
    :query    :model/QueryAction))

------------------------------------------------ CRUD fns -----------------------------------------------------

Inserts an Action and related type table. Returns the action id.

(defn insert!
  [action-data]
  (t2/with-transaction [_conn]
    (let [action (first (t2/insert-returning-instances! Action (select-keys action-data action-columns)))
          model  (type->model (:type action))]
      (t2/query-one {:insert-into (t2/table-name model)
                     :values [(-> (apply dissoc action-data action-columns)
                                  (assoc :action_id (:id action))
                                  (cond->
                                    (= (:type action) :implicit)
                                    (dissoc :database_id)
                                    (= (:type action) :http)
                                    (update :template json/encode)
                                    (= (:type action) :query)
                                    (update :dataset_query json/encode)))]})
      (:id action))))

Updates an Action and the related type table. Deletes the old type table row if the type has changed.

(defn update!
  [{:keys [id] :as action} existing-action]
  (when-let [action-row (not-empty (select-keys action action-columns))]
    (t2/update! Action id action-row))
  (when-let [type-row (not-empty (cond-> (apply dissoc action :id action-columns)
                                         (= (or (:type action) (:type existing-action))
                                            :implicit)
                                         (dissoc :database_id)))]
    (let [type-row (assoc type-row :action_id id)
          existing-model (type->model (:type existing-action))]
      (if (and (:type action) (not= (:type action) (:type existing-action)))
        (let [new-model (type->model (:type action))]
          (t2/delete! existing-model :action_id id)
          (t2/insert! new-model (assoc type-row :action_id id)))
        (t2/update! existing-model id type-row)))))
(defn- hydrate-subtype [action]
  (let [subtype (type->model (:type action))]
    (-> action
        (merge (t2/select-one subtype :action_id (:id action)))
        (dissoc :action_id))))
(defn- normalize-query-actions [actions]
  (when (seq actions)
    (let [query-actions (t2/select QueryAction :action_id [:in (map :id actions)])
          action-id->query-actions (m/index-by :action_id query-actions)]
      (for [action actions]
        (merge action (-> action :id action-id->query-actions (dissoc :action_id)))))))
(defn- normalize-http-actions [actions]
  (when (seq actions)
    (let [http-actions (t2/select HTTPAction :action_id [:in (map :id actions)])
          http-actions-by-action-id (m/index-by :action_id http-actions)]
      (map (fn [action]
             (let [http-action (get http-actions-by-action-id (:id action))]
               (-> action
                   (merge
                     {:disabled false}
                     (select-keys http-action [:template :response_handle :error_handle])
                     (select-keys (:template http-action) [:parameters :parameter_mappings])))))
           actions))))
(defn- normalize-implicit-actions [actions]
  (when (seq actions)
    (let [implicit-actions (t2/select ImplicitAction :action_id [:in (map :id actions)])
          implicit-actions-by-action-id (m/index-by :action_id implicit-actions)]
      (map (fn [action]
             (let [implicit-action (get implicit-actions-by-action-id (:id action))]
               (merge action
                     (select-keys implicit-action [:kind]))))
           actions))))

Select Actions and fill in sub type information. Don't use this if you need implicit parameters for implicit actions, use [[select-action]] instead. options is passed to t2/select & options arg.

(defn- select-actions-without-implicit-params
  [& options]
  (let [{:keys [query http implicit]} (group-by :type (apply t2/select Action options))
        query-actions                 (normalize-query-actions query)
        http-actions                  (normalize-http-actions http)
        implicit-actions              (normalize-implicit-actions implicit)]
    (sort-by :updated_at (concat query-actions http-actions implicit-actions))))

Makes sure that if coll is indexed by index-by, no keys will be in conflict.

(defn unique-field-slugs?
  [fields]
  (empty? (m/filter-vals #(not= % 1) (frequencies (map (comp u/slugify :name) fields)))))

Returns a map of card-id -> implicit-parameters for the given models

(defn- implicit-action-parameters
  [cards]
  (let [card-by-table-id (into {}
                               (for [card cards
                                     :let [{:keys [table-id]} (query/query->database-and-table-ids (:dataset_query card))]
                                     :when table-id]
                                 [table-id card]))
        tables (when-let [table-ids (seq (keys card-by-table-id))]
                 (t2/hydrate (t2/select 'Table :id [:in table-ids]) :fields))]
    (into {}
          (for [table tables
                :let [fields (:fields table)]
                ;; Skip tables for have conflicting slugified columns i.e. table has "name" and "NAME" columns.
                :when (unique-field-slugs? fields)
                :let [card         (get card-by-table-id (:id table))
                      id->metadata (m/index-by :id (:result_metadata card))
                      parameters (->> fields
                                      ;; get display_name from metadata
                                      (keep (fn [field]
                                              (when-let [metadata (id->metadata (:id field))]
                                                (assoc field :display_name (:display_name metadata)))))
                                      ;; remove exploded json fields and any structured field
                                      (remove (some-fn
                                               ;; exploded json fields can't be recombined in sql yet
                                               :nfc_path
                                               ;; their parents, a json field, nor things like cidr, macaddr, xml, etc
                                               (comp #(isa? % :type/Structured) :effective_type)
                                               ;; or things which we don't recognize
                                               (comp #{:type/*} :effective_type)))
                                      (map (fn [field]
                                             {:id (u/slugify (:name field))
                                              :display-name (:display_name field)
                                              :target [:variable [:template-tag (u/slugify (:name field))]]
                                              :type (:base_type field)
                                              :required (:database_required field)
                                              :is-auto-increment (:database_is_auto_increment field)
                                              ::field-id (:id field)
                                              ::pk? (isa? (:semantic_type field) :type/PK)})))]]
            [(:id card) parameters]))))

Find actions with given options and generate implicit parameters for execution. Also adds the :database_id of the model for implicit actions.

Pass in known-models to save a second Card lookup.

(defn select-actions
  [known-models & options]
  (let [actions                       (apply select-actions-without-implicit-params options)
        implicit-action-model-ids     (set (map :model_id (filter #(= :implicit (:type %)) actions)))
        implicit-action-models        (if known-models
                                        (->> known-models
                                             (filter #(contains? implicit-action-model-ids (:id %)))
                                             distinct)
                                        (when (seq implicit-action-model-ids)
                                          (t2/select 'Card :id [:in implicit-action-model-ids])))
        model-id->db-id               (into {} (for [card implicit-action-models]
                                                 [(:id card) (:database_id card)]))
        model-id->implicit-parameters (when (seq implicit-action-models)
                                        (implicit-action-parameters implicit-action-models))]
    (for [action actions]
      (if (= (:type action) :implicit)
        (let [model-id        (:model_id action)
              saved-params    (m/index-by :id (:parameters action))
              action-kind     (:kind action)
              implicit-params (cond->> (get model-id->implicit-parameters model-id)
                                :always
                                (map (fn [param] (merge param (get saved-params (:id param)))))
                                (= "row/delete" action-kind)
                                (filter ::pk?)
                                (= "row/create" action-kind)
                                (remove #(or (:is-auto-increment %)
                                             ;; non-required PKs like column with default is uuid_generate_v4()
                                             (and (::pk? %) (not (:required %)))))
                                (contains? #{"row/update" "row/delete"} action-kind)
                                (map (fn [param] (cond-> param (::pk? param) (assoc :required true))))
                                :always
                                (map #(dissoc % ::pk? ::field-id)))]
          (cond-> (assoc action :database_id (model-id->db-id (:model_id action)))
            (seq implicit-params)
            (-> (assoc :parameters implicit-params)
                (update-in [:visualization_settings :fields]
                           (fn [fields]
                             (let [param-ids (map :id implicit-params)
                                   fields    (->> (or fields {})
                                                  ;; remove entries that don't match params (in case of deleted columns)
                                                  (m/filter-keys (set param-ids)))]
                               ;; add default entries for params that don't have an entry
                               (reduce (fn [acc param-id]
                                         (if (contains? acc param-id)
                                           acc
                                           (assoc acc param-id {:id param-id, :hidden false})))
                                       fields
                                       param-ids)))))))
        action))))

Selects an Action and fills in the subtype data and implicit parameters. options is passed to t2/select-one & options arg.

(defn select-action
  [& options]
  (first (apply select-actions nil options)))

Adds a boolean field :database-enabled-actions to each action according to the database-enable-actions setting for the action's database.

(defn- map-assoc-database-enable-actions
  [actions]
  (let [action-ids                  (map :id actions)
        get-database-enable-actions (fn [{:keys [settings]}]
                                      (boolean (some-> settings
                                                       ((get-in (t2/transforms :model/Database) [:settings :out]))
                                                       :database-enable-actions)))
        id->database-enable-actions (into {}
                                          (map (juxt :id get-database-enable-actions))
                                          (t2/query {:select [:action.id :db.settings]
                                                     :from   :action
                                                     :join   [[:report_card :card] [:= :card.id :action.model_id]
                                                              [:metabase_database :db] [:= :db.id :card.database_id]]
                                                     :where  [:in :action.id action-ids]}))]
    (map (fn [action]
           (assoc action :database_enabled_actions (get id->database-enable-actions (:id action))))
         actions)))
(mi/define-batched-hydration-method dashcard-action
  :dashcard/action
  "Hydrates actions from DashboardCards. Adds a boolean field `:database-enabled-actions` to each action according to the
   `database-enable-actions` setting for the action's database."
  [dashcards]
  (let [actions-by-id (when-let [action-ids (seq (keep :action_id dashcards))]
                        (->> (select-actions nil :id [:in action-ids])
                             map-assoc-database-enable-actions
                             (m/index-by :id)))]
    (for [dashcard dashcards]
      (m/assoc-some dashcard :action (get actions-by-id (:action_id dashcard))))))

Get the action associated with a dashcard if exists, return nil otherwise.

(defn dashcard->action
  [dashcard-or-dashcard-id]
  (some->> (t2/select-one-fn :action_id :model/DashboardCard :id (u/the-id dashcard-or-dashcard-id))
           (select-action :id)))

------------------------------------------------ Serialization ---------------------------------------------------

(defmethod serdes/extract-query "Action" [_model _opts]
  (eduction (map hydrate-subtype)
            (t2/reducible-select Action)))
(defmethod serdes/hash-fields :model/Action [_action]
  [:name (serdes/hydrated-hash :model) :created_at])
(defmethod serdes/extract-one "Action" [_model-name _opts action]
  (-> (serdes/extract-one-basics "Action" action)
      (update :creator_id serdes/*export-user*)
      (update :model_id serdes/*export-fk* 'Card)
      (update :type name)
      (cond-> (= (:type action) :query)
        (update :database_id serdes/*export-fk-keyed* 'Database :name))))
(defmethod serdes/load-xform "Action" [action]
  (-> action
      serdes/load-xform-basics
      (update :creator_id serdes/*import-user*)
      (update :model_id serdes/*import-fk* 'Card)
      (update :type keyword)
      (cond-> (= (:type action) "query")
        (update :database_id serdes/*import-fk-keyed* 'Database :name))))
(defmethod serdes/ingested-model-columns "Action" [_ingested]
  (into #{} (conj action-columns :database_id :dataset_query :kind :template :response_handle :error_handle :type)))
(defmethod serdes/load-update! "Action" [_model-name ingested local]
  (log/tracef "Upserting Action %d: old %s new %s" (:id local) (pr-str local) (pr-str ingested))
  (update! (assoc ingested :id (:id local)) local)
  (select-action :id (:id local)))
(defmethod serdes/load-insert! "Action" [_model-name ingested]
  (log/tracef "Inserting Action: %s" (pr-str ingested))
  (insert! ingested))
(defmethod serdes/dependencies "Action" [action]
  (concat [[{:model "Card" :id (:model_id action)}]]
    (when (= (:type action) "query")
      [[{:model "Database" :id (:database_id action)}]])))
(defmethod serdes/storage-path "Action" [action _ctx]
  (let [{:keys [id label]} (-> action serdes/path last)]
    ["actions" (serdes/storage-leaf-file-name id label)]))
 
(ns metabase.models.activity
  (:require
   [metabase.api.common :as api]
   [metabase.models.interface :as mi]
   [metabase.util.malli :as mu]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

------------------------------------------------- Perms Checking -------------------------------------------------

(def ^:private model->entity
  {"card"      :model/Card
   "dashboard" :model/Dashboard
   "metric"    :model/Metric
   "pulse"     :model/Pulse
   "segment"   :model/Segment})

Implementation for can-read?/can-write? for items in the activity feed. Dispatches off of the activity :topic, e.g. :user-joined. perms-check-fn is can-read? or can-write? and should be called as needed on models the activity records.

(defmulti can-?
  {:arglists '([perms-check-fn activity])}
  (fn [_ {:keys [topic]}]
    topic))

For now only admins can see when another user joined -- we don't want every user knowing about every other user. In the future we might want to change this and come up with some sort of system where we can determine which users get to see other users -- perhaps if they are in a group together other than 'All Users'

(defmethod can-? :user-joined [_ _]
  api/*is-superuser?*)

For every other activity topic we'll look at the read/write perms for the object the activty is about (e.g. a Card or Dashboard). For all other activity feed items with no model everyone can read/write

(defmethod can-? :default [perms-check-fn {model :model, model-id :model_id}]
  (if-let [object (when-let [entity (model->entity model)]
                    (t2/select entity model-id))]
    (perms-check-fn object)
    true))

----------------------------------------------- Entity & Lifecycle -----------------------------------------------

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase.

(def Activity
  :model/Activity)
(methodical/defmethod t2/table-name :model/Activity [_model] :activity)
(t2/define-before-insert :model/Activity
  [activity]
  (let [defaults {:timestamp :%now
                  :details   {}}]
    (merge defaults activity)))
(t2/deftransforms :model/Activity
 {:details mi/transform-json
  :topic   mi/transform-keyword})
(doto :model/Activity
  (derive :metabase/model))
(defmethod mi/can-read? :model/Activity
  [& args]
  (apply can-? mi/can-read? args))
(defmethod mi/can-write? Activity
  [& args]
  (apply can-? mi/can-write? args))

------------------------------------------------------ Etc. ------------------------------------------------------

Persistence Functions

TODO - this is probably the exact wrong way to have written this functionality. This could have been a multimethod or protocol, and various entity classes could implement it; Furthermore, we could have just used current-user-id to get the responsible user, instead of leaving it open to user error.

Inserts a new Activity entry.

Takes the following kwargs: :topic Required. The activity topic. :user-id Required. ID of the User responsible for the activity. :model Required. name of the model representing the activity. :model-id Required. ID of the model representing the activity. :object Optional. The activity object being saved. :database-id Optional. ID of the Database related to the activity. :table-id Optional. ID of the Table related to the activity. :details Optional. Details of the activity.

ex: (record-activity! :topic :event/segment-update :object segment :database-id 1 :table-id 13)

(mu/defn record-activity!
  [{:keys [topic object details database-id
           table-id user-id model model-id]
    :or   {object {}}}                      :- [:map {:closed true}
                                                [:topic                        :keyword]
                                                [:user-id     {:optional true} [:maybe pos-int?]]
                                                [:model       {:optional true} [:maybe :string]]
                                                [:model-id    {:optional true} [:maybe pos-int?]]
                                                [:object      {:optional true} [:maybe :map]]
                                                [:details     {:optional true} [:maybe :map]]
                                                [:database-id {:optional true} [:maybe pos-int?]]
                                                [:table-id    {:optional true} [:maybe pos-int?]]]]
  (first (t2/insert-returning-instances! Activity
                                         ;; strip off the `:event/` namespace of the topic, added in 0.48.0
                                         :topic       (keyword (name topic))
                                         :user_id     user-id
                                         :model       model
                                         :model_id    model-id
                                         :database_id database-id
                                         :table_id    table-id
                                         ;; TODO: test if this custom id is tracked
                                         :custom_id   (:custom_id object)
                                         :details     (or details object))))
 
(ns metabase.models.api-key
  (:require [crypto.random :as crypto-random]
            [metabase.models.audit-log :as audit-log]
            [metabase.models.interface :as mi]
            [metabase.models.permissions-group :as perms-group]
            [metabase.util :as u]
            [metabase.util.password :as u.password]
            [metabase.util.secret :as u.secret]
            [methodical.core :as methodical]
            [toucan2.core :as t2]))

the prefix length, the length of mb_1234

(def ^:private prefix-length 7)

the total number of bytes of randomness we generate for API keys

(def ^:private bytes-key-length 32)
(methodical/defmethod t2/table-name :model/ApiKey [_model] :api_key)
(mi/define-batched-hydration-method add-group
  :group
  "Add to each ApiKey a single group. Assume that each ApiKey is a member of either zero or one groups other than
  the 'All Users' group."
  [api-keys]
  (when (seq api-keys)
    (let [api-key-id->permissions-groups
          (group-by :api-key-id
                    (t2/query {:select [[:pg.name :group-name]
                                        [:pg.id :group-id]
                                        [:api_key.id :api-key-id]]
                               :from   [[:permissions_group :pg]]
                               :join   [[:permissions_group_membership :pgm]
                                      [:= :pgm.group_id :pg.id]
                                      :api_key [:= :api_key.user_id :pgm.user_id]]
                               :where  [:in :api_key.id (map u/the-id api-keys)]}))
          api-key-id->group
          (fn [api-key-id]
            (let [{name :group-name
                   id   :group-id} (->> (api-key-id->permissions-groups api-key-id)
                                      (sort-by #(= (:group-id %) (u/the-id (perms-group/all-users))))
                                      first)]
              {:name name :id id}))]
      (for [api-key api-keys]
        (assoc api-key :group (api-key-id->group (u/the-id api-key)))))))
(doto :model/ApiKey
  (derive :metabase/model)
  (derive :hook/timestamped?))

Given an API key, returns the standardized prefix for that API key.

(defn prefix
  [key]
  (apply str (take prefix-length key)))
(defn- add-prefix [{:keys [unhashed_key] :as api-key}]
  (cond-> api-key
    (contains? api-key :unhashed_key)
    (assoc :key_prefix (some-> unhashed_key u.secret/expose prefix))))

Generates a new API key - a random base64 string prefixed with mb_

(defn generate-key
  []
  (u.secret/secret
   (str "mb_" (crypto-random/base64 bytes-key-length))))
(def ^:private string-key-length (count (u.secret/expose (generate-key))))

Given an API key, returns a string of the same length with all but the prefix masked with *s

(defn mask
  [key]
  (->> (concat (prefix key) (repeat "*"))
       (take string-key-length)
       (apply str)))

Adds the key based on the unhashed_key passed in.

(defn- add-key
  [{:keys [unhashed_key] :as api-key}]
  (cond-> api-key
    (contains? api-key :unhashed_key)
    (assoc :key (some-> unhashed_key u.secret/expose u.password/hash-bcrypt))
    true (dissoc :unhashed_key)))
(t2/define-before-insert :model/ApiKey
  [api-key]
  (-> api-key
      add-prefix
      add-key))
(t2/define-before-update :model/ApiKey
  [api-key]
  (-> api-key
      add-prefix
      add-key))
(defn- add-masked-key [api-key]
  (if-let [prefix (:key_prefix api-key)]
    (assoc api-key :masked_key (mask prefix))
    api-key))
(t2/define-after-select :model/ApiKey
  [api-key]
  (-> api-key
      add-masked-key))
(defmethod audit-log/model-details :model/ApiKey
  [entity _event-type]
  (select-keys entity [:name :group :key_prefix :user_id]))
 
(ns metabase.models.application-permissions-revision
  (:require
   [metabase.models.interface :as mi]
   [metabase.util.i18n :refer [tru]]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase.

(def ApplicationPermissionsRevision
  :model/ApplicationPermissionsRevision)
(methodical/defmethod t2/table-name :model/ApplicationPermissionsRevision [_model] :application_permissions_revision)
(doto :model/ApplicationPermissionsRevision
  (derive :metabase/model)
  (derive :hook/created-at-timestamped?))
(t2/deftransforms :model/ApplicationPermissionsRevision
  {:before mi/transform-json
   :after  mi/transform-json})
(t2/define-before-update :model/ApplicationPermissionsRevision
  [_]
  (throw (Exception. (tru "You cannot update a PermissionsRevision!"))))

Return the ID of the newest ApplicationPermissionsRevision, or zero if none have been made yet. (This is used by the permissions graph update logic that checks for changes since the original graph was fetched).

(defn latest-id
  []
  (or (t2/select-one-pk ApplicationPermissionsRevision {:order-by [[:id :desc]]})
      0))
 

Model defenition for the Metabase Audit Log, which tracks actions taken by users across the Metabase app. This is distinct from the Activity and View Log models, which predate this namespace, and which power specific API endpoints used for in-app functionality, such as the recently-viewed items displayed on the homepage.

(ns metabase.models.audit-log
  (:require
   [clojure.data :as data]
   [clojure.set :as set]
   [metabase.api.common :as api]
   [metabase.models.activity :as activity]
   [metabase.models.interface :as mi]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.util :as u]
   [metabase.util.malli :as mu]
   [metabase.util.malli.registry :as mr]
   [metabase.util.malli.schema :as ms]
   [methodical.core :as m]
   [steffan-westcott.clj-otel.api.trace.span :as span]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)
(doto :model/AuditLog
  (derive :metabase/model))
(m/defmethod t2/table-name :model/AuditLog
  [_model]
  :audit_log)
(t2/deftransforms :model/AuditLog
  {:topic   mi/transform-keyword
   :details mi/transform-json})

Returns a map with data about an entity that should be included in the details column of the Audit Log.

(defmulti model-details
  {:arglists '([entity event-type])}
  mi/dispatch-on-model)
(defmethod model-details :default
  [_entity _event-type]
  {})
(def ^:private model-name->audit-logged-name
  {"RootCollection" "Collection"})

Given an instance of a model or a keyword model identifier, returns the name to store in the database as a string, or nil if it cannot be computed.

(defn model-name
  [instance-or-model]
  (let [model (or (t2/model instance-or-model) instance-or-model)
        raw-model-name (cond
                         (keyword? model) (name model)
                         (class? model) (.getSimpleName ^java.lang.Class model))]
    (model-name->audit-logged-name raw-model-name raw-model-name)))

Returns a map with previous and new versions of the objects, _keeping only fields that are present in both but have changed values_.

(defn- prepare-update-event-data
  [object previous-object]
  (let [[previous-only new-only _both] (data/diff previous-object object)
        shared-updated-keys (set/intersection (set (keys previous-only)) (set (keys new-only)))]
    {:previous (select-keys previous-object shared-updated-keys)
     :new (select-keys object shared-updated-keys)}))
(mr/def ::event-params [:map {:closed true
                              :doc "Used when inserting a value to the Audit Log."}
                        [:object          {:optional true} [:maybe :map]]
                        [:previous-object {:optional true} [:maybe :map]]
                        [:user-id         {:optional true} [:maybe pos-int?]]
                        [:model           {:optional true} [:maybe [:or :keyword :string]]]
                        [:model-id        {:optional true} [:maybe pos-int?]]
                        [:details         {:optional true} [:maybe :map]]])
(mu/defn construct-event
  :- [:map
      [:unqualified-topic simple-keyword?]
      [:user-id [:maybe ms/PositiveInt]]
      [:model-name [:maybe :string]]
      [:model-id [:maybe ms/PositiveInt]]
      [:details :map]]
  "Generates the data to be recorded in the Audit Log."
  ([topic :- :keyword
    params :- ::event-params
    current-user-id :- [:maybe pos-int?]]
   (let [unqualified-topic (keyword (name topic))
         object            (:object params)
         previous-object   (:previous-object params)
         object-details    (model-details object unqualified-topic)
         previous-details  (model-details previous-object unqualified-topic)]
     {:unqualified-topic unqualified-topic
      :user-id           (or (:user-id params) current-user-id)
      :model-name        (model-name (or (:model params) object))
      :model-id          (or (:model-id params) (u/id object))
      :details           (merge {}
                                (:details params)
                                (if (not-empty previous-object)
                                  (prepare-update-event-data object-details previous-details)
                                  object-details))})))

Returns true when we should record audit data into the audit log.

(defn- log-enabled?
  []
  (or (premium-features/is-hosted?)
      (premium-features/has-feature? :audit-app)))

Records an event in the Audit Log.

topic is a keyword representing the type of event being recorded, e.g. :dashboard-create. If the keyword is namespaced (e.g. :event/dashboard-create) the namespace is stripped before the event is recorded.

params is a map that can optionally include the following fields: - :object: the object the event is acting on, e.g. a Card instance - :previous-object: the previous version of the object, for update events - :user-id: the user ID that initiated the event (defaults: api/*current-user-id*) - :model: the name of the model the event is acting on, e.g. :model/Card or "Card" (default: model of :object) - :model-id: the ID of the model the event is acting on (default: ID of :object) - :details: a map of arbitrary details relavent to the event, which is recorded as-is (default: {})

:object and :previous-object both have model-details called on them to determine which fields should be audited, then they are added to :details before the event is recorded. :previous-object is only included if any audited fields were updated.

Under certain conditions this function does not insert anything into the audit log. - If nothing is logged, returns nil - Otherwise, returns the audit logged row.

(mu/defn record-event!
  [topic :- :keyword
   params :- ::event-params]
  (when (log-enabled?)
    (span/with-span!
      {:name       "record-event!"
       :attributes (cond-> {}
                     (:model-id params) (assoc :model/id (:model-id params))
                     (:user-id params) (assoc :user/id (:user-id params))
                     (:model params) (assoc :model/name (u/lower-case-en (:model params))))}
      (let [{:keys [user-id model-name model-id details unqualified-topic object]}
            (construct-event topic params api/*current-user-id*)]
        (t2/insert! :model/AuditLog
                    :topic    unqualified-topic
                    :details  details
                    :model    model-name
                    :model_id model-id
                    :user_id  user-id)
        ;; TODO: temporarily double-writing to the `activity` table, delete this in Metabase v48
        ;; TODO figure out set of events to actually continue recording in activity
        (when-not (#{:card-read :dashboard-read :table-read :card-query :setting-update} unqualified-topic)
          (activity/record-activity!
            {:topic    topic
             :object   object
             :details  details
             :model    model-name
             :model-id model-id
             :user-id  user-id}))))))
(t2/define-before-insert :model/AuditLog
  [activity]
  (let [defaults {:timestamp :%now
                  :details   {}}]
    (merge defaults activity)))
 
(ns metabase.models.bookmark
  (:require
   [clojure.string :as str]
   [metabase.db.connection :as mdb.connection]
   [metabase.db.query :as mdb.query]
   [metabase.db.util :as mdb.u]
   [metabase.models.card :refer [Card]]
   [metabase.models.collection :refer [Collection]]
   [metabase.models.dashboard :refer [Dashboard]]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

CardBookmark model

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase."

DashboardBookmark model

CollectionBookmark model

BookmarkOrdering model

(def CardBookmark              :model/CardBookmark)
(def DashboardBookmark    :model/DashboardBookmark)
(def CollectionBookmark  :model/CollectionBookmark)
(def BookmarkOrdering      :model/BookmarkOrdering)
(methodical/defmethod t2/table-name :model/CardBookmark       [_model] :card_bookmark)
(methodical/defmethod t2/table-name :model/DashboardBookmark  [_model] :dashboard_bookmark)
(methodical/defmethod t2/table-name :model/CollectionBookmark [_model] :collection_bookmark)
(methodical/defmethod t2/table-name :model/BookmarkOrdering   [_model] :bookmark_ordering)
(derive :model/CardBookmark :metabase/model)
(derive :model/DashboardBookmark :metabase/model)
(derive :model/CollectionBookmark :metabase/model)
(derive :model/BookmarkOrdering :metabase/model)
(defn- unqualify-key
  [k]
  (-> (str/split (name k) #"\.") peek keyword))

Shape of a bookmark returned for user. Id is a string because it is a concatenation of the model and the model's id. This is required for the frontend entity loading system and does not refer to any particular bookmark id, although the compound key can be inferred from it.

(def BookmarkResult
  [:map {:closed true}
   [:id                               :string]
   [:type                             [:enum "card" "collection" "dashboard"]]
   [:item_id                          ms/PositiveInt]
   [:name                             ms/NonBlankString]
   [:authority_level {:optional true} [:maybe :string]]
   [:dataset         {:optional true} [:maybe :boolean]]
   [:description     {:optional true} [:maybe :string]]
   [:display         {:optional true} [:maybe :string]]])
(mu/defn ^:private normalize-bookmark-result :- BookmarkResult
  "Normalizes bookmark results. Bookmarks are left joined against the card, collection, and dashboard tables, but only
  points to one of them. Normalizes it so it has just the desired fields."
  [result]
  (let [result            (cond-> (into {} (remove (comp nil? second) result))
                            ;; If not a collection then remove collection properties
                            ;; to avoid shadowing the "real" properties.
                            (not= (:type result) "collection")
                            (dissoc :collection.description :collection.name))
        normalized-result (zipmap (map unqualify-key (keys result)) (vals result))
        id-str            (str (:type normalized-result) "-" (:item_id normalized-result))]
    (-> normalized-result
        (select-keys [:item_id :type :name :dataset :description :display
                      :authority_level])
        (assoc :id id-str))))
(defn- bookmarks-union-query
  [user-id]
  (let [as-null (when (= (mdb.connection/db-type) :postgres) (h2x/->integer nil))]
    {:union-all [{:select [:card_id
                           [as-null :dashboard_id]
                           [as-null :collection_id]
                           [:card_id :item_id]
                           [(h2x/literal "card") :type]
                           :created_at]
                  :from   [:card_bookmark]
                  :where  [:= :user_id user-id]}
                 {:select [[as-null :card_id]
                           :dashboard_id
                           [as-null :collection_id]
                           [:dashboard_id :item_id]
                           [(h2x/literal "dashboard") :type]
                           :created_at]
                  :from   [:dashboard_bookmark]
                  :where  [:= :user_id user-id]}
                 {:select [[as-null :card_id]
                           [as-null :dashboard_id]
                           :collection_id
                           [:collection_id :item_id]
                           [(h2x/literal "collection") :type]
                           :created_at]
                  :from   [:collection_bookmark]
                  :where  [:= :user_id user-id]}]}))
(mu/defn bookmarks-for-user :- [:sequential BookmarkResult]
  "Get all bookmarks for a user. Each bookmark will have a string id made of the model and model-id, a type, and
  item_id, name, and description from the underlying bookmarked item."
  [user-id]
  (->> (mdb.query/query
        {:select    [[:bookmark.created_at        :created_at]
                     [:bookmark.type              :type]
                     [:bookmark.item_id           :item_id]
                     [:card.name                  (mdb.u/qualify Card :name)]
                     [:card.dataset               (mdb.u/qualify Card :dataset)]
                     [:card.display               (mdb.u/qualify Card :display)]
                     [:card.description           (mdb.u/qualify Card :description)]
                     [:card.archived              (mdb.u/qualify Card :archived)]
                     [:dashboard.name             (mdb.u/qualify Dashboard :name)]
                     [:dashboard.description      (mdb.u/qualify Dashboard :description)]
                     [:dashboard.archived         (mdb.u/qualify Dashboard :archived)]
                     [:collection.name            (mdb.u/qualify Collection  :name)]
                     [:collection.authority_level (mdb.u/qualify Collection :authority_level)]
                     [:collection.description     (mdb.u/qualify Collection :description)]
                     [:collection.archived        (mdb.u/qualify Collection :archived)]]
         :from      [[(bookmarks-union-query user-id) :bookmark]]
         :left-join [[:report_card :card]                    [:= :bookmark.card_id :card.id]
                     [:report_dashboard :dashboard]          [:= :bookmark.dashboard_id :dashboard.id]
                     ;; use of [[h2x/identifier]] here is a workaround for https://github.com/seancorfield/honeysql/issues/450
                     [:collection :collection]               [:in :collection.id [(h2x/identifier :field :bookmark :collection_id)
                                                                                  (h2x/identifier :field :dashboard :collection_id)]]
                     [:bookmark_ordering :bookmark_ordering] [:and
                                                              [:= :bookmark_ordering.user_id user-id]
                                                              [:= :bookmark_ordering.type :bookmark.type]
                                                              [:= :bookmark_ordering.item_id :bookmark.item_id]]]
         :where     (into [:and]
                          (for [table [:card :dashboard :collection]
                                :let  [field (keyword (str (name table) "." "archived"))]]
                            [:or [:= field false] [:= field nil]]))
         :order-by  [[:bookmark_ordering.ordering (case (mdb.connection/db-type)
                                                    ;; NULLS LAST is not supported by MySQL, but this is default
                                                    ;; behavior for MySQL anyway
                                                    (:postgres :h2) :asc-nulls-last
                                                    :mysql          :asc)]
                     [:created_at :desc]]})
       (map normalize-bookmark-result)))

Saves a bookmark ordering of shape [{:type, :item_id}] Deletes all existing orderings for user so should be given a total ordering.

(defn save-ordering!
  [user-id orderings]
  (t2/delete! BookmarkOrdering :user_id user-id)
  (t2/insert! BookmarkOrdering (->> orderings
                                    (map #(select-keys % [:type :item_id]))
                                    (map-indexed #(assoc %2 :user_id user-id :ordering %1)))))
 

Underlying DB model for what is now most commonly referred to as a 'Question' in most user-facing situations. Card is a historical name, but is the same thing; both terms are used interchangeably in the backend codebase.

(ns metabase.models.card
  (:require
   [clojure.core.async :as a]
   [clojure.data :as data]
   [clojure.set :as set]
   [clojure.string :as str]
   [clojure.walk :as walk]
   [malli.core :as mc]
   [medley.core :as m]
   [metabase.api.common :as api]
   [metabase.config :as config]
   [metabase.db.query :as mdb.query]
   [metabase.email.messages :as messages]
   [metabase.events :as events]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.models.audit-log :as audit-log]
   [metabase.models.collection :as collection]
   [metabase.models.field-values :as field-values]
   [metabase.models.interface :as mi]
   [metabase.models.moderation-review :as moderation-review]
   [metabase.models.parameter-card
    :as parameter-card
    :refer [ParameterCard]]
   [metabase.models.params :as params]
   [metabase.models.permissions :as perms]
   [metabase.models.pulse :as pulse]
   [metabase.models.query :as query]
   [metabase.models.revision :as revision]
   [metabase.models.serialization :as serdes]
   [metabase.moderation :as moderation]
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings :as public-settings]
   [metabase.public-settings.premium-features
    :as premium-features
    :refer [defenterprise]]
   [metabase.query-processor.async :as qp.async]
   [metabase.query-processor.util :as qp.util]
   [metabase.server.middleware.session :as mw.session]
   [metabase.shared.util.i18n :refer [trs]]
   [metabase.sync.analyze.query-results :as qr]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   [methodical.core :as methodical]
   [schema.core :as s]
   [toucan2.core :as t2]
   [toucan2.tools.hydrate :as t2.hydrate])
  (:import
   (clojure.core.async.impl.channels ManyToManyChannel)))
(set! *warn-on-reflection* true)

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all the Card symbol in our codebase.

(def Card
  :model/Card)
(methodical/defmethod t2/table-name :model/Card [_model] :report_card)
(methodical/defmethod t2.hydrate/model-for-automagic-hydration [#_model :default #_k :card]
  [_original-model _k]
  :model/Card)
(t2/deftransforms :model/Card
  {:dataset_query          mi/transform-metabase-query
   :display                mi/transform-keyword
   :embedding_params       mi/transform-json
   :query_type             mi/transform-keyword
   :result_metadata        mi/transform-result-metadata
   :visualization_settings mi/transform-visualization-settings
   :parameters             mi/transform-parameters-list
   :parameter_mappings     mi/transform-parameters-list})
(doto :model/Card
  (derive :metabase/model)
  ;; You can read/write a Card if you can read/write its parent Collection
  (derive ::perms/use-parent-collection-perms)
  (derive :hook/timestamped?)
  (derive :hook/entity-id))
(defmethod mi/can-write? Card
  ([instance]
   ;; Cards in audit collection should not be writable.
   (if (and
        ;; We want to make sure there's an existing audit collection before doing the equality check below.
        ;; If there is no audit collection, this will be nil:
        (some? (:id (perms/default-audit-collection)))
        ;; Is a direct descendant of audit collection
        (= (:collection_id instance) (:id (perms/default-audit-collection))))
     false
     (mi/current-user-has-full-permissions? (perms/perms-objects-set-for-parent-collection instance :write))))
  ([_ pk]
   (mi/can-write? (t2/select-one :model/Card :id pk))))
(defmethod mi/can-read? Card
  ([instance]
   (perms/can-read-audit-helper :model/Card instance))
  ([_ pk]
   (mi/can-read? (t2/select-one :model/Card :id pk))))

-------------------------------------------------- Hydration --------------------------------------------------

(mi/define-simple-hydration-method dashboard-count
  :dashboard_count
  "Return the number of Dashboards this Card is in."
  [{:keys [id]}]
  (t2/count 'DashboardCard, :card_id id))
(mi/define-simple-hydration-method parameter-usage-count
  :parameter_usage_count
  "Return the number of dashboard/card filters and other widgets that use this card to populate their available
  values (via ParameterCards)"
  [{:keys [id]}]
  (t2/count ParameterCard, :card_id id))
(mi/define-simple-hydration-method average-query-time
  :average_query_time
  "Average query time of card, taken by query executions which didn't hit cache. If it's nil we don't have any query
  executions on file."
  [{:keys [id]}]
  (-> (mdb.query/query {:select [:%avg.running_time]
                        :from [:query_execution]
                        :where [:and
                                [:not= :running_time nil]
                                [:not= :cache_hit true]
                                [:= :card_id id]]})
      first vals first))
(mi/define-simple-hydration-method last-query-start
  :last_query_start
  "Timestamp for start of last query of this card."
  [{:keys [id]}]
  (-> (mdb.query/query {:select [:%max.started_at]
                        :from [:query_execution]
                        :where [:and
                                [:not= :running_time nil]
                                [:not= :cache_hit true]
                                [:= :card_id id]]})
      first vals first))

There's more hydration in the shared metabase.moderation namespace, but it needs to be required:

(comment moderation/keep-me)

--------------------------------------------------- Revisions ----------------------------------------------------

(def ^:private excluded-columns-for-card-revision
  [:id :created_at :updated_at :entity_id :creator_id :public_uuid :made_public_by_id :metabase_version])
(defmethod revision/serialize-instance :model/Card
  ([instance]
   (revision/serialize-instance Card nil instance))
  ([_model _id instance]
   (cond-> (apply dissoc instance excluded-columns-for-card-revision)
     ;; datasets should preserve edits to metadata
     (not (:dataset instance))
     (dissoc :result_metadata))))

--------------------------------------------------- Lifecycle ----------------------------------------------------

Lift database_id, table_id, and query_type from query definition when inserting/updating a Card.

(defn populate-query-fields
  [{{query-type :type, :as outer-query} :dataset_query, :as card}]
  (merge
   card
   ;; mega HACK FIXME -- don't update this stuff when doing deserialization because it might differ from what's in the
   ;; YAML file and break tests like [[metabase-enterprise.serialization.v2.e2e.yaml-test/e2e-storage-ingestion-test]].
   ;; The root cause of this issue is that we're generating Cards that have a different Database ID or Table ID from
   ;; what's actually in their query -- we need to fix [[metabase.test.generate]], but I'm not sure how to do that
   (when-not mi/*deserializing?*
     (when-let [{:keys [database-id table-id]} (and query-type
                                                    (query/query->database-and-table-ids outer-query))]
       (merge
        {:query_type (keyword query-type)}
        (when database-id
          {:database_id database-id})
        (when table-id
          {:table_id table-id}))))))

When inserting/updating a Card, populate the result metadata column if not already populated by inferring the metadata from the query.

(defn- populate-result-metadata
  [{query :dataset_query, metadata :result_metadata, existing-card-id :id, :as card}]
  (cond
    ;; not updating the query => no-op
    (not query)
    (do
      (log/debug "Not inferring result metadata for Card: query was not updated")
      card)
    ;; passing in metadata => no-op
    metadata
    (do
      (log/debug "Not inferring result metadata for Card: metadata was passed in to insert!/update!")
      card)
    ;; this is an update, and dataset_query hasn't changed => no-op
    (and existing-card-id
         (= query (t2/select-one-fn :dataset_query Card :id existing-card-id)))
    (do
      (log/debugf "Not inferring result metadata for Card %s: query has not changed" existing-card-id)
      card)
    ;; query has changed (or new Card) and this is a native query => set metadata to nil
    ;;
    ;; we can't infer the metadata for a native query without running it, so it's better to have no metadata than
    ;; possibly incorrect metadata.
    (= (:type query) :native)
    (do
      (log/debug "Can't infer result metadata for Card: query is a native query. Setting result metadata to nil")
      (assoc card :result_metadata nil))
    ;; otherwise, attempt to infer the metadata. If the query can't be run for one reason or another, set metadata to
    ;; nil.
    :else
    (do
      (log/debug "Attempting to infer result metadata for Card")
      (let [inferred-metadata (not-empty (mw.session/with-current-user nil
                                           (classloader/require 'metabase.query-processor)
                                           (u/ignore-exceptions
                                             ((resolve 'metabase.query-processor/query->expected-cols) query))))]
        (assoc card :result_metadata inferred-metadata)))))

Check that a card, if it is using another Card as its source, does not have circular references between source Cards. (e.g. Card A cannot use itself as a source, or if A uses Card B as a source, Card B cannot use Card A, and so forth.)

(defn- check-for-circular-source-query-references
  [{query :dataset_query, id :id}]      ; don't use `u/the-id` here so that we can use this with `pre-insert` too
  (loop [query query, ids-already-seen #{id}]
    (let [source-card-id (qp.util/query->source-card-id query)]
      (cond
        (not source-card-id)
        :ok
        (ids-already-seen source-card-id)
        (throw
         (ex-info (tru "Cannot save Question: source query has circular references.")
                  {:status-code 400}))
        :else
        (recur (or (t2/select-one-fn :dataset_query Card :id source-card-id)
                   (throw (ex-info (tru "Card {0} does not exist." source-card-id)
                                   {:status-code 404})))
               (conj ids-already-seen source-card-id))))))
(defn- maybe-normalize-query [card]
  (cond-> card
    (seq (:dataset_query card)) (update :dataset_query mbql.normalize/normalize)))

Transforms native query's template-tags into parameters. An older style was to not include :template-tags onto cards as parameters. I think this is a mistake and they should always be there. Apparently lots of e2e tests are sloppy about this so this is included as a convenience.

(defn template-tag-parameters
  [card]
  ;; NOTE: this should mirror `getTemplateTagParameters` in frontend/src/metabase-lib/parameters/utils/template-tags.ts
  ;; If this function moves you should update the comment that links to this one
  (for [[_ {tag-type :type, widget-type :widget-type, :as tag}] (get-in card [:dataset_query :native :template-tags])
        :when                         (and tag-type
                                           (or (and widget-type (not= widget-type :none))
                                               (not= tag-type :dimension)))]
    {:id      (:id tag)
     :type    (or widget-type (cond (= tag-type :date)   :date/single
                                    (= tag-type :string) :string/=
                                    (= tag-type :number) :number/=
                                    :else                :category))
     :target  (if (= tag-type :dimension)
                [:dimension [:template-tag (:name tag)]]
                [:variable  [:template-tag (:name tag)]])
     :name    (:display-name tag)
     :slug    (:name tag)
     :default (:default tag)}))

Check that all native query Field filter parameters reference Fields belonging to the Database the query points against. This is done when saving a Card. The goal here is to prevent people from saving Cards with invalid queries -- it's better to error now then to error down the road in Query Processor land.

The usual way a user gets into the situation of having a mismatch between the Database and Field Filters is by creating a native query in the Query Builder UI, adding parameters, and then changing the Database that the query targets. See https://github.com/metabase/metabase/issues/14145 for more details.

(defn- check-field-filter-fields-are-from-correct-database
  [{{query-db-id :database, :as query} :dataset_query, :as card}]
  ;; for updates if `query` isn't being updated we don't need to validate anything.
  (when query
    (when-let [field-ids (not-empty (params/card->template-tag-field-ids card))]
      (doseq [{:keys [field-id field-name table-name field-db-id]} (mdb.query/query
                                                                    {:select    [[:field.id :field-id]
                                                                                 [:field.name :field-name]
                                                                                 [:table.name :table-name]
                                                                                 [:table.db_id :field-db-id]]
                                                                     :from      [[:metabase_field :field]]
                                                                     :left-join [[:metabase_table :table]
                                                                                 [:= :field.table_id :table.id]]
                                                                     :where     [:in :field.id (set field-ids)]})]
        (when-not (= field-db-id query-db-id)
          (throw (ex-info (letfn [(describe-database [db-id]
                                    (format "%d %s" db-id (pr-str (t2/select-one-fn :name 'Database :id db-id))))]
                            (tru "Invalid Field Filter: Field {0} belongs to Database {1}, but the query is against Database {2}"
                                 (format "%d %s.%s" field-id (pr-str table-name) (pr-str field-name))
                                 (describe-database field-db-id)
                                 (describe-database query-db-id)))
                          {:status-code           400
                           :query-database        query-db-id
                           :field-filter-database field-db-id})))))))

Check that the card is a valid model if being saved as one. Throw an exception if not.

(defn- assert-valid-model
  [{:keys [dataset dataset_query]}]
  (when dataset
    (let [template-tag-types (->> (vals (get-in dataset_query [:native :template-tags]))
                                  (map (comp keyword :type)))]
      (when (some (complement #{:card :snippet}) template-tag-types)
        (throw (ex-info (tru "A model made from a native SQL question cannot have a variable or field filter.")
                        {:status-code 400}))))))

TODO -- consider whether we should validate the Card query when you save/update it??

(defn- pre-insert [card]
  (let [defaults {:parameters         []
                  :parameter_mappings []}
        card     (merge defaults card)]
    (u/prog1 card
      ;; make sure this Card doesn't have circular source query references
      (check-for-circular-source-query-references card)
      (check-field-filter-fields-are-from-correct-database card)
      ;; TODO: add a check to see if all id in :parameter_mappings are in :parameters
      (assert-valid-model card)
      (params/assert-valid-parameters card)
      (params/assert-valid-parameter-mappings card)
      (collection/check-collection-namespace Card (:collection_id card)))))

Checks additional sandboxing constraints for Metabase Enterprise Edition. The OSS implementation is a no-op.

(defenterprise pre-update-check-sandbox-constraints
  metabase-enterprise.sandbox.models.group-table-access-policy
  [_])

Update the config of parameter on any Dashboard/Card use this card as values source .

Remove parameter.valuessourcetype and set parameter.valuessourcetype to nil ( the default type ) when: - card is archived - card.result_metadata changes and the parameter values source field can't be found anymore

(defn- update-parameters-using-card-as-values-source
  [{id :id, :as changes}]
  (let [parameter-cards   (t2/select ParameterCard :card_id id)]
    (doseq [[[po-type po-id] param-cards]
            (group-by (juxt :parameterized_object_type :parameterized_object_id) parameter-cards)]
      (let [model                  (case po-type :card 'Card :dashboard 'Dashboard)
            {:keys [parameters]}   (t2/select-one [model :parameters] :id po-id)
            affected-param-ids-set (cond
                                     ;; update all parameters that use this card as source
                                     (:archived changes)
                                     (set (map :parameter_id param-cards))
                                     ;; update only parameters that have value_field no longer in this card
                                     (:result_metadata changes)
                                     (let [param-id->parameter (m/index-by :id parameters)]
                                       (->> param-cards
                                            (filter (fn [param-card]
                                                      ;; if cant find the value-field in result_metadata, then we should remove it
                                                      (nil? (qp.util/field->field-info
                                                              (get-in (param-id->parameter (:parameter_id param-card)) [:values_source_config :value_field])
                                                              (:result_metadata changes)))))
                                            (map :parameter_id)
                                            set))
                                     :else #{})
            new-parameters (map (fn [parameter]
                                  (if (affected-param-ids-set (:id parameter))
                                    (-> parameter
                                        (assoc :values_source_type nil)
                                        (dissoc :values_source_config))
                                    parameter))
                                parameters)]
        (when-not (= parameters new-parameters)
          (t2/update! model po-id {:parameters new-parameters}))))))

A model with implicit action supported iff they are a raw table, meaning there are no clauses such as filter, limit, breakout...

The list of clauses should match with FE, which is defined in the method hasAnyClauses of metabase-lib/queries/StructuredQuery class

(defn model-supports-implicit-actions?
  [{dataset-query :dataset_query :as _card}]
  (and (= :query (:type dataset-query))
       (every? #(nil? (get-in dataset-query [:query %]))
               [:expressions :filter :limit :breakout :aggregation :joins :order-by :fields])))

Delete all implicit actions of a model if exists.

(defn- disable-implicit-action-for-model!
  [model-id]
  (when-let [action-ids (t2/select-pks-set  'Action {:select [:action.id]
                                                     :from   [:action]
                                                     :join   [:implicit_action
                                                              [:= :action.id :implicit_action.action_id]]
                                                     :where  [:= :action.model_id model-id]})]
    (t2/delete! 'Action :id [:in action-ids])))
(defn- pre-update [{archived? :archived, id :id, :as changes}]
  ;; TODO - don't we need to be doing the same permissions check we do in `pre-insert` if the query gets changed? Or
  ;; does that happen in the `PUT` endpoint?
  (u/prog1 changes
    (let [;; Fetch old card data if necessary, and share the data between multiple checks.
          old-card-info (when (or (contains? changes :dataset)
                                  (:dataset_query changes)
                                  (get-in changes [:dataset_query :native]))
                          (t2/select-one [:model/Card :dataset_query :dataset] :id id))]
      ;; if the Card is archived, then remove it from any Dashboards
      (when archived?
        (t2/delete! 'DashboardCard :card_id id))
      ;; if the template tag params for this Card have changed in any way we need to update the FieldValues for
      ;; On-Demand DB Fields
      (when (get-in changes [:dataset_query :native])
        (let [old-param-field-ids (params/card->template-tag-field-ids old-card-info)
              new-param-field-ids (params/card->template-tag-field-ids changes)]
          (when (and (seq new-param-field-ids)
                     (not= old-param-field-ids new-param-field-ids))
            (let [newly-added-param-field-ids (set/difference new-param-field-ids old-param-field-ids)]
              (log/info "Referenced Fields in Card params have changed. Was:" old-param-field-ids
                        "Is Now:" new-param-field-ids
                        "Newly Added:" newly-added-param-field-ids)
              ;; Now update the FieldValues for the Fields referenced by this Card.
              (field-values/update-field-values-for-on-demand-dbs! newly-added-param-field-ids)))))
      ;; make sure this Card doesn't have circular source query references if we're updating the query
      (when (:dataset_query changes)
        (check-for-circular-source-query-references changes))
      ;; updating a model dataset query to not support implicit actions will disable implicit actions if they exist
      (when (and (:dataset_query changes)
                 (:dataset old-card-info)
                 (not (model-supports-implicit-actions? changes)))
        (disable-implicit-action-for-model! id))
      ;; Archive associated actions
      (when (and (false? (:dataset changes))
                 (:dataset old-card-info))
        (t2/update! 'Action {:model_id id :type [:not= :implicit]} {:archived true})
        (t2/delete! 'Action :model_id id, :type :implicit))
      ;; Make sure any native query template tags match the DB in the query.
      (check-field-filter-fields-are-from-correct-database changes)
      ;; Make sure the Collection is in the default Collection namespace (e.g. as opposed to the Snippets Collection namespace)
      (collection/check-collection-namespace Card (:collection_id changes))
      (params/assert-valid-parameters changes)
      (params/assert-valid-parameter-mappings changes)
      (update-parameters-using-card-as-values-source changes)
      (parameter-card/upsert-or-delete-from-parameters! "card" id (:parameters changes))
      ;; additional checks (Enterprise Edition only)
      (pre-update-check-sandbox-constraints changes)
      (assert-valid-model (merge old-card-info changes)))))
(t2/define-after-select :model/Card
  [card]
  (public-settings/remove-public-uuid-if-public-sharing-is-disabled card))
(t2/define-before-insert :model/Card
  [card]
  (-> card
      (assoc :metabase_version config/mb-version-string)
      maybe-normalize-query
      populate-result-metadata
      pre-insert
      populate-query-fields))
(t2/define-after-insert :model/Card
  [card]
  (u/prog1 card
    (when-let [field-ids (seq (params/card->template-tag-field-ids card))]
      (log/info "Card references Fields in params:" field-ids)
      (field-values/update-field-values-for-on-demand-dbs! field-ids))
    (parameter-card/upsert-or-delete-from-parameters! "card" (:id card) (:parameters card))))
(t2/define-before-update :model/Card
  [card]
  ;; remove all the unchanged keys from the map, except for `:id`, so the functions below can do the right thing since
  ;; they were written pre-Toucan 2 and don't know about [[t2/changes]]...
  ;;
  ;; We have to convert this to a plain map rather than a Toucan 2 instance at this point to work around upstream bug
  ;; https://github.com/camsaul/toucan2/issues/145 .
  (-> (into {:id (:id card)} (t2/changes card))
      maybe-normalize-query
      populate-result-metadata
      pre-update
      populate-query-fields
      (dissoc :id)))

Cards don't normally get deleted (they get archived instead) so this mostly affects tests

(t2/define-before-delete :model/Card
  [{:keys [id] :as _card}]
  ;; delete any ParameterCard that the parameters on this card linked to
  (parameter-card/delete-all-for-parameterized-object! "card" id)
  ;; delete any ParameterCard linked to this card
  (t2/delete! ParameterCard :card_id id)
  (t2/delete! 'ModerationReview :moderated_item_type "card", :moderated_item_id id)
  (t2/delete! 'Revision :model "Card", :model_id id))
(defmethod serdes/hash-fields :model/Card
  [_card]
  [:name (serdes/hydrated-hash :collection) :created_at])

----------------------------------------------- Creating Cards ----------------------------------------------------

(s/defn result-metadata-async :- ManyToManyChannel
  "Return a channel of metadata for the passed in `query`. Takes the `original-query` so it can determine if existing
  `metadata` might still be valid. Takes `dataset?` since existing metadata might need to be \"blended\" into the
  fresh metadata to preserve metadata edits from the dataset.
  Note this condition is possible for new cards and edits to cards. New cards can be created from existing cards by
  copying, and they could be datasets, have edited metadata that needs to be blended into a fresh run.
  This is also complicated because everything is optional, so we cannot assume the client will provide metadata and
  might need to save a metadata edit, or might need to use db-saved metadata on a modified dataset."
  [{:keys [original-query query metadata original-metadata dataset?]}]
  (let [valid-metadata? (and metadata (mc/validate qr/ResultsMetadata metadata))]
    (cond
      (or
       ;; query didn't change, preserve existing metadata
       (and (= (mbql.normalize/normalize original-query)
               (mbql.normalize/normalize query))
            valid-metadata?)
       ;; only sent valid metadata in the edit. Metadata might be the same, might be different. We save in either case
       (and (nil? query)
            valid-metadata?)
       ;; copying card and reusing existing metadata
       (and (nil? original-query)
            query
            valid-metadata?))
      (do
        (log/debug (trs "Reusing provided metadata"))
        (a/to-chan! [metadata]))
      ;; frontend always sends query. But sometimes programatic don't (cypress, API usage). Returning an empty channel
      ;; means the metadata won't be updated at all.
      (nil? query)
      (do
        (log/debug (trs "No query provided so not querying for metadata"))
        (doto (a/chan) a/close!))
      ;; datasets need to incorporate the metadata either passed in or already in the db. Query has changed so we
      ;; re-run and blend the saved into the new metadata
      (and dataset? (or valid-metadata? (seq original-metadata)))
      (do
        (log/debug (trs "Querying for metadata and blending model metadata"))
        (a/go (let [metadata' (if valid-metadata?
                                (map mbql.normalize/normalize-source-metadata metadata)
                                original-metadata)
                    fresh     (a/<! (qp.async/result-metadata-for-query-async query))]
                (qp.util/combine-metadata fresh metadata'))))
      :else
      ;; compute fresh
      (do
        (log/debug (trs "Querying for metadata"))
        (qp.async/result-metadata-for-query-async query)))))

Duration in milliseconds to wait for the metadata before saving the card without the metadata. That metadata will be saved later when it is ready.

(def metadata-sync-wait-ms
  1500)

Duration in milliseconds to wait for the metadata before abandoning the asynchronous metadata saving. Default is 15 minutes.

(def metadata-async-timeout-ms
  (u/minutes->ms 15))

Save metadata when (and if) it is ready. Takes a chan that will eventually return metadata. Waits up to [[metadata-async-timeout-ms]] for the metadata, and then saves it if the query of the card has not changed.

(defn schedule-metadata-saving
  [result-metadata-chan card]
  (a/go
    (let [timeoutc        (a/timeout metadata-async-timeout-ms)
          [metadata port] (a/alts! [result-metadata-chan timeoutc])
          id              (:id card)]
      (cond (= port timeoutc)
            (do (a/close! result-metadata-chan)
                (log/info (trs "Metadata not ready in {0} minutes, abandoning"
                               (long (/ metadata-async-timeout-ms 1000 60)))))
            (not (seq metadata))
            (log/info (trs "Not updating metadata asynchronously for card {0} because no metadata"
                           id))
            :else
            (future
              (let [current-query (t2/select-one-fn :dataset_query Card :id id)]
                (if (= (:dataset_query card) current-query)
                  (do (t2/update! Card id {:result_metadata metadata})
                      (log/info (trs "Metadata updated asynchronously for card {0}" id)))
                  (log/info (trs "Not updating metadata asynchronously for card {0} because query has changed"
                                 id)))))))))

Create a new Card. Metadata will be fetched off thread. If the metadata takes longer than [[metadata-sync-wait-ms]] the card will be saved without metadata and it will be saved to the card in the future when it is ready.

Dispatches the :card-create event unless delay-event? is true. Useful for when many cards are created in a transaction and work in the :card-create event cannot proceed because the cards would not be visible outside of the transaction yet. If you pass true here it is important to call the event after the cards are successfully created.

(defn create-card!
  ([card creator] (create-card! card creator false))
  ([{:keys [dataset_query result_metadata dataset parameters parameter_mappings], :as card-data} creator delay-event?]
   ;; `zipmap` instead of `select-keys` because we want to get `nil` values for keys that aren't present. Required by
   ;; `api/maybe-reconcile-collection-position!`
   (let [data-keys            [:dataset_query :description :display :name :visualization_settings
                               :parameters :parameter_mappings :collection_id :collection_position :cache_ttl]
         card-data            (assoc (zipmap data-keys (map card-data data-keys))
                                     :creator_id (:id creator)
                                     :dataset (boolean (:dataset card-data))
                                     :parameters (or parameters [])
                                     :parameter_mappings (or parameter_mappings []))
         result-metadata-chan (result-metadata-async {:query    dataset_query
                                                      :metadata result_metadata
                                                      :dataset? dataset})
         metadata-timeout     (a/timeout metadata-sync-wait-ms)
         [metadata port]      (a/alts!! [result-metadata-chan metadata-timeout])
         timed-out?           (= port metadata-timeout)
         card                 (t2/with-transaction [_conn]
                                ;; Adding a new card at `collection_position` could cause other cards in this
                                ;; collection to change position, check that and fix it if needed
                                (api/maybe-reconcile-collection-position! card-data)
                                (first (t2/insert-returning-instances! Card (cond-> card-data
                                                                              (and metadata (not timed-out?))
                                                                              (assoc :result_metadata metadata)))))]
     (when-not delay-event?
       (events/publish-event! :event/card-create {:object card :user-id (:id creator)}))
     (when timed-out?
       (log/info (trs "Metadata not available soon enough. Saving new card and asynchronously updating metadata")))
     ;; include same information returned by GET /api/card/:id since frontend replaces the Card it currently has with
     ;; returned one -- See #4283
     (u/prog1 card
       (when timed-out?
         (schedule-metadata-saving result-metadata-chan <>))))))

------------------------------------------------- Updating Cards -------------------------------------------------

(defn- card-archived? [old-card new-card]
  (and (not (:archived old-card))
       (:archived new-card)))
(defn- line-area-bar? [display]
  (contains? #{:line :area :bar} display))
(defn- progress? [display]
  (= :progress display))
(defn- allows-rows-alert? [display]
  (not (contains? #{:line :bar :area :progress} display)))

Alerts no longer make sense when the kind of question being alerted on significantly changes. Setting up an alert when a time series query reaches 10 is no longer valid if the question switches from a line graph to a table. This function goes through various scenarios that render an alert no longer valid

(defn- display-change-broke-alert?
  [{old-display :display} {new-display :display}]
  (when-not (= old-display new-display)
    (or
     ;; Did the alert switch from a table type to a line/bar/area/progress graph type?
     (and (allows-rows-alert? old-display)
          (or (line-area-bar? new-display)
              (progress? new-display)))
     ;; Switching from a line/bar/area to another type that is not those three invalidates the alert
     (and (line-area-bar? old-display)
          (not (line-area-bar? new-display)))
     ;; Switching from a progress graph to anything else invalidates the alert
     (and (progress? old-display)
          (not (progress? new-display))))))

If we had a goal before, and now it's gone, the alert is no longer valid

(defn- goal-missing?
  [old-card new-card]
  (and
   (get-in old-card [:visualization_settings :graph.goal_value])
   (not (get-in new-card [:visualization_settings :graph.goal_value]))))

If there are multiple breakouts and a goal, we don't know which breakout to compare to the goal, so it invalidates the alert

(defn- multiple-breakouts?
  [{:keys [display] :as new-card}]
  (and (get-in new-card [:visualization_settings :graph.goal_value])
       (or (line-area-bar? display)
           (progress? display))
       (< 1 (count (get-in new-card [:dataset_query :query :breakout])))))

Removes all of the alerts and notifies all of the email recipients of the alerts change via NOTIFY-FN!

(defn- delete-alert-and-notify!
  [& {:keys [notify-fn! alerts actor]}]
  (t2/delete! :model/Pulse :id [:in (map :id alerts)])
  (doseq [{:keys [channels] :as alert} alerts
          :let [email-channel (m/find-first #(= :email (:channel_type %)) channels)]]
    (doseq [recipient (:recipients email-channel)]
      (notify-fn! alert recipient actor))))

Removes all alerts and will email each recipient letting them know

(defn delete-alert-and-notify-archived!
  [& {:keys [alerts actor]}]
  (delete-alert-and-notify! {:notify-fn! messages/send-alert-stopped-because-archived-email!
                             :alerts     alerts
                             :actor      actor}))
(defn- delete-alert-and-notify-changed! [& {:keys [alerts actor]}]
  (delete-alert-and-notify! {:notify-fn! messages/send-alert-stopped-because-changed-email!
                             :alerts     alerts
                             :actor      actor}))
(defn- delete-alerts-if-needed! [& {:keys [old-card new-card actor]}]
  ;; If there are alerts, we need to check to ensure the card change doesn't invalidate the alert
  (when-let [alerts (binding [pulse/*allow-hydrate-archived-cards* true]
                      (seq (pulse/retrieve-alerts-for-cards {:card-ids [(:id new-card)]})))]
    (cond
      (card-archived? old-card new-card)
      (delete-alert-and-notify-archived! :alerts alerts, :actor actor)
      (or (display-change-broke-alert? old-card new-card)
          (goal-missing? old-card new-card)
          (multiple-breakouts? new-card))
      (delete-alert-and-notify-changed! :alerts alerts, :actor actor)
      ;; The change doesn't invalidate the alert, do nothing
      :else
      nil)))

Return true if card is verified, false otherwise. Assumes that moderation reviews are ordered so that the most recent is the first. This is the case from the hydration function for moderation_reviews.

(defn- card-is-verified?
  [card]
  (-> card :moderation_reviews first :status #{"verified"} boolean))

Return whether there were any changes in the objects at the keys for consider.

returns false because changes to collection_id are ignored: (changed? #{:description} {:collection_id 1 :description "foo"} {:collection_id 2 :description "foo"})

returns true: (changed? #{:description} {:collection_id 1 :description "foo"} {:collection_id 2 :description "diff"})

(defn- changed?
  [consider card-before updates]
  ;; have to ignore keyword vs strings over api. `{:type :query}` vs `{:type "query"}`
  (let [prepare              (fn prepare [card] (walk/prewalk (fn [x] (if (keyword? x)
                                                                        (name x)
                                                                        x))
                                                              card))
        before               (prepare (select-keys card-before consider))
        after                (prepare (select-keys updates consider))
        [_ changes-in-after] (data/diff before after)]
    (boolean (seq changes-in-after))))

When comparing a card to possibly unverify, only consider these keys as changing something 'important' about the query.

(def ^:private card-compare-keys
  #{:table_id
    :database_id
    :query_type ;; these first three may not even be changeable
    :dataset_query})

Update a Card. Metadata is fetched asynchronously. If it is ready before [[metadata-sync-wait-ms]] elapses it will be included, otherwise the metadata will be saved to the database asynchronously.

(defn update-card!
  [{:keys [card-before-update card-updates actor]}]
  ;; don't block our precious core.async thread, run the actual DB updates on a separate thread
  (t2/with-transaction [_conn]
   (api/maybe-reconcile-collection-position! card-before-update card-updates)
   (when (and (card-is-verified? card-before-update)
              (changed? card-compare-keys card-before-update card-updates))
     ;; this is an enterprise feature but we don't care if enterprise is enabled here. If there is a review we need
     ;; to remove it regardless if enterprise edition is present at the moment.
     (moderation-review/create-review! {:moderated_item_id   (:id card-before-update)
                                        :moderated_item_type "card"
                                        :moderator_id        (:id actor)
                                        :status              nil
                                        :text                (tru "Unverified due to edit")}))
   ;; ok, now save the Card
   (t2/update! Card (:id card-before-update)
     ;; `collection_id` and `description` can be `nil` (in order to unset them). Other values should only be
     ;; modified if they're passed in as non-nil
     (u/select-keys-when card-updates
       :present #{:collection_id :collection_position :description :cache_ttl :dataset}
       :non-nil #{:dataset_query :display :name :visualization_settings :archived :enable_embedding
                  :parameters :parameter_mappings :embedding_params :result_metadata :collection_preview})))
  ;; Fetch the updated Card from the DB
  (let [card (t2/select-one Card :id (:id card-before-update))]
    (delete-alerts-if-needed! :old-card card-before-update, :new-card card, :actor actor)
    ;; skip publishing the event if it's just a change in its collection position
    (when-not (= #{:collection_position}
                 (set (keys card-updates)))
      (events/publish-event! :event/card-update {:object card :user-id api/*current-user-id*}))
    card))

------------------------------------------------- Serialization --------------------------------------------------

(defmethod serdes/extract-query "Card" [_ opts]
  (serdes/extract-query-collections Card opts))
(defn- export-result-metadata [card metadata]
  (when (and metadata (:dataset card))
    (for [m metadata]
      (-> (dissoc m :fingerprint)
          (m/update-existing :table_id  serdes/*export-table-fk*)
          (m/update-existing :id        serdes/*export-field-fk*)
          (m/update-existing :field_ref serdes/export-mbql)))))
(defn- import-result-metadata [metadata]
  (when metadata
    (for [m metadata]
      (-> m
          (m/update-existing :table_id  serdes/*import-table-fk*)
          (m/update-existing :id        serdes/*import-field-fk*)
          (m/update-existing :field_ref serdes/import-mbql)))))
(defn- result-metadata-deps [metadata]
  (when (seq metadata)
    (reduce set/union #{} (for [m (seq metadata)]
                            (reduce set/union (serdes/mbql-deps (:field_ref m))
                                    [(when (:table_id m) #{(serdes/table->path (:table_id m))})
                                     (when (:id m)       #{(serdes/field->path (:id m))})])))))
(defmethod serdes/extract-one "Card"
  [_model-name _opts card]
  ;; Cards have :table_id, :database_id, :collection_id, :creator_id that need conversion.
  ;; :table_id and :database_id are extracted as just :table_id [database_name schema table_name].
  ;; :collection_id is extracted as its entity_id or identity-hash.
  ;; :creator_id as the user's email.
  (try
    (-> (serdes/extract-one-basics "Card" card)
        (update :database_id            serdes/*export-fk-keyed* 'Database :name)
        (update :table_id               serdes/*export-table-fk*)
        (update :collection_id          serdes/*export-fk* 'Collection)
        (update :creator_id             serdes/*export-user*)
        (update :made_public_by_id      serdes/*export-user*)
        (update :dataset_query          serdes/export-mbql)
        (update :parameters             serdes/export-parameters)
        (update :parameter_mappings     serdes/export-parameter-mappings)
        (update :visualization_settings serdes/export-visualization-settings)
        (update :result_metadata        (partial export-result-metadata card)))
    (catch Exception e
      (throw (ex-info (format "Failed to export Card: %s" (ex-message e)) {:card card} e)))))
(defmethod serdes/load-xform "Card"
  [card]
  (-> card
      serdes/load-xform-basics
      (update :database_id            serdes/*import-fk-keyed* 'Database :name)
      (update :table_id               serdes/*import-table-fk*)
      (update :creator_id             serdes/*import-user*)
      (update :made_public_by_id      serdes/*import-user*)
      (update :collection_id          serdes/*import-fk* 'Collection)
      (update :dataset_query          serdes/import-mbql)
      (update :parameters             serdes/import-parameters)
      (update :parameter_mappings     serdes/import-parameter-mappings)
      (update :visualization_settings serdes/import-visualization-settings)
      (update :result_metadata        import-result-metadata)))
(defmethod serdes/dependencies "Card"
  [{:keys [collection_id database_id dataset_query parameters parameter_mappings
           result_metadata table_id visualization_settings]}]
  (->> (map serdes/mbql-deps parameter_mappings)
       (reduce set/union #{})
       (set/union (serdes/parameters-deps parameters))
       (set/union #{[{:model "Database" :id database_id}]})
       ; table_id and collection_id are nullable.
       (set/union (when table_id #{(serdes/table->path table_id)}))
       (set/union (when collection_id #{[{:model "Collection" :id collection_id}]}))
       (set/union (result-metadata-deps result_metadata))
       (set/union (serdes/mbql-deps dataset_query))
       (set/union (serdes/visualization-settings-deps visualization_settings))
       vec))
(defmethod serdes/descendants "Card" [_model-name id]
  (let [card               (t2/select-one Card :id id)
        source-table       (some->  card :dataset_query :query :source-table)
        template-tags      (some->> card :dataset_query :native :template-tags vals (keep :card-id))
        parameters-card-id (some->> card :parameters (keep (comp :card_id :values_source_config)))
        snippets           (some->> card :dataset_query :native :template-tags vals (keep :snippet-id))]
    (set/union
      (when (and (string? source-table)
                 (str/starts-with? source-table "card__"))
        #{["Card" (Integer/parseInt (.substring ^String source-table 6))]})
      (when (seq template-tags)
        (set (for [card-id template-tags]
               ["Card" card-id])))
      (when (seq parameters-card-id)
        (set (for [card-id parameters-card-id]
               ["Card" card-id])))
      (when (seq snippets)
        (set (for [snippet-id snippets]
               ["NativeQuerySnippet" snippet-id]))))))

------------------------------------------------ Audit Log --------------------------------------------------------

(defmethod audit-log/model-details :model/Card
  [{dataset? :dataset :as card} _event-type]
  (merge (select-keys card [:name :description :database_id :table_id])
          ;; Use `model` instead of `dataset` to mirror product terminology
         {:model? dataset?}))
 

Collections are used to organize Cards, Dashboards, and Pulses; as of v0.30, they are the primary way we determine permissions for these objects. metabase.models.collection.graph. metabase.models.collection.graph

(ns metabase.models.collection
  (:refer-clojure :exclude [ancestors descendants])
  (:require
   [clojure.core.memoize :as memoize]
   [clojure.set :as set]
   [clojure.string :as str]
   [metabase.api.common
    :as api
    :refer [*current-user-id* *current-user-permissions-set*]]
   [metabase.db.connection :as mdb.connection]
   [metabase.models.collection.root :as collection.root]
   [metabase.models.interface :as mi]
   [metabase.models.permissions :as perms :refer [Permissions]]
   [metabase.models.serialization :as serdes]
   [metabase.permissions.util :as perms.u]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.util :as u]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [methodical.core :as methodical]
   [potemkin :as p]
   [toucan2.core :as t2]
   [toucan2.protocols :as t2.protocols]
   [toucan2.realize :as t2.realize]))
(set! *warn-on-reflection* true)
(comment collection.root/keep-me)
(comment mdb.connection/keep-me) ;; for [[memoize/ttl]]

for [[memoize/ttl]]

(p/import-vars [collection.root root-collection root-collection-with-ui-details])

Schema for things that are instances of [[metabase.models.collection.root.RootCollection]].

(def ^:private RootCollection
  [:fn
   {:error/message (str "an instance of the root Collection")}
   #'collection.root/is-root-collection?])

Maximum number of characters allowed in a Collection slug.

(def ^:private ^:const collection-slug-max-length
  510)

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], no2 it's a reference to the toucan2 model name. We'll keep this till we replace all the Card symbol in our codebase.

(def Collection
  :model/Collection)
(methodical/defmethod t2/table-name :model/Collection [_model] :collection)
(methodical/defmethod t2/model-for-automagic-hydration [#_model :default #_k :collection]
  [_original-model _k]
  :model/Collection)
(t2/deftransforms :model/Collection
  {:namespace       mi/transform-keyword
   :authority_level mi/transform-keyword})
(doto Collection
  (derive :metabase/model)
  (derive :hook/entity-id)
  (derive ::mi/read-policy.full-perms-for-perms-set)
  (derive ::mi/write-policy.full-perms-for-perms-set))
(defmethod mi/can-write? Collection
  ([instance]
   (mi/can-write? :model/Collection (:id instance)))
  ([model pk]
   (if (= pk (:id (perms/default-audit-collection)))
     false
     (mi/current-user-has-full-permissions? :write model pk))))
(defmethod mi/can-read? Collection
  ([instance]
   (perms/can-read-audit-helper :model/Collection instance))
  ([_ pk]
   (mi/can-read? (t2/select-one :model/Collection :id pk))))

Malli Schema for valid collection authority levels.

(def AuthorityLevel
  [:enum "official"])

+----------------------------------------------------------------------------------------------------------------+ | Slug Validation | +----------------------------------------------------------------------------------------------------------------+

(defn- slugify [collection-name]
  ;; double-check that someone isn't trying to use a blank string as the collection name
  (when (str/blank? collection-name)
    (throw (ex-info (tru "Collection name cannot be blank!")
             {:status-code 400, :errors {:name (tru "cannot be blank")}})))
  (u/slugify collection-name collection-slug-max-length))

+----------------------------------------------------------------------------------------------------------------+ | Nested Collections: Location Paths | +----------------------------------------------------------------------------------------------------------------+

"Location Paths" are strings that keep track of where a Colllection lives in a filesystem-like hierarchy. Almost all of our backend code does not need to know this and can act as if there is no Collection hierarchy; it is, however, presented as such in the UI. Perhaps it is best to think of the hierarchy as a façade.

For example, Collection 30 might have a location like /10/20/, which means it's the child of Collection 20, who itself is the child of Collection 10. Note that the location does not include the ID of Collection 30 itself.

Storing the relationship in this manner, rather than with foreign keys such as :parent_id, allows us to efficiently fetch all ancestors or descendants of a Collection without having to make multiple DB calls (e.g. to fetch a grandparent, you'd first have to fetch its parent to get their parent_id).

The following functions are useful for working with the Collection location, breaking it out into component IDs, assembling IDs into a location path, and so forth.

* Don't use this directly! Instead use [[location-path->ids]]. *

'Explode' a location-path into a sequence of Collection IDs, and parse them as integers. THIS DOES NOT VALIDATE THAT THE PATH OR RESULTS ARE VALID. This unchecked version exists solely to power the other version below.

(defn- unchecked-location-path->ids
  [location-path]
  (for [^String id-str (rest (str/split location-path #"/"))]
    (Integer/parseInt id-str)))
(defn- valid-location-path? [s]
  (boolean
   (and (string? s)
        (re-matches #"^/(\d+/)*$" s)
        (let [ids (unchecked-location-path->ids s)]
          (or (empty? ids)
              (apply distinct? ids))))))

Schema for a directory-style 'path' to the location of a Collection.

(def ^:private LocationPath
  [:fn #'valid-location-path?])
(mu/defn location-path :- LocationPath
  "Build a 'location path' from a sequence of `collections-or-ids`.
     (location-path 10 20) ; -> \"/10/20/\
  [& collections-or-ids :- [:* [:or ms/PositiveInt :map]]]
  (if-not (seq collections-or-ids)
    "/"
    (str
     "/"
     (str/join "/" (for [collection-or-id collections-or-ids]
                     (u/the-id collection-or-id)))
     "/")))
(mu/defn location-path->ids :- [:sequential ms/PositiveInt]
  "'Explode' a `location-path` into a sequence of Collection IDs, and parse them as integers.
     (location-path->ids \"/10/20/\") ; -> [10 20]"
  [location-path :- LocationPath]
  (unchecked-location-path->ids location-path))
(mu/defn location-path->parent-id :- [:maybe ms/PositiveInt]
  "Given a `location-path` fetch the ID of the direct of a Collection.
     (location-path->parent-id \"/10/20/\") ; -> 20"
  [location-path :- LocationPath]
  (last (location-path->ids location-path)))
(mu/defn all-ids-in-location-path-are-valid? :- :boolean
  "Do all the IDs in `location-path` belong to actual Collections? (This requires a DB call to check this, so this
  should only be used when creating/updating a Collection. Don't use this for casual schema validation.)"
  [location-path :- LocationPath]
  (or
   ;; if location is just the root Collection there are no IDs in the path, so nothing to check
   (= location-path "/")
   ;; otherwise get all the IDs in the path and then make sure the count Collections with those IDs matches the number
   ;; of IDs
   (let [ids (location-path->ids location-path)]
     (= (count ids)
        (t2/count Collection :id [:in ids])))))

Assert that the location property of a collection, if specified, is valid. This checks that it is valid both from a schema standpoint, and from a 'do the referenced Collections exist' standpoint. Intended for use as part of pre-update and pre-insert.

(defn- assert-valid-location
  [{:keys [location], :as collection}]
  ;; if setting/updating the `location` of this Collection make sure it matches the schema for valid location paths
  (when (contains? collection :location)
    (when-not (valid-location-path? location)
      (let [msg (tru "Invalid Collection location: path is invalid.")]
        (throw (ex-info msg {:status-code 400, :errors {:location msg}}))))
    ;; if this is a Personal Collection it's only allowed to go in the Root Collection: you can't put it anywhere else!
    (when (:personal_owner_id collection)
      (when-not (= location "/")
        (let [msg (tru "You cannot move a Personal Collection.")]
          (throw (ex-info msg {:status-code 400, :errors {:location msg}})))))
    ;; Also make sure that all the IDs referenced in the Location path actually correspond to real Collections
    (when-not (all-ids-in-location-path-are-valid? location)
      (let [msg (tru "Invalid Collection location: some or all ancestors do not exist.")]
        (throw (ex-info msg {:status-code 404, :errors {:location msg}}))))))

Check that the namespace of this Collection is valid -- it must belong to the same namespace as its parent Collection.

(defn- assert-valid-namespace
  [{:keys [location], owner-id :personal_owner_id, collection-namespace :namespace, :as collection}]
  {:pre [(contains? collection :namespace)]}
  (when location
    (when-let [parent-id (location-path->parent-id location)]
      (let [parent-namespace (t2/select-one-fn :namespace Collection :id parent-id)]
        (when-not (= (keyword collection-namespace) (keyword parent-namespace))
          (let [msg (tru "Collection must be in the same namespace as its parent")]
            (throw (ex-info msg {:status-code 400, :errors {:location msg}})))))))
  ;; non-default namespace Collections cannot be personal Collections
  (when (and owner-id collection-namespace)
    (let [msg (tru "Personal Collections must be in the default namespace")]
      (throw (ex-info msg {:status-code 400, :errors {:personal_owner_id msg}})))))
(def ^:private CollectionWithLocationOrRoot
  [:or
   RootCollection
   [:map
    [:location LocationPath]]])

Schema for a valid CollectionInstance that has valid :location and :id properties, or the special root-collection placeholder object.

(def CollectionWithLocationAndIDOrRoot
  [:or
   RootCollection
   [:map
    [:location LocationPath]
    [:id       ms/PositiveInt]]])
(mu/defn ^:private parent :- CollectionWithLocationAndIDOrRoot
  "Fetch the parent Collection of `collection`, or the Root Collection special placeholder object if this is a
  top-level Collection."
  [collection :- CollectionWithLocationOrRoot]
  (if-let [new-parent-id (location-path->parent-id (:location collection))]
    (t2/select-one Collection :id new-parent-id)
    root-collection))

+----------------------------------------------------------------------------------------------------------------+ | Nested Collections: "Effective" Location Paths | +----------------------------------------------------------------------------------------------------------------+

"Effective" Location Paths are location paths for Collections that exclude the IDs of Collections the current user isn't allowed to see.

For example, if a Collection has a location of /10/20/30/, and the current User is allowed to see Collections 10 and 30, but not 20, we will show them an "effective" location path of /10/30/. This is used for things like breadcrumbing in the frontend.

Includes the possible values for visible collections, either :all or a set of ids, possibly including "root" to represent the root collection.

(def ^:private VisibleCollections
  [:or
   [:= :all]
   [:set
    [:or [:= "root"] ms/PositiveInt]]])
(mu/defn permissions-set->visible-collection-ids :- VisibleCollections
  "Given a `permissions-set` (presumably those of the current user), return a set of IDs of Collections that the
  permissions set allows you to view. For those with *root* permissions (e.g., an admin), this function will return
  `:all`, signifying that you are allowed to view all Collections. For *Root Collection* permissions, the response
  will include \"root\".
    (permissions-set->visible-collection-ids #{\"/collection/10/\"})   ; -> #{10}
    (permissions-set->visible-collection-ids #{\"/\"})                 ; -> :all
    (permissions-set->visible-collection-ids #{\"/collection/root/\"}) ; -> #{\"root\"}
  You probably don't want to consume the results of this function directly -- most of the time, the reason you are
  calling this function in the first place is because you want add a `FILTER` clause to an application DB query (e.g.
  to only fetch Cards that belong to Collections visible to the current User). Use
  [[visible-collection-ids->honeysql-filter-clause]] to generate a filter clause that handles all possible outputs of
  this function correctly.
  !!! IMPORTANT NOTE !!!
  Because the result may include `nil` for the Root Collection, or may be `:all`, MAKE SURE YOU HANDLE THOSE
  SITUATIONS CORRECTLY before using these IDs to make a DB call. Better yet, use
  [[visible-collection-ids->honeysql-filter-clause]] to generate appropriate HoneySQL."
  [permissions-set]
  (if (contains? permissions-set "/")
    :all
    (set
     (for [path  permissions-set
           :let  [[_ id-str] (re-matches #"/collection/((?:\d+)|root)/(read/)?" path)]
           :when id-str]
       (cond-> id-str
         (not= id-str "root") Integer/parseInt)))))

Generate an appropriate HoneySQL :where clause to filter something by visible Collection IDs, such as the ones returned by permissions-set->visible-collection-ids. Correctly handles all possible values returned by that function, including :all and nil Collection IDs (for the Root Collection).

Guaranteed to always generate a valid HoneySQL form, so this can be used directly in a query without further checks.

(t2/select Card {:where (collection/visible-collection-ids->honeysql-filter-clause (collection/permissions-set->visible-collection-ids @current-user-permissions-set))})

(mu/defn visible-collection-ids->honeysql-filter-clause
  ([collection-ids :- VisibleCollections]
   (visible-collection-ids->honeysql-filter-clause :collection_id collection-ids))
  ([collection-id-field :- :keyword
    collection-ids      :- VisibleCollections]
   (if (= collection-ids :all)
     true
     (let [{non-root-ids false, root-id true} (group-by (partial = "root") collection-ids)
           non-root-clause                    (when (seq non-root-ids)
                                                [:in collection-id-field non-root-ids])
           root-clause                        (when (seq root-id)
                                                [:= collection-id-field nil])]
       (cond
         (and root-clause non-root-clause)
         [:or root-clause non-root-clause]
         (or root-clause non-root-clause)
         (or root-clause non-root-clause)
         :else
         false)))))

Generates an appropriate HoneySQL :where clause to filter out descendants of a collection A with a specific property. This property is being a descendant of a visible collection other than A. Used for effective children calculations

(mu/defn visible-collection-ids->direct-visible-descendant-clause
  [parent-collection :- CollectionWithLocationAndIDOrRoot, collection-ids :- VisibleCollections]
  (let [parent-id           (or (:id parent-collection) "")
        child-literal       (if (collection.root/is-root-collection? parent-collection)
                              "/"
                              (format "%%/%s/" (str parent-id)))]
    (into
     ;; if the collection-ids are empty, the whole into turns into nil and we have a dangling [:and] clause in query.
     ;; the (1 = 1) is to prevent this
     [:and [:= [:inline 1] [:inline 1]]]
     (if (= collection-ids :all)
       ;; In the case that visible-collection-ids is all, that means there's no invisible collection ids
       ;; meaning, the effective children are always the direct children. So check for being a direct child.
       [[:like :location (h2x/literal child-literal)]]
       (let [to-disj-ids         (location-path->ids (or (:effective_location parent-collection) "/"))
             disj-collection-ids (apply disj collection-ids (conj to-disj-ids parent-id))]
         (for [visible-collection-id disj-collection-ids]
           [:not-like :location (h2x/literal (format "%%/%s/%%" (str visible-collection-id)))]))))))
(mu/defn ^:private effective-location-path* :- [:maybe LocationPath]
  ([collection :- CollectionWithLocationOrRoot]
   (if (collection.root/is-root-collection? collection)
     nil
     (effective-location-path* (:location collection)
                               (permissions-set->visible-collection-ids @*current-user-permissions-set*))))
  ([real-location-path     :- LocationPath
    allowed-collection-ids :- VisibleCollections]
   (if (= allowed-collection-ids :all)
     real-location-path
     (apply location-path (for [id    (location-path->ids real-location-path)
                                :when (contains? allowed-collection-ids id)]
                            id)))))
(mi/define-simple-hydration-method effective-location-path
  :effective_location
  "Given a `location-path` and a set of Collection IDs one is allowed to view (obtained from
  `permissions-set->visible-collection-ids` above), calculate the 'effective' location path (excluding IDs of
  Collections for which we do not have read perms) we should show to the User.
  When called with a single argument, `collection`, this is used as a hydration function to hydrate
  `:effective_location`."
  ([collection]
   (effective-location-path* collection))
  ([real-location-path allowed-collection-ids]
   (effective-location-path* real-location-path allowed-collection-ids)))

+----------------------------------------------------------------------------------------------------------------+ | Nested Collections: Ancestors, Childrens, Child Collections | +----------------------------------------------------------------------------------------------------------------+

(mu/defn ^:private ancestors* :- [:maybe [:sequential (mi/InstanceOf Collection)]]
  [{:keys [location]}]
  (when-let [ancestor-ids (seq (location-path->ids location))]
    (t2/select [Collection :name :id :personal_owner_id]
      :id [:in ancestor-ids]
      {:order-by [:location]})))
(mi/define-simple-hydration-method ^:private ancestors
  :ancestors
  "Fetch ancestors (parent, grandparent, etc.) of a `collection`. These are returned in order starting with the
  highest-level (e.g. most distant) ancestor."
  [collection]
  (ancestors* collection))
(mu/defn ^:private effective-ancestors* :- [:sequential [:or RootCollection (mi/InstanceOf Collection)]]
  [collection :- CollectionWithLocationAndIDOrRoot]
  (if (collection.root/is-root-collection? collection)
    []
    (filter mi/can-read? (cons (root-collection-with-ui-details (:namespace collection)) (ancestors collection)))))
(mi/define-simple-hydration-method effective-ancestors
  :effective_ancestors
  "Fetch the ancestors of a `collection`, filtering out any ones the current User isn't allowed to see. This is used
  in the UI to power the 'breadcrumb' path to the location of a given Collection. For example, suppose we have four
  Collections, nested like:
    A > B > C > D
  The ancestors of D are:
    [Root] > A > B > C
  If the current User is allowed to see A and C, but not B, `effective-ancestors` of D will be:
    [Root] > A > C
  Thus the existence of C will be kept hidden from the current User, and for all intents and purposes the current User
  can effectively treat A as the parent of C."
  [collection]
  (effective-ancestors* collection))
(mu/defn ^:private parent-id* :- [:maybe ms/PositiveInt]
  [{:keys [location]} :- CollectionWithLocationOrRoot]
  (some-> location location-path->parent-id))
(mi/define-simple-hydration-method parent-id
  :parent_id
  "Get the immediate parent `collection` id, if set."
  [collection]
  (parent-id* collection))
(mu/defn children-location :- LocationPath
  "Given a `collection` return a location path that should match the `:location` value of all the children of the
  Collection.
     (children-location collection) ; -> \"/10/20/30/\";
     ;; To get children of this collection:
     (t2/select Collection :location \"/10/20/30/\")"
  [{:keys [location], :as collection} :- CollectionWithLocationAndIDOrRoot]
  (if (collection.root/is-root-collection? collection)
    "/"
    (str location (u/the-id collection) "/")))
(def ^:private Children
  [:schema
   {:registry {::children [:and
                           (mi/InstanceOf Collection)
                           [:map
                            [:children [:set [:ref ::children]]]]]}}
   [:ref ::children]])
(mu/defn ^:private descendants :- [:set Children]
  "Return all descendant Collections of a `collection`, including children, grandchildren, and so forth. This is done
  primarily to power the `effective-children` feature below, and thus the descendants are returned in a hierarchy,
  rather than as a flat set. e.g. results will be something like:
       +-> B
       |
    A -+-> C -+-> D -> E
              |
              +-> F -> G
  where each letter represents a Collection, and the arrows represent values of its respective `:children`
  set."
  [collection :- CollectionWithLocationAndIDOrRoot, & additional-honeysql-where-clauses]
  ;; first, fetch all the descendants of the `collection`, and build a map of location -> children. This will be used
  ;; so we can fetch the immediate children of each Collection
  (let [location->children (group-by :location (t2/select [Collection :name :id :location :description]
                                                 {:where
                                                  (apply
                                                   vector
                                                   :and
                                                   [:like :location (str (children-location collection) "%")]
                                                   ;; Only return the Personal Collection belonging to the Current
                                                   ;; User, regardless of whether we should actually be allowed to see
                                                   ;; it (e.g., admins have perms for all Collections). This is done
                                                   ;; to keep the Root Collection View for admins from getting crazily
                                                   ;; cluttered with Personal Collections belonging to randos
                                                   [:or
                                                    [:= :personal_owner_id nil]
                                                    [:= :personal_owner_id *current-user-id*]]
                                                   additional-honeysql-where-clauses)}))
        ;; Next, build a function to add children to a given `coll`. This function will recursively call itself to add
        ;; children to each child
        add-children       (fn add-children [coll]
                             (let [children (get location->children (children-location coll))]
                               (assoc coll :children (set (map add-children children)))))]
    ;; call the `add-children` function we just built on the root `collection` that was passed in.
    (-> (add-children collection)
        ;; since this function will be used for hydration (etc.), return only the newly produced `:children`
        ;; key
        :children)))
(mu/defn descendant-ids :- [:maybe [:set ms/PositiveInt]]
  "Return a set of IDs of all descendant Collections of a `collection`."
  [collection :- CollectionWithLocationAndIDOrRoot]
  (t2/select-pks-set Collection :location [:like (str (children-location collection) \%)]))
(mu/defn ^:private effective-children-where-clause
  [collection & additional-honeysql-where-clauses]
  (let [visible-collection-ids (permissions-set->visible-collection-ids @*current-user-permissions-set*)]
    ;; Collection B is an effective child of Collection A if...
    (into
      [:and
       ;; it is a descendant of Collection A
       [:like :location (h2x/literal (str (children-location collection) "%"))]
       ;; it is visible.
       (visible-collection-ids->honeysql-filter-clause :id visible-collection-ids)
       ;; it is NOT a descendant of a visible Collection other than A
       (visible-collection-ids->direct-visible-descendant-clause (t2/hydrate collection :effective_location) visible-collection-ids)
       ;; don't want personal collections in collection items. Only on the sidebar
       [:= :personal_owner_id nil]]
      ;; (any additional conditions)
      additional-honeysql-where-clauses)))
(mu/defn effective-children-query :- [:map
                                      [:select :any]
                                      [:from   :any]
                                      [:where  :any]]
  "Return a query for the descendant Collections of a `collection`
  that should be presented to the current user as the children of this Collection.
  This takes into account descendants that get filtered out when the current user can't see them. For
  example, suppose we have some Collections with a hierarchy like this:
       +-> B
       |
    A -+-> C -+-> D -> E
              |
              +-> F -> G
   Suppose the current User can see A, B, E, F, and G, but not C, or D. The 'effective' children of A would be B, E,
   and F, and the current user would be presented with a hierarchy like:
       +-> B
       |
    A -+-> E
       |
       +-> F -> G
   You can think of this process as 'collapsing' the Collection hierarchy and removing nodes that aren't visible to
   the current User. This needs to be done so we can give a User a way to navigate to nodes that they are allowed to
   access, but that are children of Collections they cannot access; in the example above, E and F are such nodes."
  [collection :- CollectionWithLocationAndIDOrRoot & additional-honeysql-where-clauses]
  {:select [:id :name :description]
   :from   [[:collection :col]]
   :where  (apply effective-children-where-clause collection additional-honeysql-where-clauses)})
(mu/defn ^:private effective-children* :- [:set (mi/InstanceOf Collection)]
  [collection :- CollectionWithLocationAndIDOrRoot & additional-honeysql-where-clauses]
  (set (t2/select [Collection :id :name :description]
                  {:where (apply effective-children-where-clause collection additional-honeysql-where-clauses)})))
(mi/define-simple-hydration-method effective-children
  :effective_children
  "Get the descendant Collections of `collection` that should be presented to the current User as direct children of
  this Collection. See documentation for [[metabase.models.collection/effective-children-query]] for more details."
  [collection & additional-honeysql-where-clauses]
  (apply effective-children* collection additional-honeysql-where-clauses))

+----------------------------------------------------------------------------------------------------------------+ | Recursive Operations: Moving & Archiving | +----------------------------------------------------------------------------------------------------------------+

(mu/defn perms-for-archiving :- [:set perms.u/PathSchema]
  "Return the set of Permissions needed to archive or unarchive a `collection`. Since archiving a Collection is
  *recursive* (i.e., it applies to all the descendant Collections of that Collection), we require write ('curate')
  permissions for the Collection itself and all its descendants, but not for its parent Collection.
  For example, suppose we have a Collection hierarchy like:
    A > B > C
  To move or archive B, you need write permissions for A, B, and C:
  *  A, because you are taking something out of it (by archiving it)
  *  B, because you are archiving it
  *  C, because by archiving its parent, you are archiving it as well"
  [collection :- CollectionWithLocationAndIDOrRoot]
  ;; Make sure we're not trying to archive the Root Collection...
  (when (collection.root/is-root-collection? collection)
    (throw (Exception. (tru "You cannot archive the Root Collection."))))
  ;; Make sure we're not trying to archive the Custom Reports Collection...
  (when (= (perms/default-custom-reports-collection) collection)
    (throw (Exception. (tru "You cannot archive the Custom Reports Collection."))))
  ;; also make sure we're not trying to archive a PERSONAL Collection
  (when (t2/exists? Collection :id (u/the-id collection), :personal_owner_id [:not= nil])
    (throw (Exception. (tru "You cannot archive a Personal Collection."))))
  (set
   (for [collection-or-id (cons
                           (parent collection)
                           (cons
                            collection
                            (t2/select-pks-set Collection :location [:like (str (children-location collection) "%")])))]
     (perms/collection-readwrite-path collection-or-id))))
(mu/defn perms-for-moving :- [:set perms.u/PathSchema]
  "Return the set of Permissions needed to move a `collection`. Like archiving, moving is recursive, so we require
  perms for both the Collection and its descendants; we additionally require permissions for its new parent Collection.
  For example, suppose we have a Collection hierarchy of three Collections, A, B, and C, and a forth Collection, D,
  and we want to move B from A to D:
    A > B > C        A
               ===>
    D                D > B > C
  To move or archive B, you would need write permissions for A, B, C, and D:
  *  A, because we're moving something out of it
  *  B, since it's the Collection we're operating on
  *  C, since it will by definition be affected too
  *  D, because it's the new parent Collection, and moving something into it requires write perms."
  [collection :- CollectionWithLocationAndIDOrRoot
   new-parent :- CollectionWithLocationAndIDOrRoot]
  ;; Make sure we're not trying to move the Root Collection...
  (when (collection.root/is-root-collection? collection)
    (throw (Exception. (tru "You cannot move the Root Collection."))))
  ;; Needless to say, it makes no sense to move a Collection into itself or into one of its descendants. So let's make
  ;; sure we're not doing that...
  (when (contains? (set (location-path->ids (children-location new-parent)))
                   (u/the-id collection))
    (throw (Exception. (tru "You cannot move a Collection into itself or into one of its descendants."))))
  (set
   (cons (perms/collection-readwrite-path new-parent)
         (perms-for-archiving collection))))

Move a Collection and all its descendant Collections from its current location to a new-location.

(mu/defn move-collection!
  [collection :- CollectionWithLocationAndIDOrRoot, new-location :- LocationPath]
  (let [orig-children-location (children-location collection)
        new-children-location  (children-location (assoc collection :location new-location))]
    ;; first move this Collection
    (log/info (trs "Moving Collection {0} and its descendants from {1} to {2}"
                   (u/the-id collection) (:location collection) new-location))
    (t2/with-transaction [_conn]
      (t2/update! Collection (u/the-id collection) {:location new-location})
      ;; we need to update all the descendant collections as well...
      (t2/query-one
       {:update :collection
        :set    {:location [:replace :location orig-children-location new-children-location]}
        :where  [:like :location (str orig-children-location "%")]}))))
(mu/defn ^:private collection->descendant-ids :- [:maybe [:set ms/PositiveInt]]
  [collection :- CollectionWithLocationAndIDOrRoot, & additional-conditions]
  (apply t2/select-pks-set Collection
         :location [:like (str (children-location collection) "%")]
         additional-conditions))

Archive a Collection and its descendant Collections and their Cards, Dashboards, and Pulses.

(mu/defn ^:private archive-collection!
  [collection :- CollectionWithLocationAndIDOrRoot]
  (let [affected-collection-ids (cons (u/the-id collection)
                                      (collection->descendant-ids collection, :archived false))]
    (t2/with-transaction [_conn]
      (t2/update! (t2/table-name Collection)
                  {:id       [:in affected-collection-ids]
                   :archived false}
                  {:archived true})
     (doseq [model '[Card Dashboard NativeQuerySnippet Pulse]]
       (t2/update! model {:collection_id [:in affected-collection-ids]
                           :archived      false}
                    {:archived true})))))

Unarchive a Collection and its descendant Collections and their Cards, Dashboards, and Pulses.

(mu/defn ^:private unarchive-collection!
  [collection :- CollectionWithLocationAndIDOrRoot]
  (let [affected-collection-ids (cons (u/the-id collection)
                                      (collection->descendant-ids collection, :archived true))]
    (t2/with-transaction [_conn]
      (t2/update! (t2/table-name Collection)
               {:id       [:in affected-collection-ids]
                :archived true}
               {:archived false})
      (doseq [model '[Card Dashboard NativeQuerySnippet Pulse]]
        (t2/update! model {:collection_id [:in affected-collection-ids]
                           :archived      true}
                   {:archived false})))))

+----------------------------------------------------------------------------------------------------------------+ | Toucan IModel & Perms Method Impls | +----------------------------------------------------------------------------------------------------------------+

Schema for a Collection instance that has a valid :location, and a :personal_owner_id key present (but not neccesarily non-nil).

(def ^:private CollectionWithLocationAndPersonalOwnerID
  [:map
   [:location          LocationPath]
   [:personal_owner_id [:maybe ms/PositiveInt]]])
(mu/defn is-personal-collection-or-descendant-of-one? :- :boolean
  "Is `collection` a Personal Collection, or a descendant of one?"
  [collection :- CollectionWithLocationAndPersonalOwnerID]
  (boolean
   (or
    ;; If collection has an owner ID we're already done here, we know it's a Personal Collection
    (:personal_owner_id collection)
    ;; Otherwise try to get the ID of its highest-level ancestor, e.g. if `location` is `/1/2/3/` we would get `1`.
    ;; Then see if the root-level ancestor is a Personal Collection (Personal Collections can only got in the Root
    ;; Collection.)
    (t2/exists? Collection
                :id                (first (location-path->ids (:location collection)))
                :personal_owner_id [:not= nil]))))

----------------------------------------------------- INSERT -----------------------------------------------------

(t2/define-before-insert :model/Collection
  [{collection-name :name, :as collection}]
  (assert-valid-location collection)
  (assert-valid-namespace (merge {:namespace nil} collection))
  (assoc collection :slug (slugify collection-name)))

Grant read permissions to destination Collections for every Group with read permissions for a source Collection, and write perms for every Group with write perms for the source Collection.

(defn- copy-collection-permissions!
  [source-collection-or-id dest-collections-or-ids]
  ;; figure out who has permissions for the source Collection...
  (let [group-ids-with-read-perms  (t2/select-fn-set :group_id Permissions
                                                     :object (perms/collection-read-path source-collection-or-id))
        group-ids-with-write-perms (t2/select-fn-set :group_id Permissions
                                                     :object (perms/collection-readwrite-path source-collection-or-id))]
    ;; ...and insert corresponding rows for each destination Collection
    (t2/insert! Permissions
      (concat
       ;; insert all the new read-perms records
       (for [dest     dest-collections-or-ids
             :let     [read-path (perms/collection-read-path dest)]
             group-id group-ids-with-read-perms]
         {:group_id group-id, :object read-path})
       ;; ...and all the new write-perms records
       (for [dest     dest-collections-or-ids
             :let     [readwrite-path (perms/collection-readwrite-path dest)]
             group-id group-ids-with-write-perms]
         {:group_id group-id, :object readwrite-path})))))

When creating a new Collection, we shall copy the Permissions entries for its parent. That way, Groups who can see its parent can see it; and Groups who can 'curate' (write) its parent can 'curate' it, as a default state. (Of course, admins can change these permissions after the fact.)

This does not apply to Collections that are created inside a Personal Collection or one of its descendants. Descendants of Personal Collections, like Personal Collections themselves, cannot have permissions entries in the application database.

For newly created Collections at the root-level, copy the existing permissions for the Root Collection.

(defn- copy-parent-permissions!
  [{:keys [location id], collection-namespace :namespace, :as collection}]
  (when-not (is-personal-collection-or-descendant-of-one? collection)
    (let [parent-collection-id (location-path->parent-id location)]
      (copy-collection-permissions! (or parent-collection-id (assoc root-collection :namespace collection-namespace))
                                    [id]))))
(t2/define-after-insert :model/Collection
  [collection]
  (u/prog1 collection
    (copy-parent-permissions! (t2.realize/realize collection))))

----------------------------------------------------- UPDATE -----------------------------------------------------

If we're trying to UPDATE a Personal Collection, make sure the proposed changes are allowed. Personal Collections have lots of restrictions -- you can't archive them, for example, nor can you transfer them to other Users.

(mu/defn ^:private check-changes-allowed-for-personal-collection
  [collection-before-updates :- CollectionWithLocationAndIDOrRoot
   collection-updates        :- :map]
  ;; you're not allowed to change the `:personal_owner_id` of a Collection!
  ;; double-check and make sure it's not just the existing value getting passed back in for whatever reason
  (let [unchangeable {:personal_owner_id (tru "You are not allowed to change the owner of a Personal Collection.")
                      :authority_level   (tru "You are not allowed to change the authority level of a Personal Collection.")
                      ;; The checks below should be redundant because the `perms-for-moving` and `perms-for-archiving`
                      ;; functions also check to make sure you're not operating on Personal Collections. But as an extra safety net it
                      ;; doesn't hurt to check here too.
                      :location          (tru "You are not allowed to move a Personal Collection.")
                      :archived          (tru "You cannot archive a Personal Collection.")}]
    (when-let [[k msg] (->> unchangeable
                            (filter (fn [[k _msg]]
                                      (api/column-will-change? k collection-before-updates collection-updates)))
                            first)]
      (throw
       (ex-info msg {:status-code 400 :errors {k msg}})))))

If :archived specified in the updates map, archive/unarchive as needed.

(mu/defn ^:private maybe-archive-or-unarchive!
  [collection-before-updates :- CollectionWithLocationAndIDOrRoot
   collection-updates        :- :map]
  ;; If the updates map contains a value for `:archived`, see if it's actually something different than current value
  (when (api/column-will-change? :archived collection-before-updates collection-updates)
    ;; check to make sure we're not trying to change location at the same time
    (when (api/column-will-change? :location collection-before-updates collection-updates)
      (throw (ex-info (tru "You cannot move a Collection and archive it at the same time.")
               {:status-code 400
                :errors      {:archived (tru "You cannot move a Collection and archive it at the same time.")}})))
    ;; ok, go ahead and do the archive/unarchive operation
    ((if (:archived collection-updates)
       archive-collection!
       unarchive-collection!) collection-before-updates)))

MOVING COLLECTIONS ACROSS "PERSONAL" BOUNDARIES

As mentioned elsewhere, Permissions for Collections are handled in two different, incompatible, ways, depending on whether or not the Collection is a descendant of a Personal Collection:

  • Personal Collections, and their descendants, DO NOT have Permissions for different Groups recorded in the application Database. Perms are bound dynamically, so that the Current User has read/write perms for their Personal Collection, and for any of its descendant Collections. These CANNOT be edited.

  • Collections that are NOT descendants of Personal Collections are assigned permissions on a Group-by-Group basis using Permissions entries from the application DB, and edited via the permissions graph.

Thus, When a Collection moves "across the boundary" and either becomes a descendant of a Personal Collection, or ceases to be one, we need to take steps to transition it so it plays nicely with the new way Permissions will apply to it. The steps taken in each direction are explained in more detail for in the docstrings of their respective implementing functions below.

When moving a descendant of a Personal Collection into the Root Collection, or some other Collection not descended from a Personal Collection, we need to grant it Permissions, since now that it has moved across the boundary into impersonal-land it requires Permissions to be seen or 'curated'. If we did not grant Permissions when moving, it would immediately become invisible to all save admins, because no Group would have perms for it. This is obviously a bad experience -- we do not want a User to move a Collection that they have read/write perms for (by definition) to somewhere else and lose all access for it.

(mu/defn ^:private grant-perms-when-moving-out-of-personal-collection!
  [collection :- (mi/InstanceOf Collection) new-location :- LocationPath]
  (copy-collection-permissions! (parent {:location new-location}) (cons collection (descendants collection))))

When moving a collection that is not a descendant of a Personal Collection into a Personal Collection or one of its descendants (moving across the boundary in the other direction), any previous Group Permissions entries for it need to be deleted, so other users cannot access this newly-Personal Collection.

This needs to be done recursively for all descendants as well.

(mu/defn ^:private revoke-perms-when-moving-into-personal-collection!
  [collection :- (mi/InstanceOf Collection)]
  (t2/query-one {:delete-from :permissions
                 :where       [:in :object (for [collection (cons collection (descendants collection))
                                                 path-fn    [perms/collection-read-path
                                                             perms/collection-readwrite-path]]
                                             (path-fn collection))]}))

If a Collection is moving 'across the boundry' and will become a descendant of a Personal Collection, or will cease to be one, adjust the Permissions for it accordingly.

(defn- update-perms-when-moving-across-personal-boundry!
  [collection-before-updates collection-updates]
  ;; first, figure out if the collection is a descendant of a Personal Collection now, and whether it will be after
  ;; the update
  (let [is-descendant-of-personal?      (is-personal-collection-or-descendant-of-one? collection-before-updates)
        will-be-descendant-of-personal? (is-personal-collection-or-descendant-of-one? (merge collection-before-updates
                                                                                             collection-updates))]
    ;; see if whether it is a descendant of a Personal Collection or not is set to change. If it's not going to
    ;; change, we don't need to do anything
    (when (not= is-descendant-of-personal? will-be-descendant-of-personal?)
      ;; if it *is* a descendant of a Personal Collection, and is about to be moved into the 'real world', we need to
      ;; copy the new parent's perms for it and for all of its descendants
      (if is-descendant-of-personal?
        (grant-perms-when-moving-out-of-personal-collection! collection-before-updates (:location collection-updates))
        ;; otherwise, if it is *not* a descendant of a Personal Collection, but is set to become one, we need to
        ;; delete any perms entries for it and for all of its descendants, so other randos won't be able to access
        ;; this newly privatized Collection
        (revoke-perms-when-moving-into-personal-collection! collection-before-updates)))))

PUTTING IT ALL TOGETHER <3

Returns true if the :namespace values (for a collection) are equal between multiple instances. Either one can be a string or keyword.

This is necessary because on select, the :namespace value becomes a keyword (and hence, is a keyword in pre-update, but when passing an entity to update, it must be given as a string, not a keyword, because otherwise HoneySQL will attempt to quote it as a column name instead of a string value (and the update statement will fail).

(defn- namespace-equals?
  [& namespaces]
  (let [std-fn (fn [v]
                 (if (keyword? v) (name v) (str v)))]
    (apply = (map std-fn namespaces))))
(t2/define-before-update :model/Collection
  [collection]
  (let [collection-before-updates (t2/instance :model/Collection (t2/original collection))
        {collection-name :name
         :as collection-updates}  (or (t2/changes collection) {})]
    ;; VARIOUS CHECKS BEFORE DOING ANYTHING:
    ;; (1) if this is a personal Collection, check that the 'propsed' changes are allowed
    (when (:personal_owner_id collection-before-updates)
      (check-changes-allowed-for-personal-collection collection-before-updates collection-updates))
    ;; (2) make sure the location is valid if we're changing it
    (assert-valid-location collection-updates)
    ;; (3) make sure Collection namespace is valid
    (when (contains? collection-updates :namespace)
      (when-not (namespace-equals? (:namespace collection-before-updates) (:namespace collection-updates))
        (let [msg (tru "You cannot move a Collection to a different namespace once it has been created.")]
          (throw (ex-info msg {:status-code 400, :errors {:namespace msg}})))))
    (assert-valid-namespace (merge (select-keys collection-before-updates [:namespace]) collection-updates))
    ;; (4) If we're moving a Collection from a location on a Personal Collection hierarchy to a location not on one,
    ;; or vice versa, we need to grant/revoke permissions as appropriate (see above for more details)
    (when (api/column-will-change? :location collection-before-updates collection-updates)
      (update-perms-when-moving-across-personal-boundry! collection-before-updates collection-updates))
    ;; OK, AT THIS POINT THE CHANGES ARE VALIDATED. NOW START ISSUING UPDATES
    ;; (1) archive or unarchive as appropriate
    (maybe-archive-or-unarchive! collection-before-updates collection-updates)
    ;; (2) slugify the collection name in case it's changed in the output; the results of this will get passed along
    ;; to Toucan's `update!` impl
    (cond-> collection-updates
      collection-name (assoc :slug (slugify collection-name)))))

----------------------------------------------------- DELETE -----------------------------------------------------

Whether to allow deleting Personal Collections. Normally we should never allow this, but in the single case of deleting a User themselves, we need to allow this. (Note that in normal usage, Users never get deleted, but rather archived; thus this code is used solely by our test suite, by things such as the with-temp macros.)

(defonce ^:dynamic 
  *allow-deleting-personal-collections*
  false)
(t2/define-before-delete :model/Collection
  [collection]
  ;; Delete all the Children of this Collection
  (t2/delete! Collection :location (children-location collection))
  ;; You can't delete a Personal Collection! Unless we enable it because we are simultaneously deleting the User
  (when-not *allow-deleting-personal-collections*
    (when (:personal_owner_id collection)
      (throw (Exception. (tru "You cannot delete a Personal Collection!")))))
  ;; Delete permissions records for this Collection
  (t2/query-one {:delete-from :permissions
                 :where       [:or
                               [:= :object (perms/collection-readwrite-path collection)]
                               [:= :object (perms/collection-read-path collection)]]}))

-------------------------------------------------- IModel Impl ---------------------------------------------------

Return the required set of permissions to read-or-write collection-or-id.

(defmethod mi/perms-objects-set Collection
  [collection-or-id read-or-write]
  (let [collection (if (integer? collection-or-id)
                     (t2/select-one [Collection :id :namespace] :id (collection-or-id))
                     collection-or-id)]
    ;; HACK Collections in the "snippets" namespace have no-op permissions unless EE enhancements are enabled
    ;;
    ;; TODO -- Pretty sure snippet perms should be feature flagged by `advanced-permissions` instead
    (if (and (= (u/qualified-name (:namespace collection)) "snippets")
             (not (premium-features/enable-enhancements?)))
      #{}
      ;; This is not entirely accurate as you need to be a superuser to modifiy a collection itself (e.g., changing its
      ;; name) but if you have write perms you can add/remove cards
      #{(case read-or-write
          :read  (perms/collection-read-path collection-or-id)
          :write (perms/collection-readwrite-path collection-or-id))})))
(defn- parent-identity-hash [coll]
  (let [parent-id (-> coll
                      (t2/hydrate :parent_id)
                      :parent_id)]
    (if parent-id
      (serdes/identity-hash (t2/select-one Collection :id parent-id))
      "ROOT")))
(defmethod serdes/hash-fields Collection
  [_collection]
  [:name :namespace parent-identity-hash :created_at])
(defmethod serdes/extract-query "Collection" [_model {:keys [collection-set]}]
  (if (seq collection-set)
    (t2/reducible-select Collection :id [:in collection-set])
    (t2/reducible-select Collection :personal_owner_id nil)))
(defmethod serdes/extract-one "Collection"
  ;; Transform :location (which uses database IDs) into a portable :parent_id with the parent's entity ID.
  ;; Also transform :personal_owner_id from a database ID to the email string, if it's defined.
  ;; Use the :slug as the human-readable label.
  [_model-name _opts coll]
  (let [fetch-collection (fn [id]
                           (t2/select-one Collection :id id))
        parent           (some-> coll
                                 :id
                                 fetch-collection
                                 (t2/hydrate :parent_id)
                                 :parent_id
                                 fetch-collection)
        parent-id        (when parent
                           (or (:entity_id parent) (serdes/identity-hash parent)))
        owner-email      (when (:personal_owner_id coll)
                           (t2/select-one-fn :email 'User :id (:personal_owner_id coll)))]
    (-> (serdes/extract-one-basics "Collection" coll)
        (dissoc :location)
        (assoc :parent_id parent-id :personal_owner_id owner-email)
        (assoc-in [:serdes/meta 0 :label] (:slug coll)))))
(defmethod serdes/load-xform "Collection" [{:keys [parent_id] :as contents}]
  (let [loc        (if parent_id
                     (let [{:keys [id location]} (serdes/lookup-by-id Collection parent_id)]
                       (str location id "/"))
                     "/")]
    (-> contents
        (dissoc :parent_id)
        (assoc :location loc)
        (update :personal_owner_id serdes/*import-user*)
        serdes/load-xform-basics)))
(defmethod serdes/dependencies "Collection"
  [{:keys [parent_id]}]
  (if parent_id
    [[{:model "Collection" :id parent_id}]]
    []))
(defmethod serdes/generate-path "Collection" [_ coll]
  (serdes/maybe-labeled "Collection" coll :slug))
(defmethod serdes/ascendants "Collection" [_ id]
  (let [location (t2/select-one-fn :location Collection :id id)]
    ;; it would work returning just one, but why not return all if it's cheap
    (set (map vector (repeat "Collection") (location-path->ids location)))))
(defmethod serdes/descendants "Collection" [_model-name id]
  (let [location    (t2/select-one-fn :location Collection :id id)
        child-colls (set (for [child-id (t2/select-pks-set Collection {:where [:like :location (str location id "/%")]})]
                           ["Collection" child-id]))
        dashboards  (set (for [dash-id (t2/select-pks-set 'Dashboard :collection_id id)]
                           ["Dashboard" dash-id]))
        cards       (set (for [card-id (t2/select-pks-set 'Card      :collection_id id)]
                           ["Card" card-id]))]
    (set/union child-colls dashboards cards)))
(defmethod serdes/storage-path "Collection" [coll {:keys [collections]}]
  (let [parental (get collections (:entity_id coll))]
    (concat ["collections"] parental [(last parental)])))

+----------------------------------------------------------------------------------------------------------------+ | Perms Checking Helper Fns | +----------------------------------------------------------------------------------------------------------------+

Check that we have write permissions for Collection with collection-id, or throw a 403 Exception. If collection-id is nil, this check is done for the Root Collection.

(defn check-write-perms-for-collection
  [collection-or-id-or-nil]
  (let [actual-perms   @*current-user-permissions-set*
        required-perms (perms/collection-readwrite-path (if collection-or-id-or-nil
                                                          collection-or-id-or-nil
                                                          root-collection))]
    (when-not (perms/set-has-full-permissions? actual-perms required-perms)
      (throw (ex-info (tru "You do not have curate permissions for this Collection.")
                      {:status-code    403
                       :collection     collection-or-id-or-nil
                       :required-perms required-perms
                       :actual-perms   actual-perms})))))

If we're changing the collection_id of an object, make sure we have write permissions for both the old and new Collections, or throw a 403 if not. If collection_id isn't present in object-updates, or the value is the same as the original, this check is a no-op.

As usual, an collection-id of nil represents the Root Collection.

Intended for use with PUT or PATCH-style operations. Usage should look something like:

;; object-before-update is the object as it currently exists in the application DB ;; object-updates is a map of updated values for the object (check-allowed-to-change-collection (t2/select-one Card :id 100) http-request-body)

(defn check-allowed-to-change-collection
  [object-before-update object-updates]
  ;; if collection_id is set to change...
  (when (api/column-will-change? :collection_id object-before-update object-updates)
    ;; check that we're allowed to modify the old Collection
    (check-write-perms-for-collection (:collection_id object-before-update))
    ;; check that we're allowed to modify the new Collection
    (check-write-perms-for-collection (:collection_id object-updates))))

+----------------------------------------------------------------------------------------------------------------+ | Personal Collections | +----------------------------------------------------------------------------------------------------------------+

(mu/defn format-personal-collection-name :- ms/NonBlankString
  "Constructs the personal collection name from user name.
  When displaying to users we'll tranlsate it to user's locale,
  but to keeps things consistent in the database, we'll store the name in site's locale.
  Practically, use `user-or-site` = `:site` when insert or update the name in database,
  and `:user` when we need the name for displaying purposes"
  [first-name last-name email user-or-site]
  {:pre [(#{:user :site} user-or-site)]}
  (if (= :user user-or-site)
    (cond
      (and first-name last-name) (tru "{0} {1}''s Personal Collection" first-name last-name)
      :else                      (tru "{0}''s Personal Collection" (or first-name last-name email)))
    (cond
      (and first-name last-name) (trs "{0} {1}''s Personal Collection" first-name last-name)
      :else                      (trs "{0}''s Personal Collection" (or first-name last-name email)))))
(mu/defn user->personal-collection-name :- ms/NonBlankString
  "Come up with a nice name for the Personal Collection for `user-or-id`."
  [user-or-id user-or-site]
  (let [{first-name :first_name
         last-name  :last_name
         email      :email} (t2/select-one ['User :first_name :last_name :email]
                              :id (u/the-id user-or-id))]
    (format-personal-collection-name first-name last-name email user-or-site)))

For Personal collection, we make sure the collection's name and slug is translated to user's locale This is only used for displaying purposes, For insertion or updating the name, use site's locale instead

(defn personal-collection-with-ui-details
  [{:keys [personal_owner_id] :as collection}]
  (if-not personal_owner_id
    collection
    (let [collection-name (user->personal-collection-name personal_owner_id :user)]
      (assoc collection
             :name collection-name
             :slug (u/slugify collection-name)))))
(mu/defn user->existing-personal-collection :- [:maybe (mi/InstanceOf Collection)]
  "For a `user-or-id`, return their personal Collection, if it already exists.
  Use [[metabase.models.collection/user->personal-collection]] to fetch their personal Collection *and* create it if
  needed."
  [user-or-id]
  (t2/select-one Collection :personal_owner_id (u/the-id user-or-id)))
(mu/defn user->personal-collection :- (mi/InstanceOf Collection)
  "Return the Personal Collection for `user-or-id`, if it already exists; if not, create it and return it."
  [user-or-id]
  (or (user->existing-personal-collection user-or-id)
      (try
        (first (t2/insert-returning-instances! Collection
                                               {:name              (user->personal-collection-name user-or-id :site)
                                                :personal_owner_id (u/the-id user-or-id)}))
        ;; if an Exception was thrown why trying to create the Personal Collection, we can assume it was a race
        ;; condition where some other thread created it in the meantime; try one last time to fetch it
        (catch Throwable e
          (or (user->existing-personal-collection user-or-id)
              (throw e))))))

Cached function to fetch the ID of the Personal Collection belonging to User with user-id. Since a Personal Collection cannot be deleted, the ID will not change; thus it is safe to cache, saving a DB call. It is also required to caclulate the Current User's permissions set, which is done for every API call; thus it is cached to save a DB call for every API call.

(def ^:private ^{:arglists '([user-id])} user->personal-collection-id
  (memoize/ttl
   ^{::memoize/args-fn (fn [[user-id]]
                         [(mdb.connection/unique-identifier) user-id])}
   (fn user->personal-collection-id*
     [user-id]
     (u/the-id (user->personal-collection user-id)))
   ;; cache the results for 60 minutes; TTL is here only to eventually clear out old entries/keep it from growing too
   ;; large
   :ttl/threshold (* 60 60 1000)))
(mu/defn user->personal-collection-and-descendant-ids :- [:sequential {:min 1} ms/PositiveInt]
  "Somewhat-optimized function that fetches the ID of a User's Personal Collection as well as the IDs of all descendants
  of that Collection. Exists because this needs to be known to calculate the Current User's permissions set, which is
  done for every API call; this function is an attempt to make fetching this information as efficient as reasonably
  possible."
  [user-or-id]
  (let [personal-collection-id (user->personal-collection-id (u/the-id user-or-id))]
    (cons personal-collection-id
          ;; `descendant-ids` wants a CollectionWithLocationAndID, and luckily we know Personal Collections always go
          ;; in Root, so we can pass it what it needs without actually having to fetch an entire CollectionInstance
          (descendant-ids {:location "/", :id personal-collection-id}))))
(mi/define-batched-hydration-method include-personal-collection-ids
  :personal_collection_id
  "Efficiently hydrate the `:personal_collection_id` property of a sequence of Users. (This is, predictably, the ID of
  their Personal Collection.)"
  [users]
  (when (seq users)
    ;; efficiently create a map of user ID -> personal collection ID
    (let [user-id->collection-id (t2/select-fn->pk :personal_owner_id Collection
                                   :personal_owner_id [:in (set (map u/the-id users))])]
      (assert (map? user-id->collection-id))
      ;; now for each User, try to find the corresponding ID out of that map. If it's not present (the personal
      ;; Collection hasn't been created yet), then instead call `user->personal-collection-id`, which will create it
      ;; as a side-effect. This will ensure this property never comes back as `nil`
      (for [user users]
        (assoc user :personal_collection_id (or (user-id->collection-id (u/the-id user))
                                                (user->personal-collection-id (u/the-id user))))))))
(mi/define-batched-hydration-method collection-is-personal
  :is_personal
  "Efficiently hydrate the `:is_personal` property of a sequence of Collections.
  `true` means the collection is or nested in a personal collection."
  [collections]
  (if (= 1 (count collections))
    (let [collection (first collections)]
      (if (some? collection)
        [(assoc collection :is_personal (is-personal-collection-or-descendant-of-one? collection))]
        ;; root collection is nil
        [collection]))
    (let [personal-collection-ids (t2/select-pks-set :model/collection :personal_owner_id [:not= nil])
          location-is-personal    (fn [location]
                                    (boolean
                                     (and (string? location)
                                          (some #(str/starts-with? location (format "/%d/" %)) personal-collection-ids))))]
      (map (fn [{:keys [location personal_owner_id] :as coll}]
             (if (some? coll)
               (assoc coll :is_personal (or (some? personal_owner_id)
                                            (location-is-personal location)))
               nil))
           collections))))

Set of Collection namespaces (as keywords) that instances of this model are allowed to go in. By default, only the default namespace (namespace = nil).

(defmulti allowed-namespaces
  {:arglists '([model])}
  t2.protocols/dispatch-value)
(defmethod allowed-namespaces :default
  [_]
  #{nil :analytics})

Check that object's :collection_id refers to a Collection in an allowed namespace (see allowed-namespaces), or throw an Exception.

;; Cards can only go in Collections in the default namespace (namespace = nil) (check-collection-namespace Card new-collection-id)

(defn check-collection-namespace
  [model collection-id]
  (when collection-id
    (let [collection           (or (t2/select-one [Collection :namespace] :id collection-id)
                                   (let [msg (tru "Collection does not exist.")]
                                     (throw (ex-info msg {:status-code 404
                                                          :errors      {:collection_id msg}}))))
          collection-namespace (keyword (:namespace collection))
          allowed-namespaces   (allowed-namespaces model)]
      (when-not (contains? allowed-namespaces collection-namespace)
        (let [msg (tru "A {0} can only go in Collections in the {1} namespace."
                       (name model)
                       (str/join (format " %s " (tru "or")) (map #(pr-str (or % (tru "default")))
                                                                 allowed-namespaces)))]
          (throw (ex-info msg {:status-code          400
                               :errors               {:collection_id msg}
                               :allowed-namespaces   allowed-namespaces
                               :collection-namespace collection-namespace})))))))

Annotate collections with :below and :here keys to indicate which types are in their subtree and which types are in the collection at that level.

(defn- annotate-collections
  [{:keys [dataset card] :as _coll-type-ids} collections]
  (let [parent-info (reduce (fn [m {:keys [location id] :as _collection}]
                              (let [parent-ids (set (location-path->ids location))]
                                (cond-> m
                                  (contains? dataset id)
                                  (update :dataset set/union parent-ids)
                                  (contains? card id)
                                  (update :card set/union parent-ids))))
                            {:dataset #{} :card #{}}
                            collections)]
    (map (fn [{:keys [id] :as collection}]
           (let [types (cond-> #{}
                         (contains? (:dataset parent-info) id)
                         (conj :dataset)
                         (contains? (:card parent-info) id)
                         (conj :card))]
             (cond-> collection
               (seq types) (assoc :below types)
               (contains? dataset id) (update :here (fnil conj #{}) :dataset)
               (contains? card id) (update :here (fnil conj #{}) :card))))
         collections)))

Convert a flat sequence of Collections into a tree structure e.g.

(collections->tree {:dataset #{C D} :card #{F C} [A B C D E F G]) ;; -> [{:name "A" :below #{:card :dataset} :children [{:name "B"} {:name "C" :here #{:dataset :card} :below #{:dataset :card} :children [{:name "D" :here #{:dataset} :children [{:name "E"}]} {:name "F" :here #{:card} :children [{:name "G"}]}]}]} {:name "H"}]

(defn collections->tree
  [coll-type-ids collections]
  (let [all-visible-ids (set (map :id collections))]
    (transduce
     identity
     (fn ->tree
       ;; 1. We'll use a map representation to start off with to make building the tree easier. Keyed by Collection ID
       ;; e.g.
       ;;
       ;; {1 {:name "A"
       ;;     :children {2 {:name "B"}, ...}}}
       ([] {})
       ;; 2. For each as we come across it, put it in the correct location in the tree. Convert it's `:location` (e.g.
       ;; `/1/`) plus its ID to a key path e.g. `[1 :children 2]`
       ;;
       ;; If any ancestor Collections are not present in `collections`, just remove their IDs from the path,
       ;; effectively "pulling" a Collection up to a higher level. e.g. if we have A > B > C and we can't see B then
       ;; the tree should come back as A > C.
       ([m collection]
        (let [path (as-> (location-path->ids (:location collection)) ids
                     (filter all-visible-ids ids)
                     (concat ids [(:id collection)])
                     (interpose :children ids))]
          (update-in m path merge collection)))
       ;; 3. Once we've build the entire tree structure, go in and convert each ID->Collection map into a flat sequence,
       ;; sorted by the lowercased Collection name. Do this recursively for the `:children` of each Collection e.g.
       ;;
       ;; {1 {:name "A"
       ;;     :children {2 {:name "B"}, ...}}}
       ;; ->
       ;; [{:name "A"
       ;;   :children [{:name "B"}, ...]}]
       ([m]
        (->> (vals m)
             (map #(update % :children ->tree))
             (sort-by (fn [{coll-type :type, coll-name :name, coll-id :id}]
                        ;; coll-type is `nil` or "instance-analytics"
                        ;; nil sorts first, so we get instance-analytics at the end, which is what we want
                        [coll-type ((fnil u/lower-case-en "") coll-name) coll-id])))))
     (annotate-collections coll-type-ids collections))))
 
(ns metabase.models.collection-permission-graph-revision
  (:require
   [metabase.models.interface :as mi]
   [metabase.util.i18n :refer [tru]]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase.

(def CollectionPermissionGraphRevision
  :model/CollectionPermissionGraphRevision)
(methodical/defmethod t2/table-name :model/CollectionPermissionGraphRevision [_model] :collection_permission_graph_revision)
(doto :model/CollectionPermissionGraphRevision
  (derive :metabase/model)
  (derive :hook/created-at-timestamped?))
(t2/deftransforms :model/CollectionPermissionGraphRevision
  {:before mi/transform-json
   :after  mi/transform-json})
(t2/define-before-update :model/CollectionPermissionGraphRevision
  [_]
  (throw (Exception. (tru "You cannot update a CollectionPermissionGraphRevision!"))))

Return the ID of the newest CollectionPermissionGraphRevision, or zero if none have been made yet. (This is used by the collection graph update logic that checks for changes since the original graph was fetched).

(defn latest-id
  []
  (or (:id (t2/select-one [CollectionPermissionGraphRevision [:%max.id :id]]))
      0))
 

Code for generating and updating the Collection permissions graph. See [[metabase.models.permissions]] for more details and for the code for generating and updating the data permissions graph.

(ns metabase.models.collection.graph
  (:require
   [clojure.data :as data]
   [metabase.db.query :as mdb.query]
   [metabase.models.collection :as collection :refer [Collection]]
   [metabase.models.collection-permission-graph-revision
    :as c-perm-revision
    :refer [CollectionPermissionGraphRevision]]
   [metabase.models.permissions :as perms :refer [Permissions]]
   [metabase.models.permissions-group :as perms-group :as perms-group :refer [PermissionsGroup]]
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.util :as u]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

+----------------------------------------------------------------------------------------------------------------+ | PERMISSIONS GRAPH | +----------------------------------------------------------------------------------------------------------------+

---------------------------------------------------- Schemas -----------------------------------------------------

(def ^:private CollectionPermissions
  [:enum :write :read :none])

collection-id -> status

(def ^:private GroupPermissionsGraph
  ; when doing a delta between old graph and new graph root won't always
  ; be present, which is why it's *optional*
  [:map-of [:or [:= :root] ms/PositiveInt] CollectionPermissions])
(def ^:private PermissionsGraph
  [:map {:closed true}
   [:revision :int]
   [:groups   [:map-of ms/PositiveInt GroupPermissionsGraph]]])

-------------------------------------------------- Fetch Graph ---------------------------------------------------

(defn- group-id->permissions-set []
  (into {} (for [[group-id perms] (group-by :group_id (t2/select Permissions))]
             {group-id (set (map :object perms))})))
(mu/defn ^:private perms-type-for-collection :- CollectionPermissions
  [permissions-set collection-or-id]
  (cond
    (perms/set-has-full-permissions? permissions-set (perms/collection-readwrite-path collection-or-id)) :write
    (perms/set-has-full-permissions? permissions-set (perms/collection-read-path collection-or-id))      :read
    :else                                                                                                :none))
(mu/defn ^:private group-permissions-graph :- GroupPermissionsGraph
  "Return the permissions graph for a single group having `permissions-set`."
  [collection-namespace permissions-set collection-ids]
  (into
   {:root (perms-type-for-collection permissions-set (assoc collection/root-collection :namespace collection-namespace))}
   (for [collection-id collection-ids]
     {collection-id (perms-type-for-collection permissions-set collection-id)})))
(mu/defn ^:private non-personal-collection-ids :- [:set ms/PositiveInt]
  "Return a set of IDs of all Collections that are neither Personal Collections nor descendants of Personal
  Collections (i.e., things that you can set Permissions for, and that should go in the graph.)"
  [collection-namespace :- [:maybe ms/KeywordOrString]]
  (let [personal-collection-ids (t2/select-pks-set Collection :personal_owner_id [:not= nil])
        honeysql-form           {:select [[:id :id]]
                                 :from   [:collection]
                                 :where  (into [:and
                                                (perms/audit-namespace-clause :namespace (u/qualified-name collection-namespace))
                                                [:= :personal_owner_id nil]]
                                               (for [collection-id personal-collection-ids]
                                                 [:not [:like :location (h2x/literal (format "/%d/%%" collection-id))]]))}]
    (set (map :id (mdb.query/query honeysql-form)))))

Return the permission graph for the collections with id in collection-ids and the root collection.

(defn- collection-permission-graph
  ([collection-ids] (collection-permission-graph collection-ids nil))
  ([collection-ids collection-namespace]
   (let [group-id->perms (group-id->permissions-set)]
     {:revision (c-perm-revision/latest-id)
      :groups   (into {} (for [group-id (t2/select-pks-set PermissionsGroup)]
                           {group-id (group-permissions-graph collection-namespace
                                                              (group-id->perms group-id)
                                                              collection-ids)}))})))

In the graph, override the instance analytics collection within the admin group to read.

(defn- modify-instance-analytics-for-admins
  [graph]
  (let [admin-group-id      (:id (perms-group/admin))
        audit-collection-id (:id (perms/default-audit-collection))]
    (if (nil? audit-collection-id)
      graph
      (assoc-in graph [:groups admin-group-id audit-collection-id] :read))))
(mu/defn graph :- PermissionsGraph
  "Fetch a graph representing the current permissions status for every group and all permissioned collections. This
  works just like the function of the same name in `metabase.models.permissions`; see also the documentation for that
  function.
  The graph is restricted to a given namespace by the optional `collection-namespace` param; by default, `nil`, which
  restricts it to the 'default' namespace containing normal Card/Dashboard/Pulse Collections.
  Note: All Collections are returned at the same level of the 'graph', regardless of how the Collection hierarchy is
  structured. Collections do not inherit permissions from ancestor Collections in the same way data permissions are
  inherited (e.g. full `:read` perms for a Database implies `:read` perms for all its schemas); a 'child' object (e.g.
  schema) *cannot* have more restrictive permissions than its parent (e.g. Database). Child Collections *can* have
  more restrictive permissions than their parent."
  ([]
   (graph nil))
  ([collection-namespace :- [:maybe ms/KeywordOrString]]
   (t2/with-transaction [_conn]
     (-> collection-namespace
         non-personal-collection-ids
         (collection-permission-graph collection-namespace)
         modify-instance-analytics-for-admins))))

-------------------------------------------------- Update Graph --------------------------------------------------

Update the permissions for group ID with group-id on collection with ID collection-id in the optional collection-namespace to new-collection-perms.

(mu/defn ^:private update-collection-permissions!
  [collection-namespace :- [:maybe ms/KeywordOrString]
   group-id             :- ms/PositiveInt
   collection-id        :- [:or [:= :root] ms/PositiveInt]
   new-collection-perms :- CollectionPermissions]
  (let [collection-id (if (= collection-id :root)
                        (assoc collection/root-collection :namespace collection-namespace)
                        collection-id)]
    ;; remove whatever entry is already there (if any) and add a new entry if applicable
    (perms/revoke-collection-permissions! group-id collection-id)
    (case new-collection-perms
      :write (perms/grant-collection-readwrite-permissions! group-id collection-id)
      :read  (perms/grant-collection-read-permissions! group-id collection-id)
      :none  nil)))
(mu/defn ^:private update-group-permissions!
  [collection-namespace :- [:maybe ms/KeywordOrString]
   group-id             :- ms/PositiveInt
   new-group-perms      :- GroupPermissionsGraph]
  (doseq [[collection-id new-perms] new-group-perms]
    (update-collection-permissions! collection-namespace group-id collection-id new-perms)))

OSS implementation of audit-db/update-audit-collection-permissions!, which is an enterprise feature, so does nothing in the OSS version.

(defenterprise update-audit-collection-permissions!
  metabase-enterprise.audit-app.permissions [_ _] ::noop)

Update the Collections permissions graph for Collections of collection-namespace (default nil, the 'default' namespace). This works just like [[metabase.models.permission/update-data-perms-graph!]], but for Collections; refer to that function's extensive documentation to get a sense for how this works.

(mu/defn update-graph!
  ([new-graph]
   (update-graph! nil new-graph))
  ([collection-namespace :- [:maybe ms/KeywordOrString], new-graph :- PermissionsGraph]
   (let [old-graph          (graph collection-namespace)
         old-perms          (:groups old-graph)
         new-perms          (:groups new-graph)
         ;; filter out any groups not in the old graph
         new-perms          (select-keys new-perms (keys old-perms))
         ;; filter out any collections not in the old graph
         new-perms          (into {} (for [[group-id collection-id->perms] new-perms]
                                      [group-id (select-keys collection-id->perms (keys (get old-perms group-id)))]))
         [diff-old changes] (data/diff old-perms new-perms)]
     (perms/log-permissions-changes diff-old changes)
     (perms/check-revision-numbers old-graph new-graph)
     (when (seq changes)
       (t2/with-transaction [_conn]
         (doseq [[group-id changes] changes]
           (update-audit-collection-permissions! group-id changes)
           (update-group-permissions! collection-namespace group-id changes))
         (perms/save-perms-revision! CollectionPermissionGraphRevision (:revision old-graph)
                                      (assoc old-graph :namespace collection-namespace) changes))))))
 
(ns metabase.models.collection.root
  (:require
   [medley.core :as m]
   [metabase.models.interface :as mi]
   [metabase.models.permissions :as perms]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.shared.util.i18n :refer [tru]]
   [metabase.util :as u]
   [potemkin.types :as p.types]
   [toucan2.protocols :as t2.protocols]
   [toucan2.tools.hydrate :refer [hydrate]]))

+----------------------------------------------------------------------------------------------------------------+ | Root Collection Special Placeholder Object | +----------------------------------------------------------------------------------------------------------------+

The Root Collection special placeholder object is used to represent the fact that we're working with the 'Root' Collection in many of the functions in this namespace. The Root Collection is not a true Collection, but instead represents things that have no collection_id, or are otherwise to be seen at the top-level by the current user.

(p.types/defrecord+ RootCollection [])
(doto RootCollection
  (derive ::mi/read-policy.full-perms-for-perms-set)
  (derive ::mi/write-policy.full-perms-for-perms-set))
(extend-protocol t2.protocols/IModel
  RootCollection
  (model [_this]
    RootCollection))
(defmethod mi/perms-objects-set RootCollection
  [collection read-or-write]
  {:pre [(map? collection)]}
  ;; HACK Collections in the "snippets" namespace have no-op permissions unless EE enhancements are enabled
  (if (and (= (u/qualified-name (:namespace collection)) "snippets")
           (not (premium-features/enable-enhancements?)))
    #{}
    #{((case read-or-write
         :read  perms/collection-read-path
         :write perms/collection-readwrite-path) collection)}))

Special placeholder object representing the Root Collection, which isn't really a real Collection.

(def ^RootCollection root-collection
  (map->RootCollection {::is-root? true, :authority_level nil}))

Is x the special placeholder object representing the Root Collection?

(defn is-root-collection?
  [x]
  ;; TODO -- not sure this makes sense because other places we check whether `::is-root?` is present or not.
  (instance? RootCollection x))

The special Root Collection placeholder object with some extra details to facilitate displaying it on the FE.

(defn root-collection-with-ui-details
  [collection-namespace]
  (m/assoc-some root-collection
                :name (case (keyword collection-namespace)
                        :snippets (tru "Top folder")
                        (tru "Our analytics"))
                :namespace collection-namespace
                :is_personal false
                :id   "root"))
(defn- hydrated-root-collection
  []
  (-> (root-collection-with-ui-details nil)
      (hydrate :can_write)))

Hydrate :collection onto entity when the id is nil.

(defn hydrate-root-collection
  [{:keys [collection_id] :as entity}]
  (cond-> entity
    (nil? collection_id) (assoc :collection (hydrated-root-collection))))
 
(ns metabase.models.dashboard
  (:require
   [clojure.core.async :as a]
   [clojure.data :refer [diff]]
   [clojure.set :as set]
   [clojure.string :as str]
   [medley.core :as m]
   [metabase.automagic-dashboards.populate :as populate]
   [metabase.db.query :as mdb.query]
   [metabase.events :as events]
   [metabase.models.audit-log :as audit-log]
   [metabase.models.card :as card :refer [Card]]
   [metabase.models.collection :as collection :refer [Collection]]
   [metabase.models.dashboard-card
    :as dashboard-card
    :refer [DashboardCard]]
   [metabase.models.dashboard-tab :as dashboard-tab]
   [metabase.models.field-values :as field-values]
   [metabase.models.interface :as mi]
   [metabase.models.parameter-card :as parameter-card]
   [metabase.models.params :as params]
   [metabase.models.permissions :as perms]
   [metabase.models.pulse :as pulse :refer [Pulse]]
   [metabase.models.pulse-card :as pulse-card]
   [metabase.models.revision :as revision]
   [metabase.models.serialization :as serdes]
   [metabase.moderation :as moderation]
   [metabase.public-settings :as public-settings]
   [metabase.query-processor.async :as qp.async]
   [metabase.util :as u]
   [metabase.util.i18n :as i18n :refer [deferred-tru deferred-trun tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [methodical.core :as methodical]
   [toucan2.core :as t2]
   [toucan2.realize :as t2.realize]))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all the Dashboard symbol in our codebase.

(def Dashboard
  :model/Dashboard)
(methodical/defmethod t2/table-name :model/Dashboard [_model] :report_dashboard)
(doto :model/Dashboard
  (derive :metabase/model)
  (derive ::perms/use-parent-collection-perms)
  (derive :hook/timestamped?)
  (derive :hook/entity-id))
(defmethod mi/can-write? Dashboard
  ([instance]
   ;; Dashboards in audit collection should be read only
   (if (and
        ;; We want to make sure there's an existing audit collection before doing the equality check below.
        ;; If there is no audit collection, this will be nil:
        (some? (:id (perms/default-audit-collection)))
        ;; Is a direct descendant of audit collection
        (= (:collection_id instance) (:id (perms/default-audit-collection))))
     false
     (mi/current-user-has-full-permissions? (perms/perms-objects-set-for-parent-collection instance :write))))
  ([_ pk]
   (mi/can-write? (t2/select-one :model/Dashboard :id pk))))
(defmethod mi/can-read? Dashboard
  ([instance]
   (perms/can-read-audit-helper :model/Dashboard instance))
  ([_ pk]
   (mi/can-read? (t2/select-one :model/Dashboard :id pk))))
(t2/deftransforms :model/Dashboard
  {:parameters       mi/transform-parameters-list
   :embedding_params mi/transform-json})
(t2/define-before-delete :model/Dashboard
  [dashboard]
  (let [dashboard-id (u/the-id dashboard)]
    (parameter-card/delete-all-for-parameterized-object! "dashboard" dashboard-id)
    (t2/delete! 'Revision :model "Dashboard" :model_id dashboard-id)))
(t2/define-before-insert :model/Dashboard
  [dashboard]
  (let [defaults  {:parameters []}
        dashboard (merge defaults dashboard)]
    (u/prog1 dashboard
      (params/assert-valid-parameters dashboard)
      (collection/check-collection-namespace Dashboard (:collection_id dashboard)))))
(t2/define-after-insert :model/Dashboard
  [dashboard]
  (u/prog1 dashboard
    (parameter-card/upsert-or-delete-from-parameters! "dashboard" (:id dashboard) (:parameters dashboard))))
(t2/define-before-update :model/Dashboard
  [dashboard]
  (u/prog1 dashboard
    (params/assert-valid-parameters dashboard)
    (parameter-card/upsert-or-delete-from-parameters! "dashboard" (:id dashboard) (:parameters dashboard))
    (collection/check-collection-namespace Dashboard (:collection_id dashboard))))

Updates the pulses' names and collection IDs, and syncs the PulseCards

(defn- update-dashboard-subscription-pulses!
  [dashboard]
  (let [dashboard-id (u/the-id dashboard)
        affected     (mdb.query/query
                      {:select-distinct [[:p.id :pulse-id] [:pc.card_id :card-id]]
                       :from            [[:pulse :p]]
                       :join            [[:pulse_card :pc] [:= :p.id :pc.pulse_id]]
                       :where           [:= :p.dashboard_id dashboard-id]})]
    (when-let [pulse-ids (seq (distinct (map :pulse-id affected)))]
      (let [correct-card-ids     (->> (mdb.query/query
                                       {:select-distinct [:dc.card_id]
                                        :from            [[:report_dashboardcard :dc]]
                                        :where           [:and
                                                          [:= :dc.dashboard_id dashboard-id]
                                                          [:not= :dc.card_id nil]]})
                                      (map :card_id)
                                      set)
            stale-card-ids       (->> affected
                                      (keep :card-id)
                                      set)
            cards-to-add         (set/difference correct-card-ids stale-card-ids)
            card-id->dashcard-id (when (seq cards-to-add)
                                   (t2/select-fn->pk :card_id DashboardCard :dashboard_id dashboard-id
                                                     :card_id [:in cards-to-add]))
            positions-for        (fn [pulse-id] (drop (pulse-card/next-position-for pulse-id)
                                                      (range)))
            new-pulse-cards      (for [pulse-id                         pulse-ids
                                       [[card-id dashcard-id] position] (map vector
                                                                             card-id->dashcard-id
                                                                             (positions-for pulse-id))]
                                   {:pulse_id          pulse-id
                                    :card_id           card-id
                                    :dashboard_card_id dashcard-id
                                    :position          position})]
        (t2/with-transaction [_conn]
          (binding [pulse/*allow-moving-dashboard-subscriptions* true]
            (t2/update! Pulse {:dashboard_id dashboard-id}
                        {:name (:name dashboard)
                         :collection_id (:collection_id dashboard)})
            (pulse-card/bulk-create! new-pulse-cards)))))))
(t2/define-after-update :model/Dashboard
  [dashboard]
  (update-dashboard-subscription-pulses! dashboard))
(defn- migrate-parameter [p]
  (cond-> p
    ;; It was previously possible for parameters to have empty strings for :name and
    ;; :slug, but these are now required to be non-blank strings. (metabase#24500)
    (or (= (:name p) )
        (= (:slug p) ))
    (assoc :name "unnamed" :slug "unnamed")
    (or
     ;; we don't support linked filters for parameters with :values_source_type of anything except nil,
     ;; but it was previously possible to set :values_source_type to "static-list" or "card" and still
     ;; have linked filters. (metabase#33892)
     (some? (:values_source_type p))
     (= (:values_query_type p) "none"))
     ;; linked filters don't do anything when parameters have values_query_type="none" (aka "Input box"),
     ;; but it was previously possible to set :values_query_type to "none" and still have linked filters.
     ;; (metabase#34657)
    (dissoc :filteringParameters)))

Update the :parameters list of a dashboard from legacy formats.

(defn- migrate-parameters-list
  [dashboard]
  (m/update-existing dashboard :parameters #(map migrate-parameter %)))
(t2/define-after-select :model/Dashboard
  [dashboard]
  (-> dashboard
      migrate-parameters-list
      public-settings/remove-public-uuid-if-public-sharing-is-disabled))
(defmethod serdes/hash-fields :model/Dashboard
  [_dashboard]
  [:name (serdes/hydrated-hash :collection) :created_at])

--------------------------------------------------- Hydration ----------------------------------------------------

(mi/define-simple-hydration-method tabs
  :tabs
  "Return the ordered DashboardTabs associated with `dashboard-or-id`, sorted by tab position."
  [dashboard-or-id]
  (t2/select :model/DashboardTab :dashboard_id (u/the-id dashboard-or-id) {:order-by [[:position :asc]]}))
(mi/define-simple-hydration-method dashcards
  :dashcards
  "Return the DashboardCards associated with `dashboard`, in the order they were created."
  [dashboard-or-id]
  (t2/select DashboardCard
             {:select    [:dashcard.* [:collection.authority_level :collection_authority_level]]
              :from      [[:report_dashboardcard :dashcard]]
              :left-join [[:report_card :card] [:= :dashcard.card_id :card.id]
                          [:collection :collection] [:= :collection.id :card.collection_id]]
              :where     [:and
                          [:= :dashcard.dashboard_id (u/the-id dashboard-or-id)]
                          [:or
                           [:= :card.archived false]
                           [:= :card.archived nil]]] ; e.g. DashCards with no corresponding Card, e.g. text Cards
              :order-by  [[:dashcard.created_at :asc]]}))
(mi/define-batched-hydration-method collections-authority-level
  :collection_authority_level
  "Efficiently hydrate the `:collection_authority_level` of a sequence of dashboards."
  [dashboards]
  (when (seq dashboards)
    (let [coll-id->level (into {}
                               (map (juxt :id :authority_level))
                               (mdb.query/query {:select    [:dashboard.id :collection.authority_level]
                                                 :from      [[:report_dashboard :dashboard]]
                                                 :left-join [[:collection :collection] [:= :collection.id :dashboard.collection_id]]
                                                 :where     [:in :dashboard.id (into #{} (map u/the-id) dashboards)]}))]
      (for [dashboard dashboards]
        (assoc dashboard :collection_authority_level (get coll-id->level (u/the-id dashboard)))))))
(comment moderation/keep-me)

--------------------------------------------------- Revisions ----------------------------------------------------

(def ^:private excluded-columns-for-dashboard-revision
  [:id :created_at :updated_at :creator_id :points_of_interest :caveats :show_in_getting_started :entity_id
   ;; not sure what position is for, from the column remark:
   ;; > The position this Dashboard should appear in the Dashboards list,
   ;;   lower-numbered positions appearing before higher numbered ones.
   ;; TODO: querying on stats we don't have any dashboard that has a position, maybe we could just drop it?
   :public_uuid :made_public_by_id
   :position])
(def ^:private excluded-columns-for-dashcard-revision
  [:entity_id :created_at :updated_at :collection_authority_level])
(def ^:private excluded-columns-for-dashboard-tab-revision
  [:created_at :updated_at :entity_id])
(defmethod revision/serialize-instance :model/Dashboard
  [_model _id dashboard]
  (let [dashcards (or (:dashcards dashboard)
                      (dashcards dashboard))
        dashcards (when (seq dashcards)
                    (if (contains? (first dashcards) :series)
                      dashcards
                      (t2/hydrate dashcards :series)))
        tabs  (or (:tabs dashboard)
                  (tabs dashboard))]
    (-> (apply dissoc dashboard excluded-columns-for-dashboard-revision)
        (assoc :cards (vec (for [dashboard-card dashcards]
                             (-> (apply dissoc dashboard-card excluded-columns-for-dashcard-revision)
                                 (assoc :series (mapv :id (:series dashboard-card)))))))
        (assoc :tabs (map #(apply dissoc % excluded-columns-for-dashboard-tab-revision) tabs)))))
(defn- revert-dashcards
  [dashboard-id serialized-cards]
  (let [current-cards    (t2/select-fn-vec #(apply dissoc (t2.realize/realize %) excluded-columns-for-dashcard-revision)
                                           :model/DashboardCard
                                           :dashboard_id dashboard-id)
        id->current-card (zipmap (map :id current-cards) current-cards)
        {:keys [to-create to-update to-delete]} (u/classify-changes current-cards serialized-cards)]
    (when (seq to-delete)
      (dashboard-card/delete-dashboard-cards! (map :id to-delete)))
    (when (seq to-create)
      (dashboard-card/create-dashboard-cards! (map #(assoc % :dashboard_id dashboard-id) to-create)))
    (when (seq to-update)
      (doseq [update-card to-update]
        (dashboard-card/update-dashboard-card! update-card (id->current-card (:id update-card)))))))

Given a list of dashcards, remove any dashcard that references cards that are either archived or not exist.

(defn- remove-invalid-dashcards
  [dashcards]
  (let [card-ids          (set (keep :card_id dashcards))
        active-card-ids   (when-let [card-ids (seq card-ids)]
                            (t2/select-pks-set :model/Card :id [:in card-ids] :archived false))
        inactive-card-ids (set/difference card-ids active-card-ids)]
   (remove #(contains? inactive-card-ids (:card_id %)) dashcards)))
(defmethod revision/revert-to-revision! :model/Dashboard
  [_model dashboard-id _user-id serialized-dashboard]
  ;; Update the dashboard description / name / permissions
  (t2/update! :model/Dashboard dashboard-id (dissoc serialized-dashboard :cards :tabs))
  ;; Now update the tabs and cards as needed
  (let [serialized-dashcards      (:cards serialized-dashboard)
        current-tabs              (t2/select-fn-vec #(dissoc (t2.realize/realize %) :created_at :updated_at :entity_id :dashboard_id)
                                                    :model/DashboardTab :dashboard_id dashboard-id)
        {:keys [old->new-tab-id]} (dashboard-tab/do-update-tabs! dashboard-id current-tabs (:tabs serialized-dashboard))
        serialized-dashcards      (cond->> serialized-dashcards
                                    true
                                    remove-invalid-dashcards
                                    ;; in case reverting result in new tabs being created,
                                    ;; we need to remap the tab-id
                                    (seq old->new-tab-id)
                                    (map (fn [card]
                                           (if-let [new-tab-id (get old->new-tab-id (:dashboard_tab_id card))]
                                             (assoc card :dashboard_tab_id new-tab-id)
                                             card))))]
    (revert-dashcards dashboard-id serialized-dashcards))
  serialized-dashboard)
(defmethod revision/diff-strings :model/Dashboard
  [_model prev-dashboard dashboard]
  (let [[removals changes]  (diff prev-dashboard dashboard)
        check-series-change (fn [idx card-changes]
                              (when (and (:series card-changes)
                                         (get-in prev-dashboard [:cards idx :card_id]))
                                (let [num-series₁ (count (get-in prev-dashboard [:cards idx :series]))
                                      num-series₂ (count (get-in dashboard [:cards idx :series]))]
                                  (cond
                                    (< num-series₁ num-series₂)
                                    (deferred-tru "added some series to card {0}" (get-in prev-dashboard [:cards idx :card_id]))

                                    (> num-series₁ num-series₂)
                                    (deferred-tru "removed some series from card {0}" (get-in prev-dashboard [:cards idx :card_id]))

                                    :else
                                    (deferred-tru "modified the series on card {0}" (get-in prev-dashboard [:cards idx :card_id]))))))]
    (-> [(when-let [default-description (u/build-sentence ((get-method revision/diff-strings :default) Dashboard prev-dashboard dashboard))]
           (cond-> default-description
             (str/ends-with? default-description ".") (subs 0 (dec (count default-description)))))
         (when (:cache_ttl changes)
           (cond
             (nil? (:cache_ttl prev-dashboard)) (deferred-tru "added a cache ttl")
             (nil? (:cache_ttl dashboard)) (deferred-tru "removed the cache ttl")
             :else (deferred-tru "changed the cache ttl from \"{0}\" to \"{1}\""
                     (:cache_ttl prev-dashboard) (:cache_ttl dashboard))))
         (when (or (:cards changes) (:cards removals))
           (let [prev-card-ids  (set (map :id (:cards prev-dashboard)))
                 num-prev-cards (count prev-card-ids)
                 new-card-ids   (set (map :id (:cards dashboard)))
                 num-new-cards  (count new-card-ids)
                 num-cards-diff (abs (- num-prev-cards num-new-cards))
                 keys-changes   (set (flatten (concat (map keys (:cards changes))
                                                      (map keys (:cards removals)))))]
             (cond
               (and
                (set/subset? prev-card-ids new-card-ids)
                (< num-prev-cards num-new-cards))                     (deferred-trun "added a card" "added {0} cards" num-cards-diff)
               (and
                (set/subset? new-card-ids prev-card-ids)
                (> num-prev-cards num-new-cards))                     (deferred-trun "removed a card" "removed {0} cards" num-cards-diff)
               (set/subset? keys-changes #{:row :col :size_x :size_y}) (deferred-tru "rearranged the cards")
               :else                                                   (deferred-tru "modified the cards"))))

         (when (or (:tabs changes) (:tabs removals))
           (let [prev-tabs     (:tabs prev-dashboard)
                 new-tabs      (:tabs dashboard)
                 prev-tab-ids  (set (map :id prev-tabs))
                 num-prev-tabs (count prev-tab-ids)
                 new-tab-ids   (set (map :id new-tabs))
                 num-new-tabs  (count new-tab-ids)
                 num-tabs-diff (abs (- num-prev-tabs num-new-tabs))]
             (cond
               (and
                (set/subset? prev-tab-ids new-tab-ids)
                (< num-prev-tabs num-new-tabs))              (deferred-trun "added a tab" "added {0} tabs" num-tabs-diff)

               (and
                (set/subset? new-tab-ids prev-tab-ids)
                (> num-prev-tabs num-new-tabs))              (deferred-trun "removed a tab" "removed {0} tabs" num-tabs-diff)

               (= (set (map #(dissoc % :position) prev-tabs))
                  (set (map #(dissoc % :position) new-tabs))) (deferred-tru "rearranged the tabs")

               :else                                          (deferred-tru "modified the tabs"))))
         (let [f (comp boolean :auto_apply_filters)]
           (when (not= (f prev-dashboard) (f dashboard))
             (deferred-tru "set auto apply filters to {0}" (str (f dashboard)))))]
        (concat (map-indexed check-series-change (:cards changes)))
        (->> (filter identity)))))

Check if a dashboard has tabs.

(defn has-tabs?
  [dashboard-or-id]
  (t2/exists? :model/DashboardTab :dashboard_id (u/the-id dashboard-or-id)))

+----------------------------------------------------------------------------------------------------------------+ | OTHER CRUD FNS | +----------------------------------------------------------------------------------------------------------------+

Get the set of Field IDs referenced by the parameters in this Dashboard.

(defn- dashboard-id->param-field-ids
  [dashboard-or-id]
  (let [dash (-> (t2/select-one Dashboard :id (u/the-id dashboard-or-id))
                 (t2/hydrate [:dashcards :card]))]
    (params/dashcards->param-field-ids (:dashcards dash))))

If the parameters have changed since last time this Dashboard was saved, we need to update the FieldValues for any Fields that belong to an 'On-Demand' synced DB.

(defn- update-field-values-for-on-demand-dbs!
  [old-param-field-ids new-param-field-ids]
  (when (and (seq new-param-field-ids)
             (not= old-param-field-ids new-param-field-ids))
    (let [newly-added-param-field-ids (set/difference new-param-field-ids old-param-field-ids)]
      (log/info "Referenced Fields in Dashboard params have changed: Was:" old-param-field-ids
                "Is Now:" new-param-field-ids
                "Newly Added:" newly-added-param-field-ids)
      (field-values/update-field-values-for-on-demand-dbs! newly-added-param-field-ids))))

Add Cards to a Dashboard. This function is provided for convenience and also makes sure various cleanup steps are performed when finished, for example updating FieldValues for On-Demand DBs. Returns newly created DashboardCards.

(defn add-dashcards!
  {:style/indent 2}
  [dashboard-or-id dashcards]
  (let [old-param-field-ids (dashboard-id->param-field-ids dashboard-or-id)
        dashboard-cards     (map (fn [dashcard]
                                   (-> (assoc dashcard :dashboard_id (u/the-id dashboard-or-id))
                                       (update :series #(filter identity (map u/the-id %))))) dashcards)]
    (u/prog1 (dashboard-card/create-dashboard-cards! dashboard-cards)
      (let [new-param-field-ids (dashboard-id->param-field-ids dashboard-or-id)]
        (update-field-values-for-on-demand-dbs! old-param-field-ids new-param-field-ids)))))
(def ^:private DashboardWithSeriesAndCard
  [:map
   [:id ms/PositiveInt]
   [:dashcards [:sequential [:map
                                 [:card_id {:optional true} [:maybe ms/PositiveInt]]
                                 [:card {:optional true} [:maybe [:map
                                                                  [:id ms/PositiveInt]]]]]]]])

Update the dashcards belonging to dashboard. This function is provided as a convenience instead of doing this yourself; it also makes sure various cleanup steps are performed when finished, for example updating FieldValues for On-Demand DBs. Returns nil.

(mu/defn update-dashcards!
  {:style/indent 1}
  [dashboard     :- DashboardWithSeriesAndCard
   new-dashcards :- [:sequential ms/Map]]
  (let [old-dashcards    (:dashcards dashboard)
        id->old-dashcard (m/index-by :id old-dashcards)
        old-dashcard-ids (set (keys id->old-dashcard))
        new-dashcard-ids (set (map :id new-dashcards))
        only-new         (set/difference new-dashcard-ids old-dashcard-ids)]
    ;; ensure the dashcards we are updating are part of the given dashboard
    (when (seq only-new)
      (throw (ex-info (tru "Dashboard {0} does not have a DashboardCard with ID {1}"
                           (u/the-id dashboard) (first only-new))
                      {:status-code 404})))
    (doseq [dashcard new-dashcards]
      (let [;; update-dashboard-card! requires series to be a sequence of card IDs
            old-dashcard       (-> (get id->old-dashcard (:id dashcard))
                                   (update :series #(map :id %)))
            dashboard-card     (update dashcard :series #(map :id %))]
        (dashboard-card/update-dashboard-card! dashboard-card old-dashcard)))
    (let [new-param-field-ids (params/dashcards->param-field-ids (t2/hydrate new-dashcards :card))]
      (update-field-values-for-on-demand-dbs! (params/dashcards->param-field-ids old-dashcards) new-param-field-ids))))

Fetch the results metadata for a query by running the query and seeing what the qp gives us in return.

TODO - we need to actually make this async, but then we'd need to make save-card! async, and so forth

(defn- result-metadata-for-query
  [query]
  (a/<!! (qp.async/result-metadata-for-query-async query)))
(defn- save-card!
  [card]
  (cond
    ;; If this is a pre-existing card, just return it
    (and (integer? (:id card)) (t2/select-one Card :id (:id card)))
    card
    ;; Don't save text cards
    (-> card :dataset_query not-empty)
    (let [card (first (t2/insert-returning-instances!
                        Card
                        (-> card
                            (update :result_metadata #(or % (-> card
                                                                :dataset_query
                                                                result-metadata-for-query)))
                            (dissoc :id))))]
      (events/publish-event! :event/card-create {:object card :user-id (:creator_id card)})
      (t2/hydrate card :creator :dashboard_count :can_write :collection))))
(defn- ensure-unique-collection-name
  [collection-name parent-collection-id]
  (let [c (t2/count Collection
            :name     [:like (format "%s%%" collection-name)]
            :location (collection/children-location (t2/select-one [Collection :location :id]
                                                      :id parent-collection-id)))]
    (if (zero? c)
      collection-name
      (format "%s %s" collection-name (inc c)))))

Save a denormalized description of dashboard.

(defn save-transient-dashboard!
  [dashboard parent-collection-id]
  (let [{dashcards      :dashcards
         tabs           :tabs
         dashboard-name :name
         :keys          [description] :as dashboard} (i18n/localized-strings->strings dashboard)
        collection (populate/create-collection!
                    (ensure-unique-collection-name dashboard-name parent-collection-id)
                    "Automatically generated cards."
                    parent-collection-id)
        dashboard  (first (t2/insert-returning-instances!
                            :model/Dashboard
                            (-> dashboard
                                (dissoc :dashcards :tabs :rule :related
                                        :transient_name :transient_filters :param_fields :more)
                                (assoc :description description
                                       :collection_id (:id collection)
                                       :collection_position 1))))
        {:keys [old->new-tab-id]} (dashboard-tab/do-update-tabs! (:id dashboard) nil tabs)]
    (add-dashcards! dashboard
                    (for [dashcard dashcards]
                      (let [card     (some-> dashcard :card (assoc :collection_id (:id collection)) save-card!)
                            series   (some->> dashcard :series (map (fn [card]
                                                                      (-> card
                                                                          (assoc :collection_id (:id collection))
                                                                          save-card!))))
                            dashcard (-> dashcard
                                         (dissoc :card :id :creator_id)
                                         (update :parameter_mappings
                                                 (partial map #(assoc % :card_id (:id card))))
                                         (assoc :series series)
                                         (update :dashboard_tab_id (or old->new-tab-id {}))
                                         (assoc :card_id (:id card)))]
                        dashcard)))
    dashboard))
(def ^:private ParamWithMapping
  [:map
   [:id ms/NonBlankString]
   [:name ms/NonBlankString]
   [:mappings [:maybe [:set dashboard-card/ParamMapping]]]])
(mu/defn ^:private dashboard->resolved-params* :- [:map-of ms/NonBlankString ParamWithMapping]
  [dashboard :- [:map [:parameters [:maybe [:sequential :map]]]]]
  (let [dashboard           (t2/hydrate dashboard [:dashcards :card])
        param-key->mappings (apply
                             merge-with set/union
                             (for [dashcard (:dashcards dashboard)
                                   param    (:parameter_mappings dashcard)]
                               {(:parameter_id param) #{(assoc param :dashcard dashcard)}}))]
    (into {} (for [{param-key :id, :as param} (:parameters dashboard)]
               [(u/qualified-name param-key) (assoc param :mappings (get param-key->mappings param-key))]))))
(mi/define-simple-hydration-method dashboard->resolved-params
  :resolved-params
  "Return map of Dashboard parameter key -> param with resolved `:mappings`.
    (dashboard->resolved-params (t2/select-one Dashboard :id 62))
    ;; ->
    {\"ee876336\" {:name     \"Category Name\"
                   :slug     \"category_name\"
                   :id       \"ee876336\"
                   :type     \"category\"
                   :mappings #{{:parameter_id \"ee876336\"
                                :card_id      66
                                :dashcard     ...
                                :target       [:dimension [:fk-> [:field-id 263] [:field-id 276]]]}}},
     \"6f10a41f\" {:name     \"Price\"
                   :slug     \"price\"
                   :id       \"6f10a41f\"
                   :type     \"category\"
                   :mappings #{{:parameter_id \"6f10a41f\"
                                :card_id      66
                                :dashcard     ...
                                :target       [:dimension [:field-id 264]]}}}}"
  [dashboard]
  (dashboard->resolved-params* dashboard))

+----------------------------------------------------------------------------------------------------------------+ | SERIALIZATION | +----------------------------------------------------------------------------------------------------------------+

(defmethod serdes/extract-query "Dashboard" [_ opts]
  (eduction (map #(t2/hydrate % :dashcards))
            (serdes/extract-query-collections Dashboard opts)))
(defn- extract-dashcard
  [dashcard]
  (-> (into (sorted-map) dashcard)
      (dissoc :id :collection_authority_level :dashboard_id :updated_at)
      (update :card_id                serdes/*export-fk* 'Card)
      (update :action_id              serdes/*export-fk* 'Action)
      (update :dashboard_tab_id       serdes/*export-fk* :model/DashboardTab)
      (update :parameter_mappings     serdes/export-parameter-mappings)
      (update :visualization_settings serdes/export-visualization-settings)))
(defn- extract-dashtab
  [dashtab]
  (dissoc dashtab :id :dashboard_id :updated_at))
(defmethod serdes/extract-one "Dashboard"
  [_model-name _opts dash]
  (let [dash (cond-> dash
               (nil? (:dashcards dash))
               (t2/hydrate :dashcards)
               (nil? (:tabs dash))
               (t2/hydrate :tabs))]
    (-> (serdes/extract-one-basics "Dashboard" dash)
        (update :dashcards         #(mapv extract-dashcard %))
        (update :tabs              #(mapv extract-dashtab %))
        (update :parameters        serdes/export-parameters)
        (update :collection_id     serdes/*export-fk* Collection)
        (update :creator_id        serdes/*export-user*)
        (update :made_public_by_id serdes/*export-user*))))
(defmethod serdes/load-xform "Dashboard"
  [dash]
  (-> dash
      serdes/load-xform-basics
      ;; Deliberately not doing anything to :dashcards - they get handled by load-insert! and load-update! below.
      (update :collection_id     serdes/*import-fk* Collection)
      (update :parameters        serdes/import-parameters)
      (update :creator_id        serdes/*import-user*)
      (update :made_public_by_id serdes/*import-user*)))
(defn- dashcard-for [dashcard dashboard]
  (assoc dashcard
         :dashboard_id (:entity_id dashboard)
         :serdes/meta  (remove nil?
                               [{:model "Dashboard"     :id (:entity_id dashboard)}
                                (when-let [dashtab-eeid (last (:dashboard_tab_id dashcard))]
                                  {:model "DashboardTab" :id dashtab-eeid})
                                {:model "DashboardCard" :id (:entity_id dashcard)}])))
(defn- dashtab-for [tab dashboard]
  (assoc tab
         :dashboard_id (:entity_id dashboard)
         :serdes/meta  [{:model "Dashboard"    :id (:entity_id dashboard)}
                        {:model "DashboardTab" :id (:entity_id tab)}]))

Remove nested entities which are not present in incoming serialization load

(defn- drop-excessive-nested!
  [hydration-key ingested local]
  (let [local-nested    (get (t2/hydrate local hydration-key) hydration-key)
        ingested-nested (get ingested hydration-key)
        to-remove       (set/difference (set (map :entity_id local-nested))
                                        (set (map :entity_id ingested-nested)))
        model           (t2/model (first local-nested))]
    (when (seq to-remove)
      (t2/delete! model :entity_id [:in to-remove]))))

Call the default load-one! for the Dashboard, then for each DashboardCard.

(defmethod serdes/load-one! "Dashboard" [ingested maybe-local]
  (let [dashboard ((get-method serdes/load-one! :default) (dissoc ingested :dashcards :tabs) maybe-local)]

    (drop-excessive-nested! :tabs ingested dashboard)
    (doseq [tab (:tabs ingested)]
      (serdes/load-one! (dashtab-for tab dashboard)
                        (t2/select-one :model/DashboardTab :entity_id (:entity_id tab))))

    (drop-excessive-nested! :dashcards ingested dashboard)
    (doseq [dashcard (:dashcards ingested)]
      (serdes/load-one! (dashcard-for dashcard dashboard)
                        (t2/select-one :model/DashboardCard :entity_id (:entity_id dashcard))))))
(defn- serdes-deps-dashcard
  [{:keys [action_id card_id parameter_mappings visualization_settings]}]
  (->> (mapcat serdes/mbql-deps parameter_mappings)
       (concat (serdes/visualization-settings-deps visualization_settings))
       (concat (when card_id   #{[{:model "Card"   :id card_id}]}))
       (concat (when action_id #{[{:model "Action" :id action_id}]}))
       set))
(defmethod serdes/dependencies "Dashboard"
  [{:keys [collection_id dashcards parameters]}]
  (->> (map serdes-deps-dashcard dashcards)
       (reduce set/union #{})
       (set/union (when collection_id #{[{:model "Collection" :id collection_id}]}))
       (set/union (serdes/parameters-deps parameters))))
(defmethod serdes/descendants "Dashboard" [_model-name id]
  (let [dashcards (t2/select ['DashboardCard :card_id :action_id :parameter_mappings :visualization_settings]
                             :dashboard_id id)
        dashboard (t2/select-one Dashboard :id id)]
    (set/union
      ;; DashboardCards are inlined into Dashboards, but we need to capture what those those DashboardCards rely on
      ;; here. So their actions, and their cards both direct and mentioned in their parameters or viz settings.
     (set (for [{:keys [card_id parameter_mappings]} dashcards
                 ;; Capture all card_ids in the parameters, plus this dashcard's card_id if non-nil.
                card-id (cond-> (set (keep :card_id parameter_mappings))
                          card_id (conj card_id))]
            ["Card" card-id]))
     (set (for [{:keys [action_id]} dashcards
                :when action_id]
            ["Action" action_id]))
     (reduce set/union #{}
             (for [dc dashcards]
               (serdes/visualization-settings-descendants (:visualization_settings dc))))
      ;; parameter with values_source_type = "card" will depend on a card
     (set (for [card-id (some->> dashboard :parameters (keep (comp :card_id :values_source_config)))]
            ["Card" card-id])))))

------------------------------------------------ Audit Log --------------------------------------------------------

(defmethod audit-log/model-details Dashboard
  [dashboard event-type]
  (case event-type
    (:dashboard-create :dashboard-delete :dashboard-read)
    (select-keys dashboard [:description :name])

    (:dashboard-add-cards :dashboard-remove-cards)
    (-> (select-keys dashboard [:description :name :parameters :dashcards])
        (update :dashcards (fn [dashcards]
                             (for [{:keys [id card_id]} dashcards]
                                  (-> (t2/select-one [Card :name :description], :id card_id)
                                      (assoc :id id)
                                      (assoc :card_id card_id))))))

    {}))
 
(ns metabase.models.dashboard-card
  (:require
   [clojure.set :as set]
   [medley.core :as m]
   [metabase.db :as mdb]
   [metabase.db.query :as mdb.query]
   [metabase.models.dashboard-card-series :refer [DashboardCardSeries]]
   [metabase.models.interface :as mi]
   [metabase.models.pulse-card :refer [PulseCard]]
   [metabase.models.serialization :as serdes]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all the DashboardCard symbol in our codebase.

(def DashboardCard
  :model/DashboardCard)
(methodical/defmethod t2/table-name :model/DashboardCard [_model] :report_dashboardcard)
(doto :model/DashboardCard
  (derive :metabase/model)
  (derive ::mi/read-policy.full-perms-for-perms-set)
  (derive ::mi/write-policy.full-perms-for-perms-set)
  (derive :hook/timestamped?)
  (derive :hook/entity-id))
(t2/deftransforms :model/DashboardCard
  {:parameter_mappings     mi/transform-parameters-list
   :visualization_settings mi/transform-visualization-settings})
(t2/define-before-insert :model/DashboardCard
 [dashcard]
 (merge {:parameter_mappings     []
         :visualization_settings {}} dashcard))
(declare series)

Return the set of permissions required to read-or-write this DashboardCard. If :card and :series are already hydrated this method doesn't need to make any DB calls.

(defmethod mi/perms-objects-set :model/DashboardCard
  [dashcard read-or-write]
  (let [card   (or (:card dashcard)
                   (t2/select-one [:model/Card :dataset_query] :id (u/the-id (:card_id dashcard))))
        series (or (:series dashcard)
                   (series dashcard))]
    (apply set/union (mi/perms-objects-set card read-or-write) (for [series-card series]
                                                                 (mi/perms-objects-set series-card read-or-write)))))

Convert a map with dashboard-card into a Toucan instance assuming it came from parsed JSON and the map keys have been keywordized. This is useful if the data from a request body inside a defendpoint body, and you need it in the same format as if it were selected from the DB with toucan. It doesn't transform the :created_at or :updated_at fields, as the types of timestamp values differ by the application database driver.

For example: ``` (= dashcard ;; from toucan select, excluding :createdat and :updatedat (-> (json/generate-string dashcard) (json/parse-string true) from-parsed-json)) => true ```

(defn from-parsed-json
  [dashboard-card]
  (t2/instance :model/DashboardCard
               (-> dashboard-card
                   (m/update-existing :parameter_mappings mi/normalize-parameters-list)
                   (m/update-existing :visualization_settings mi/normalize-visualization-settings))))
(defmethod serdes/hash-fields :model/DashboardCard
  [_dashboard-card]
  [(serdes/hydrated-hash :card) ; :card is optional, eg. text cards
   (comp serdes/identity-hash
         #(t2/select-one 'Dashboard :id %)
         :dashboard_id)
   :visualization_settings
   :row :col
   :created_at])

--------------------------------------------------- HYDRATION ----------------------------------------------------

(mi/define-batched-hydration-method series
  :series
  "Return the `Cards` associated as additional series on this DashboardCard."
  [dashcards]
  (let [dashcard-ids        (map :id dashcards)
        dashcard-id->series (when (seq dashcard-ids)
                              (as-> (t2/select
                                     [:model/Card :id :name :description :display :dataset_query
                                      :visualization_settings :collection_id :series.dashboardcard_id]
                                     {:left-join [[:dashboardcard_series :series] [:= :report_card.id :series.card_id]]
                                      :where     [:in :series.dashboardcard_id dashcard-ids]
                                      :order-by  [[:series.position :asc]]}) series
                               (group-by :dashboardcard_id series)
                               (update-vals series #(map (fn [card] (dissoc card :dashboardcard_id)) %))))]
    (map (fn [dashcard]
           (assoc dashcard :series (get dashcard-id->series (:id dashcard) [])))
         dashcards)))

---------------------------------------------------- CRUD FNS ----------------------------------------------------

Fetch a single DashboardCard by its ID value.

(mu/defn retrieve-dashboard-card
  [id :- ms/PositiveInt]
  (-> (t2/select-one :model/DashboardCard :id id)
      (t2/hydrate :series)))

Return the cards which are other cards with respect to this dashboard card in multiple series display for dashboard

Dashboard (and dashboard only) has this thing where you're displaying multiple cards entirely.

This is actually completely different from the combo display, which is a visualization type in visualization option.

This is also actually completely different from having multiple series display from the visualization with same type (line bar or whatever), which is a separate option in line area or bar visualization

(defn dashcard->multi-cards
  [dashcard]
  (mdb.query/query {:select    [:newcard.*]
                    :from      [[:report_dashboardcard :dashcard]]
                    :left-join [[:dashboardcard_series :dashcardseries]
                                [:= :dashcard.id :dashcardseries.dashboardcard_id]
                                [:report_card :newcard]
                                [:= :dashcardseries.card_id :newcard.id]]
                    :where     [:and
                                [:= :newcard.archived false]
                                [:= :dashcard.id (:id dashcard)]]}))

Batch update the DashboardCardSeries for multiple DashboardCards. Each card-ids list should be a definitive collection of all IDs of cards for the dashboard card in the desired order.

  • If an ID in card-ids has no corresponding existing DashboardCardSeries object, one will be created.
  • If an existing DashboardCardSeries has no corresponding ID in card-ids, it will be deleted.
  • All cards will be updated with a position according to their place in the collection of card-ids
(defn update-dashboard-cards-series!
  {:arglists '([dashcard-id->card-ids])}
  [dashcard-id->card-ids]
  (when (seq dashcard-id->card-ids)
    ;; first off, just delete all series on the dashboard card (we add them again below)
    (t2/delete! DashboardCardSeries :dashboardcard_id [:in (keys dashcard-id->card-ids)])
    ;; now just insert all of the series that were given to us
    (when-let [card-series (seq (for [[dashcard-id card-ids] dashcard-id->card-ids
                                      [i card-id]            (map-indexed vector card-ids)]
                                  {:dashboardcard_id dashcard-id, :card_id card-id, :position i}))]
      (t2/insert! DashboardCardSeries card-series))))
(def ^:private DashboardCardUpdates
  [:map
   [:id                                      ms/PositiveInt]
   [:action_id              {:optional true} [:maybe ms/PositiveInt]]
   [:parameter_mappings     {:optional true} [:maybe [:sequential :map]]]
   [:visualization_settings {:optional true} [:maybe :map]]
   ;; series is a sequence of IDs of additional cards after the first to include as "additional serieses"
   [:series                 {:optional true} [:maybe [:sequential ms/PositiveInt]]]])

Returns the keys in new that have different values than the corresponding keys in old

(defn- shallow-updates
  [new old]
  (into {}
        (filter (fn [[k v]]
                  (not= v (get old k)))
                new)))

Updates an existing DashboardCard including all DashboardCardSeries. old-dashboard-card is provided to avoid an extra DB call if there are no changes. Returns nil.

(mu/defn update-dashboard-card!
  [{dashcard-id :id :keys [series] :as dashboard-card} :- DashboardCardUpdates
   old-dashboard-card :- DashboardCardUpdates]
  (t2/with-transaction [_conn]
    (let [update-ks [:action_id :card_id :row :col :size_x :size_y
                     :parameter_mappings :visualization_settings :dashboard_tab_id]
          updates   (shallow-updates (select-keys dashboard-card update-ks)
                                     (select-keys old-dashboard-card update-ks))]
      (when (seq updates)
        (t2/update! :model/DashboardCard dashcard-id updates))
      (when (not= (:series dashboard-card [])
                  (:series old-dashboard-card []))
        (update-dashboard-cards-series! {dashcard-id series}))
      nil)))

Schema for a parameter mapping as it would appear in the DashboardCard :parameter_mappings column.

(def ParamMapping
  [:and
   [:map-of :keyword :any]
   [:map
    ;; TODO -- validate `:target` as well... breaks a few tests tho so those will have to be fixed
    [:parameter_id ms/NonBlankString]
    #_[:target       :any]]])
(def ^:private NewDashboardCard
  ;; TODO - make the rest of the options explicit instead of just allowing whatever for other keys
  [:map
   [:dashboard_id                            ms/PositiveInt]
   [:action_id              {:optional true} [:maybe ms/PositiveInt]]
   ;; TODO - use ParamMapping. Breaks too many tests right now tho
   [:parameter_mappings     {:optional true} [:maybe [:sequential map?]]]
   [:visualization_settings {:optional true} [:maybe map?]]
   [:series                 {:optional true} [:maybe [:sequential ms/PositiveInt]]]])

Create a new DashboardCard by inserting it into the database along with all associated pieces of data such as DashboardCardSeries. Returns the newly created DashboardCard or throws an Exception.

(mu/defn create-dashboard-cards!
  [dashboard-cards :- [:sequential NewDashboardCard]]
  (when (seq dashboard-cards)
    (t2/with-transaction [_conn]
      (let [dashboard-card-ids (t2/insert-returning-pks!
                                DashboardCard
                                (for [dashcard dashboard-cards]
                                  (merge {:parameter_mappings []
                                          :visualization_settings {}}
                                         (dissoc dashcard :id :created_at :updated_at :entity_id :series :card :collection_authority_level))))]
        ;; add series to the DashboardCard
        (update-dashboard-cards-series! (zipmap dashboard-card-ids (map #(get % :series []) dashboard-cards)))
        ;; return the full DashboardCard
        (-> (t2/select DashboardCard :id [:in dashboard-card-ids])
            (t2/hydrate :series))))))

Delete DashboardCards of a Dasbhoard.

(defn delete-dashboard-cards!
  [dashboard-card-ids]
  {:pre [(coll? dashboard-card-ids)]}
  (t2/with-transaction [_conn]
    (t2/delete! PulseCard :dashboard_card_id [:in dashboard-card-ids])
    (t2/delete! DashboardCard :id [:in dashboard-card-ids])))

----------------------------------------------- Link cards ----------------------------------------------------

(def ^:private all-card-info-columns
  {:model         :text
   :id            :integer
   :name          :text
   :description   :text
   ;; for cards and datasets
   :collection_id :integer
   :display       :text
   ;; for tables
   :db_id        :integer})
(def ^:private  link-card-columns-for-model
  {"database"   [:id :name :description]
   "table"      [:id [:display_name :name] :description :db_id]
   "dashboard"  [:id :name :description :collection_id]
   "card"       [:id :name :description :collection_id :display]
   "dataset"    [:id :name :description :collection_id :display]
   "collection" [:id :name :description]})

Returns the column name. If the column is aliased, i.e. [:original_name :aliased_name], return the aliased column name

(defn- ->column-alias
  [column-or-aliased]
  (if (sequential? column-or-aliased)
    (second column-or-aliased)
    column-or-aliased))

The search query uses a union-all which requires that there be the same number of columns in each of the segments of the query. This function will take the columns for model and will inject constant nil values for any column missing from entity-columns but found in all-card-info-columns.

(defn- select-clause-for-link-card-model
  [model]
  (let [model-cols                       (link-card-columns-for-model model)
        model-col-alias->honeysql-clause (m/index-by ->column-alias model-cols)]
    (for [[col col-type] all-card-info-columns
          :let           [maybe-aliased-col (get model-col-alias->honeysql-clause col)]]
      (cond
        (= col :model)
        [(h2x/literal model) :model]
        maybe-aliased-col
        maybe-aliased-col
        ;; This entity is missing the column, project a null for that column value. For Postgres and H2, cast it to the
        ;; correct type, e.g.
        ;;
        ;;    SELECT cast(NULL AS integer)
        ;;
        ;; For MySQL, this is not needed.
        :else
        [(when-not (= (mdb/db-type) :mysql)
           [:cast nil col-type])
         col]))))
(def ^:private link-card-models
  (set (keys serdes/link-card-model->toucan-model)))

Return a honeysql query that is used to fetch info for a linkcard.

(defn link-card-info-query-for-model
  [model id-or-ids]
  {:select (select-clause-for-link-card-model model)
   :from   (t2/table-name (serdes/link-card-model->toucan-model model))
   :where  (if (coll? id-or-ids)
             [:in :id id-or-ids]
             [:= :id id-or-ids])})
(defn- link-card-info-query
  [link-card-model->ids]
  (if (= 1 (count link-card-model->ids))
    (apply link-card-info-query-for-model (first link-card-model->ids))
    {:select   [:*]
     :from     [[{:union-all (map #(apply link-card-info-query-for-model %) link-card-model->ids)}
                 :alias_is_required_by_sql_but_not_needed_here]]}))
(mi/define-batched-hydration-method dashcard-linkcard-info
  :dashcard/linkcard-info
  "Update entity info for link cards.
  Link cards are dashcards that link to internal entities like Database/Dashboard/... or an url.
  The viz-settings only store the model name and id, info like name, description will need to be
  hydrated on fetch to make sure those info are up-to-date."
  [dashcards]
  (let [entity-path   [:visualization_settings :link :entity]
        ;; find all dashcards that are link-cards and get its model, id
        ;; [[:table #{1 2}] [:database #{3 4}]]
        model-and-ids (->> dashcards
                           (map #(get-in % entity-path))
                           (filter #(link-card-models (:model %)))
                           (group-by :model)
                           (map (fn [[k v]] [k (set (map :id v))])))]
    (if (seq model-and-ids)
      (let [;; query all entities in 1 db call
            ;; {[:table 3] {:name ...}}
            model-and-id->info
            (-> (m/index-by (juxt :model :id) (t2/query (link-card-info-query model-and-ids)))
                (update-vals (fn [{model :model :as instance}]
                               (if (mi/can-read? (t2/instance (serdes/link-card-model->toucan-model model) instance))
                                 instance
                                 {:restricted true}))))]
        (map (fn [card]
               (if-let [model-info (->> (get-in card entity-path)
                                        ((juxt :model :id))
                                        (get model-and-id->info))]
                 (assoc-in card entity-path model-info)
                 card))
             dashcards))
      dashcards)))

Comparator that determines which of two dashcards comes first in the layout order used for pulses. This is the same order used on the frontend for the mobile layout. Orders cards left-to-right, then top-to-bottom

(defn dashcard-comparator
  [{row-1 :row col-1 :col} {row-2 :row col-2 :col}]
  (if (= row-1 row-2)
    (compare col-1 col-2)
    (compare row-1 row-2)))

----------------------------------------------- SERIALIZATION ---------------------------------------------------- DashboardCards are not serialized as their own, separate entities. They are inlined onto their parent Dashboards. If the parent dashboard has tabs, the dashcards are inlined under each DashboardTab, which are inlined on the Dashboard. However, we can reuse some of the serdes machinery (especially load-one!) by implementing a few serdes methods.

(defmethod serdes/generate-path "DashboardCard" [_ dashcard]
  (remove nil?
          [(serdes/infer-self-path "Dashboard" (t2/select-one 'Dashboard :id (:dashboard_id dashcard)))
           (when (:dashboard_tab_id dashcard)
             (serdes/infer-self-path "DashboardTab" (t2/select-one :model/DashboardTab :id (:dashboard_tab_id dashcard))))
           (serdes/infer-self-path "DashboardCard" dashcard)]))
(defmethod serdes/load-xform "DashboardCard"
  [dashcard]
  (-> dashcard
      (dissoc :serdes/meta)
      (update :card_id                serdes/*import-fk* :model/Card)
      (update :action_id              serdes/*import-fk* :model/Action)
      (update :dashboard_id           serdes/*import-fk* :model/Dashboard)
      (update :dashboard_tab_id       serdes/*import-fk* :model/DashboardTab)
      (update :created_at             #(if (string? %) (u.date/parse %) %))
      (update :parameter_mappings     serdes/import-parameter-mappings)
      (update :visualization_settings serdes/import-visualization-settings)))
 
(ns metabase.models.dashboard-card-series
  (:require
   [metabase.models.serialization :as serdes]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all the DashboardCardSeries symbol in our codebase.

(def DashboardCardSeries
  :model/DashboardCardSeries)
(methodical/defmethod t2/table-name :model/DashboardCardSeries [_model] :dashboardcard_series)
(doto :model/DashboardCardSeries
 (derive :metabase/model))
(defn- dashboard-card [{:keys [dashboardcard_id]}]
  (t2/select-one :model/DashboardCardSeries :id dashboardcard_id))
(defmethod serdes/hash-fields :model/DashboardCardSeries
  [_dashboard-card-series]
  [(comp serdes/identity-hash dashboard-card)
   (serdes/hydrated-hash :card)
   :position])
 
(ns metabase.models.dashboard-tab
  (:require
   [medley.core :as m]
   [metabase.models.dashboard-card :as dashboard-card]
   [metabase.models.interface :as mi]
   [metabase.models.serialization :as serdes]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [methodical.core :as methodical]
   [toucan2.core :as t2]
   [toucan2.tools.hydrate :as t2.hydrate]))
(methodical/defmethod t2/table-name :model/DashboardTab [_model] :dashboard_tab)
(doto :model/DashboardTab
  (derive :metabase/model)
  (derive ::mi/read-policy.full-perms-for-perms-set)
  (derive ::mi/write-policy.full-perms-for-perms-set)
  (derive :hook/timestamped?)
  (derive :hook/entity-id))
(methodical/defmethod t2/model-for-automagic-hydration [:metabase.models.dashboard-card/DashboardCard :dashboard_tab]
  [_original-model _k]
  :model/DashboardTab)
(methodical/defmethod t2.hydrate/fk-keys-for-automagic-hydration [:metabase.models.dashboard-card/DashboardCard :dashboard_tab :default]
  [_original-model _dest-key _hydrating-model]
  [:dashboard_tab_id])
(methodical/defmethod t2.hydrate/batched-hydrate [:default :tab-cards]
  "Given a list of tabs, return a seq of ordered tabs, in which each tabs contain a seq of orderd cards."
  [_model _k tabs]
  (assert (= 1 (count (set (map :dashboard_id tabs)))), "All tabs must belong to the same dashboard")
  (let [dashboard-id      (:dashboard_id (first tabs))
        tab-ids           (map :id tabs)
        dashcards         (t2/select :model/DashboardCard :dashboard_id dashboard-id :dashboard_tab_id [:in tab-ids])
        tab-id->dashcards (-> (group-by :dashboard_tab_id dashcards)
                              (update-vals #(sort dashboard-card/dashcard-comparator %)))
        tabs              (sort-by :position tabs)]
    (for [{:keys [id] :as tab} tabs]
      (assoc tab :cards (get tab-id->dashcards id)))))
(defmethod mi/perms-objects-set :model/DashboardTab
  [dashtab read-or-write]
  (let [dashboard (or (:dashboard dashtab)
                      (t2/select-one :model/Dashboard :id (:dashboard_id dashtab)))]
    (mi/perms-objects-set dashboard read-or-write)))

----------------------------------------------- SERIALIZATION ----------------------------------------------------

(defmethod serdes/hash-fields :model/DashboardTab
  [_dashboard-tab]
  [:name
   (comp serdes/identity-hash
        #(t2/select-one :model/Dashboard :id %)
        :dashboard_id)
   :position
   :created_at])

DashboardTabs are not serialized as their own, separate entities. They are inlined onto their parent Dashboards.

(defmethod serdes/generate-path "DashboardTab" [_ dashcard]
  [(serdes/infer-self-path "Dashboard" (t2/select-one :model/Dashboard :id (:dashboard_id dashcard)))
   (serdes/infer-self-path "DashboardTab" dashcard)])
(defmethod serdes/load-xform "DashboardTab"
  [dashtab]
  (-> dashtab
      (dissoc :serdes/meta)
      (update :dashboard_id serdes/*import-fk* :model/Dashboard)
      (update :created_at   #(if (string? %) (u.date/parse %) %))))

-------------------------------------------------- CRUD fns ------------------------------------------------------

(mu/defn create-tabs! :- [:map-of neg-int? pos-int?]
  "Create the new tabs and returned a mapping from temporary tab ID to the new tab ID."
  [dashboard-id :- ms/PositiveInt
   new-tabs     :- [:sequential [:map [:id neg-int?]]]]
  (let [new-tab-ids (t2/insert-returning-pks! :model/DashboardTab (->> new-tabs
                                                                       (map #(dissoc % :id))
                                                                       (map #(assoc % :dashboard_id dashboard-id))))]
    (zipmap (map :id new-tabs) new-tab-ids)))
(mu/defn update-tabs! :- nil?
  "Updates tabs of a dashboard if changed."
  [current-tabs :- [:sequential [:map [:id ms/PositiveInt]]]
   new-tabs     :- [:sequential [:map [:id ms/PositiveInt]]]]
  (let [update-ks       [:name :position]
        id->current-tab (m/index-by :id current-tabs)
        to-update-tabs  (filter
                          ;; filter out tabs that haven't changed
                          (fn [new-tab]
                            (let [current-tab (get id->current-tab (:id new-tab))]
                              (not= (select-keys current-tab update-ks)
                                    (select-keys new-tab update-ks))))
                          new-tabs)]
    (doseq [tab to-update-tabs]
      (t2/update! :model/DashboardTab (:id tab) (select-keys tab update-ks)))
    nil))
(mu/defn delete-tabs! :- nil?
  "Delete tabs of a Dashboard"
  [tab-ids :- [:sequential {:min 1} ms/PositiveInt]]
  (when (seq tab-ids)
    (t2/delete! :model/DashboardTab :id [:in tab-ids]))
  nil)

Given current tabs and new tabs, do the necessary create/update/delete to apply new tab changes. Returns: - old->new-tab-id: a map from tab IDs in new-tabs to newly created tab IDs - created-tab-ids - updated-tab-ids - deleted-tab-ids - total-num-tabs: the total number of active tabs after the operation.

(defn do-update-tabs!
  [dashboard-id current-tabs new-tabs]
  (let [{:keys [to-create
                to-update
                to-delete]} (u/classify-changes current-tabs new-tabs)
        to-delete-ids       (map :id to-delete)
        _                   (when-let [to-delete-ids (seq to-delete-ids)]
                              (delete-tabs! to-delete-ids))
        old->new-tab-id     (when (seq to-create)
                              (let [new-tab-ids (t2/insert-returning-pks! :model/DashboardTab
                                                                          (->> to-create
                                                                               (map #(dissoc % :id))
                                                                               (map #(assoc % :dashboard_id dashboard-id))))]
                                (zipmap (map :id to-create) new-tab-ids)))]
    (when (seq to-update)
      (update-tabs! current-tabs to-update))
    {:old->new-tab-id old->new-tab-id
     :created-tab-ids (vals old->new-tab-id)
     :deleted-tab-ids to-delete-ids
     :total-num-tabs  (reduce + (map count [to-create to-update]))}))
 
(ns metabase.models.database
  (:require
   [medley.core :as m]
   [metabase.db.util :as mdb.u]
   [metabase.driver :as driver]
   [metabase.driver.impl :as driver.impl]
   [metabase.driver.util :as driver.u]
   [metabase.models.audit-log :as audit-log]
   [metabase.models.interface :as mi]
   [metabase.models.permissions :as perms]
   [metabase.models.permissions-group :as perms-group]
   [metabase.models.secret :as secret :refer [Secret]]
   [metabase.models.serialization :as serdes]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru trs]]
   [metabase.util.log :as log]
   [methodical.core :as methodical]
   [toucan2.core :as t2]
   [toucan2.realize :as t2.realize]))

----------------------------------------------- Entity & Lifecycle -----------------------------------------------

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all Database symbols in our codebase.

(def Database
  :model/Database)
(methodical/defmethod t2/table-name :model/Database [_model] :metabase_database)
(t2/deftransforms :model/Database
  {:details                     mi/transform-encrypted-json
   :engine                      mi/transform-keyword
   :metadata_sync_schedule      mi/transform-cron-string
   :cache_field_values_schedule mi/transform-cron-string
   :start_of_week               mi/transform-keyword
   :settings                    mi/transform-encrypted-json
   :dbms_version                mi/transform-json})
(methodical/defmethod t2/model-for-automagic-hydration [:default :database] [_model _k] :model/Database)
(methodical/defmethod t2/model-for-automagic-hydration [:default :db]       [_model _k] :model/Database)
(doto :model/Database
  (derive :metabase/model)
  (derive ::mi/read-policy.partial-perms-for-perms-set)
  (derive ::mi/write-policy.full-perms-for-perms-set)
  (derive :hook/timestamped?))

Audit Database should only be fetched if audit app is enabled.

(defn- should-read-audit-db?
  [database-id]
  (and (not (premium-features/enable-audit-app?)) (= database-id perms/audit-db-id)))
(defmethod mi/can-read? Database
  ([instance]
   (if (should-read-audit-db? (:id instance))
     false
     (mi/current-user-has-partial-permissions? :read instance)))
  ([model pk]
   (if (should-read-audit-db? pk)
     false
     (mi/current-user-has-partial-permissions? :read model pk))))
(defmethod mi/can-write? :model/Database
  ([instance]
   (and (not= (u/the-id instance) perms/audit-db-id)
        ((get-method mi/can-write? ::mi/write-policy.full-perms-for-perms-set) instance)))
  ([model pk]
   (and (not= pk perms/audit-db-id)
        ((get-method mi/can-write? ::mi/write-policy.full-perms-for-perms-set) model pk))))

(Re)schedule sync operation tasks for database. (Existing scheduled tasks will be deleted first.)

(defn- schedule-tasks!
  [database]
  (try
    ;; this is done this way to avoid circular dependencies
    (classloader/require 'metabase.task.sync-databases)
    ((resolve 'metabase.task.sync-databases/check-and-schedule-tasks-for-db!) database)
    (catch Throwable e
      (log/error e (trs "Error scheduling tasks for DB")))))

TODO - something like NSNotificationCenter in Objective-C would be really really useful here so things that want to implement behavior when an object is deleted can do it without having to put code here

Unschedule any currently pending sync operation tasks for database.

(defn- unschedule-tasks!
  [database]
  (try
    (classloader/require 'metabase.task.sync-databases)
    ((resolve 'metabase.task.sync-databases/unschedule-tasks-for-db!) database)
    (catch Throwable e
      (log/error e (trs "Error unscheduling tasks for DB.")))))
(t2/define-after-insert :model/Database
  [database]
  (u/prog1 database
    ;; add this database to the All Users permissions group
    (perms/grant-full-data-permissions! (perms-group/all-users) database)
    ;; give full download perms for this database to the All Users permissions group
    (perms/grant-full-download-permissions! (perms-group/all-users) database)
    ;; schedule the Database sync & analyze tasks
    (schedule-tasks! (t2.realize/realize database))))

Track whether we're calling [[driver/normalize-db-details]] already to prevent infinite recursion. [[driver/normalize-db-details]] is actually done for side effects!

(def ^:private ^:dynamic *normalizing-details*
  false)
(t2/define-after-select :model/Database
  [{driver :engine, :as database}]
  (letfn [(normalize-details [db]
            (binding [*normalizing-details* true]
              (driver/normalize-db-details driver db)))]
    (cond-> database
      ;; TODO - this is only really needed for API responses. This should be a `hydrate` thing instead!
      (driver.impl/registered? driver)
      (assoc :features (driver.u/features driver database))

      (and (driver.impl/registered? driver)
           (:details database)
           (not *normalizing-details*))
      normalize-details)))

Delete Secret instances from the app DB, that will become orphaned when database is deleted. For now, this will simply delete any Secret whose ID appears in the details blob, since every Secret instance that is currently created is exclusively associated with a single Database.

In the future, if/when we allow arbitrary association of secret instances to database instances, this will need to change and become more complicated (likely by consulting a many-to-many join table).

(defn- delete-orphaned-secrets!
  [{:keys [id details] :as database}]
  (when-let [conn-props-fn (get-method driver/connection-properties (driver.u/database->driver database))]
    (let [conn-props                 (conn-props-fn (driver.u/database->driver database))
          possible-secret-prop-names (keys (secret/conn-props->secret-props-by-name conn-props))]
      (doseq [secret-id (reduce (fn [acc prop-name]
                                  (if-let [secret-id (get details (keyword (str prop-name "-id")))]
                                    (conj acc secret-id)
                                    acc))
                                []
                                possible-secret-prop-names)]
        (log/info (trs "Deleting secret ID {0} from app DB because the owning database ({1}) is being deleted"
                       secret-id
                       id))
        (t2/delete! Secret :id secret-id)))))
(t2/define-before-delete :model/Database
  [{id :id, driver :engine, :as database}]
  (unschedule-tasks! database)
  (t2/query-one {:delete-from :permissions
                 :where       [:like :object (str "%" (perms/data-perms-path id) "%")]})
  (delete-orphaned-secrets! database)
  (try
    (driver/notify-database-updated driver database)
    (catch Throwable e
      (log/error e (trs "Error sending database deletion notification")))))

Helper fn for reducing over a map of all the secret connection-properties, keyed by name. This is side effecting. At each iteration step, if there is a -value suffixed property set in the details to be persisted, then we instead insert (or update an existing) Secret instance and point to the inserted -id instead.

(defn- handle-db-details-secret-prop!
  [database details conn-prop-nm conn-prop]
  (let [sub-prop   (fn [suffix]
                     (keyword (str conn-prop-nm suffix)))
        id-kw      (sub-prop "-id")
        value-kw   (sub-prop "-value")
        new-name   (format "%s for %s" (:display-name conn-prop) (:name database))
        kind       (:secret-kind conn-prop)
        ;; in the future, when secret values can simply be changed by passing
        ;; in a new ID (as opposed to a new value), this behavior will change,
        ;; but for now, we should simply look for the value
        secret-map (secret/db-details-prop->secret-map details conn-prop-nm)
        value      (:value secret-map)
        src        (:source secret-map)] ; set the :source due to the -path suffix (see above)]
    (if (nil? value) ;; secret value for this conn prop was not changed
      details
      (let [{:keys [id] :as secret*} (secret/upsert-secret-value!
                                       (id-kw details)
                                       new-name
                                       kind
                                       src
                                       value)]
        (-> details
            ;; remove the -value keyword (since in the persisted details blob, we only ever want to store the -id),
            ;; but the value may be re-added by expand-inferred-secret-values below (if appropriate)
            (dissoc value-kw (sub-prop "-path"))
            (assoc id-kw id)
            (secret/expand-inferred-secret-values conn-prop-nm conn-prop secret*))))))
(defn- handle-secrets-changes [{:keys [details] :as database}]
  (if (map? details)
    (let [updated-details (secret/reduce-over-details-secret-values
                            (driver.u/database->driver database)
                            details
                            (partial handle-db-details-secret-prop! database))]
      (assoc database :details updated-details))
    database))
(t2/define-before-update :model/Database
  [database]
  (let [database                  (mi/pre-update-changes database)
        {new-metadata-schedule    :metadata_sync_schedule,
         new-fieldvalues-schedule :cache_field_values_schedule,
         new-engine               :engine
         new-settings             :settings} database
        {is-sample?               :is_sample
         old-metadata-schedule    :metadata_sync_schedule
         old-fieldvalues-schedule :cache_field_values_schedule
         existing-settings        :settings
         existing-engine          :engine
         existing-name            :name} (t2/original database)
        new-engine                       (some-> new-engine keyword)]
    (if (and is-sample?
             new-engine
             (not= new-engine existing-engine))
      (throw (ex-info (trs "The engine on a sample database cannot be changed.")
                      {:status-code     400
                       :existing-engine existing-engine
                       :new-engine      new-engine}))
      (u/prog1 (-> database
                   (cond->
                     ;; If the engine doesn't support nested field columns, `json_unfolding` must be nil
                     (and (some? (:details database))
                          (not (driver/database-supports? (or new-engine existing-engine) :nested-field-columns database)))
                     (update :details dissoc :json_unfolding))
                   handle-secrets-changes)
        ;; TODO - this logic would make more sense in post-update if such a method existed
        ;; if the sync operation schedules have changed, we need to reschedule this DB
        (when (or new-metadata-schedule new-fieldvalues-schedule)
          ;; if one of the schedules wasn't passed continue using the old one
          (let [new-metadata-schedule    (or new-metadata-schedule old-metadata-schedule)
                new-fieldvalues-schedule (or new-fieldvalues-schedule old-fieldvalues-schedule)]
            (when (not= [new-metadata-schedule new-fieldvalues-schedule]
                        [old-metadata-schedule old-fieldvalues-schedule])
              (log/info
                (trs "{0} Database ''{1}'' sync/analyze schedules have changed!" existing-engine existing-name)
                "\n"
                (trs "Sync metadata was: ''{0}'' is now: ''{1}''" old-metadata-schedule new-metadata-schedule)
                "\n"
                (trs "Cache FieldValues was: ''{0}'', is now: ''{1}''" old-fieldvalues-schedule new-fieldvalues-schedule))
              ;; reschedule the database. Make sure we're passing back the old schedule if one of the two wasn't supplied
              (schedule-tasks!
                (assoc database
                       :metadata_sync_schedule      new-metadata-schedule
                       :cache_field_values_schedule new-fieldvalues-schedule)))))
        ;; This maintains a constraint that if a driver doesn't support actions, it can never be enabled
        ;; If we drop support for actions for a driver, we'd need to add a migration to disable actions for all databases
        (when (and (:database-enable-actions (or new-settings existing-settings))
                   (not (driver/database-supports? (or new-engine existing-engine) :actions database)))
          (throw (ex-info (trs "The database does not support actions.")
                          {:status-code     400
                           :existing-engine existing-engine
                           :new-engine      new-engine})))))))
(t2/define-before-insert :model/Database
  [{:keys [details initial_sync_status], :as database}]
  (-> database
      (cond->
        (not details)             (assoc :details {})
        (not initial_sync_status) (assoc :initial_sync_status "incomplete"))
      handle-secrets-changes))
(defmethod mi/perms-objects-set :model/Database
  [{db-id :id} read-or-write]
  #{(case read-or-write
      :read  (perms/data-perms-path db-id)
      :write (perms/db-details-write-perms-path db-id))})
(defmethod serdes/hash-fields :model/Database
  [_database]
  [:name :engine])
(defsetting persist-models-enabled
  (deferred-tru "Whether to enable models persistence for a specific Database.")
  :default        false
  :type           :boolean
  :visibility     :public
  :database-local :only)

---------------------------------------------- Hydration / Util Fns ----------------------------------------------

(mi/define-simple-hydration-method tables
  :tables
  "Return the `Tables` associated with this `Database`."
  [{:keys [id]}]
  ;; TODO - do we want to include tables that should be `:hidden`?
  (t2/select 'Table, :db_id id, :active true, {:order-by [[:%lower.display_name :asc]]}))

Return all the primary key Fields associated with this database.

(defn pk-fields
  [{:keys [id]}]
  (let [table-ids (t2/select-pks-set 'Table, :db_id id, :active true)]
    (when (seq table-ids)
      (t2/select 'Field, :table_id [:in table-ids], :semantic_type (mdb.u/isa :type/PK)))))

-------------------------------------------------- JSON Encoder --------------------------------------------------

The string to replace passwords with when serializing Databases.

(def ^:const protected-password
  "**MetabasePass**")

Gets all sensitive fields that should be redacted in API responses for a given database. Delegates to driver.u/sensitive-fields using the given database's driver (if valid), so refer to that for full details. If a valid driver can't be clearly determined, this simply returns the default set (driver.u/default-sensitive-fields).

(defn sensitive-fields-for-db
  [database]
  (if (and (some? database) (not-empty database))
      (let [driver (driver.u/database->driver database)]
        (if (some? driver)
            (driver.u/sensitive-fields (driver.u/database->driver database))
            driver.u/default-sensitive-fields))
      driver.u/default-sensitive-fields))
(methodical/defmethod mi/to-json :model/Database
  "When encoding a Database as JSON remove the `details` for any User without write perms for the DB.
  Users with write perms can see the `details` but remove anything resembling a password. No one gets to see this in
  an API response!
  Also remove settings that the User doesn't have read perms for."
  [db json-generator]
  (next-method
   (let [db (if (not (mi/can-write? db))
              (dissoc db :details)
              (update db :details (fn [details]
                                    (reduce
                                     #(m/update-existing %1 %2 (constantly protected-password))
                                     details
                                     (sensitive-fields-for-db db)))))]
     (update db :settings (fn [settings]
                            (when (map? settings)
                              (m/filter-keys
                               (fn [setting-name]
                                 (try
                                  (setting/can-read-setting? setting-name
                                                             (setting/current-user-readable-visibilities))
                                  (catch Throwable e
                                    ;; there is an known issue with exception is ignored when render API response (#32822)
                                    ;; If you see this error, you probably need to define a setting for `setting-name`.
                                    ;; But ideally, we should resovle the above issue, and remove this try/catch
                                    (log/error e (format "Error checking the readability of %s setting. The setting will be hidden in API response." setting-name))
                                    ;; let's be conservative and hide it by defaults, if you want to see it,
                                    ;; you need to define it :)
                                    false)))
                               settings)))))
   json-generator))

------------------------------------------------ Serialization ----------------------------------------------------

(defmethod serdes/extract-one "Database"
  [_model-name {:keys [include-database-secrets]} entity]
  (-> (serdes/extract-one-basics "Database" entity)
      (update :creator_id serdes/*export-user*)
      (dissoc :features) ; This is a synthetic column that isn't in the real schema.
      (cond-> (not include-database-secrets) (dissoc :details))))
(defmethod serdes/entity-id "Database"
  [_ {:keys [name]}]
  name)
(defmethod serdes/generate-path "Database"
  [_ {:keys [name]}]
  [{:model "Database" :id name}])
(defmethod serdes/load-find-local "Database"
  [[{:keys [id]}]]
  (t2/select-one Database :name id))
(defmethod serdes/load-xform "Database"
  [database]
  (-> database
      serdes/load-xform-basics
      (update :creator_id serdes/*import-user*)
      (assoc :initial_sync_status "complete")))
(defmethod serdes/load-insert! "Database" [_ ingested]
  (let [m (get-method serdes/load-insert! :default)]
    (m "Database"
       (if (:details ingested)
         ingested
         (assoc ingested :details {})))))
(defmethod serdes/load-update! "Database" [_ ingested local]
  (let [m (get-method serdes/load-update! :default)]
    (m "Database"
       (update ingested :details #(or % (:details local) {}))
       local)))
(defmethod serdes/storage-path "Database" [{:keys [name]} _]
  ;; ["databases" "db_name" "db_name"] directory for the database with same-named file inside.
  ["databases" name name])
(defmethod audit-log/model-details Database
  [database _event-type]
  (select-keys database [:id :name :engine]))
 

Dimensions are used to define remappings for Fields handled automatically when those Fields are encountered by the Query Processor. For a more detailed explanation, refer to the documentation in metabase.query-processor.middleware.add-dimension-projections.

(ns metabase.models.dimension
  (:require
   [metabase.models.interface :as mi]
   [metabase.models.serialization :as serdes]
   [metabase.util.date-2 :as u.date]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

Possible values for Dimension.type :

:internal :external

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase.

(def Dimension
  :model/Dimension)
(methodical/defmethod t2/table-name :model/Dimension [_model] :dimension)
(doto :model/Dimension
  (derive :metabase/model)
  (derive :hook/entity-id)
  (derive :hook/timestamped?))
(t2/deftransforms :model/Dimension
  {:type mi/transform-keyword})
(defmethod serdes/hash-fields :model/Dimension
  [_dimension]
  [(serdes/hydrated-hash :field)
   (serdes/hydrated-hash :human_readable_field)
   :created_at])

------------------------------------------------- Serialization -------------------------------------------------- Dimensions are inlined onto their parent Fields. We can reuse the [[serdes/load-one!]] logic by implementing [[serdes/load-xform]] though.

(defmethod serdes/load-xform "Dimension"
  [dim]
  (-> dim
      serdes/load-xform-basics
      ;; No need to handle :field_id, it was just added as the raw ID by the caller; see Field's load-one!
      (update            :human_readable_field_id serdes/*import-field-fk*)
      (update            :created_at              u.date/parse)))
 

Helpers to assist in the transition to Toucan 2. Once we switch to Toucan 2 this stuff shouldn't be needed, but we can update this namespace instead of having to update code all over the place.

(ns metabase.models.dispatch
  (:require
   [potemkin :as p]
   [schema.core :as s]
   [toucan2.core :as t2]))
(p/import-vars
 [t2
  instance
  instance-of?
  model])

True if x is a Toucan instance, but not a Toucan model.

(defn toucan-instance?
  [x]
  (t2/instance? x))
(defn ^:deprecated InstanceOf:Schema
  "Helper for creating a schema to check whether something is an instance of `model`. Use this instead of of using the
  `<Model>Instance` or calling [[type]] or [[class]] on a model yourself, since that won't work once we switch to
  Toucan 2.
    (s/defn my-fn :- (mi/InstanceOf:Schema User)
      []
      ...)
  DEPRECATED: use [[InstanceOf]] and Malli instead."
  [model]
  (s/pred (fn [x]
            (instance-of? model x))
          (format "instance of a %s" (name model))))

Helper for creating a Malli schema to check whether something is an instance of model. Use this instead of of using the <Model>Instance or calling [[type]] or [[class]] on a model yourself, since that won't work once we switch to Toucan 2.

(mu/defn my-fn :- (mi/InstanceOf User) [] ...)

(defn InstanceOf
  [model]
  [:fn
   {:error/message (format "instance of a %s" (name model))}
   (partial instance-of? model)])
 
(ns metabase.models.field
  (:require
   [clojure.core.memoize :as memoize]
   [clojure.set :as set]
   [clojure.string :as str]
   [medley.core :as m]
   [metabase.db.connection :as mdb.connection]
   [metabase.lib.field :as lib.field]
   [metabase.lib.metadata.jvm :as lib.metadata.jvm]
   [metabase.models.dimension :refer [Dimension]]
   [metabase.models.field-values :as field-values :refer [FieldValues]]
   [metabase.models.humanization :as humanization]
   [metabase.models.interface :as mi]
   [metabase.models.permissions :as perms]
   [metabase.models.serialization :as serdes]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [methodical.core :as methodical]
   [toucan2.core :as t2]
   [toucan2.tools.hydrate :as t2.hydrate]))
(set! *warn-on-reflection* true)
(comment mdb.connection/keep-me) ;; for [[memoize/ttl]]

for [[memoize/ttl]]

------------------------------------------------- Type Mappings --------------------------------------------------

Possible values for Field.visibility_type.

(def visibility-types
  #{:normal         ; Default setting.  field has no visibility restrictions.
    :details-only   ; For long blob like columns such as JSON.  field is not shown in some places on the frontend.
    :hidden         ; Lightweight hiding which removes field as a choice in most of the UI.  should still be returned in queries.
    :sensitive      ; Strict removal of field from all places except data model listing.  queries should error if someone attempts to access.
    :retired})      ; For fields that no longer exist in the physical db.  automatically set by Metabase.  QP should error if encountered in a query.

----------------------------------------------- Entity & Lifecycle -----------------------------------------------

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all the Field symbol in our codebase.

(def Field
  :model/Field)
(methodical/defmethod t2/table-name :model/Field [_model] :metabase_field)
(methodical/defmethod t2/model-for-automagic-hydration [:default :destination]          [_model _k]  :model/Field)
(methodical/defmethod t2/model-for-automagic-hydration [:default :field]                [_model _k]  :model/Field)
(methodical/defmethod t2/model-for-automagic-hydration [:default :origin]               [_model _k]  :model/Field)
(methodical/defmethod t2/model-for-automagic-hydration [:default :human_readable_field] [_model _k]  :model/Field)
(defn- hierarchy-keyword-in [column-name & {:keys [ancestor-types]}]
  (fn [k]
    (when-let [k (keyword k)]
      (when-not (some
                 (partial isa? k)
                 ancestor-types)
        (let [message (tru "Invalid value for Field column {0}: {1} is not a descendant of any of these types: {2}"
                           (pr-str column-name) (pr-str k) (pr-str ancestor-types))]
          (throw (ex-info message
                          {:status-code       400
                           :errors            {column-name message}
                           :value             k
                           :allowed-ancestors ancestor-types}))))
      (u/qualified-name k))))
(defn- hierarchy-keyword-out [column-name & {:keys [fallback-type ancestor-types]}]
  (fn [s]
    (when (seq s)
      (let [k (keyword s)]
        (if (some
             (partial isa? k)
             ancestor-types)
          k
          (do
            (log/warn (trs "Invalid Field {0} {1}: falling back to {2}" column-name k fallback-type))
            fallback-type))))))
(def ^:private transform-field-base-type
  {:in  (hierarchy-keyword-in  :base_type :ancestor-types [:type/*])
   :out (hierarchy-keyword-out :base_type :ancestor-types [:type/*], :fallback-type :type/*)})
(def ^:private transform-field-effective-type
  {:in  (hierarchy-keyword-in  :effective_type :ancestor-types [:type/*])
   :out (hierarchy-keyword-out :effective_type :ancestor-types [:type/*], :fallback-type :type/*)})
(def ^:private transform-field-semantic-type
  {:in  (hierarchy-keyword-in  :semantic_type :ancestor-types [:Semantic/* :Relation/*])
   :out (hierarchy-keyword-out :semantic_type :ancestor-types [:Semantic/* :Relation/*], :fallback-type nil)})
(def ^:private transform-field-coercion-strategy
  {:in  (hierarchy-keyword-in  :coercion_strategy :ancestor-types [:Coercion/*])
   :out (hierarchy-keyword-out :coercion_strategy :ancestor-types [:Coercion/*], :fallback-type nil)})
(defn- maybe-parse-semantic-numeric-values [maybe-double-value]
  (if (string? maybe-double-value)
    (or (u/ignore-exceptions (Double/parseDouble maybe-double-value)) maybe-double-value)
    maybe-double-value))

When fingerprinting decimal columns, NaN and Infinity values are possible. Serializing these values to JSON just yields a string, not a value double. This function will attempt to coerce any of those values to double objects

(defn- update-semantic-numeric-values
  [fingerprint]
  (m/update-existing-in fingerprint [:type :type/Number]
                        (partial m/map-vals maybe-parse-semantic-numeric-values)))
(def ^:private transform-json-fingerprints
  {:in  mi/json-in
   :out (comp update-semantic-numeric-values mi/json-out-with-keywordization)})
(t2/deftransforms :model/Field
  {:base_type         transform-field-base-type
   :effective_type    transform-field-effective-type
   :coercion_strategy transform-field-coercion-strategy
   :semantic_type     transform-field-semantic-type
   :visibility_type   mi/transform-keyword
   :has_field_values  mi/transform-keyword
   :fingerprint       transform-json-fingerprints
   :settings          mi/transform-json
   :nfc_path          mi/transform-json})
(doto :model/Field
  (derive :metabase/model)
  (derive ::mi/read-policy.partial-perms-for-perms-set)
  (derive ::mi/write-policy.full-perms-for-perms-set)
  (derive :hook/timestamped?))
(t2/define-before-insert :model/Field
  [field]
  (let [defaults {:display_name (humanization/name->human-readable-name (:name field))}]
    (merge defaults field)))
(t2/define-before-update :model/Field
  [field]
  (u/prog1 (t2/changes field)
    (when (false? (:active <>))
      (t2/update! :model/Field {:fk_target_field_id (:id field)} {:semantic_type      nil
                                                                  :fk_target_field_id nil}))))

Field permissions There are several API endpoints where large instances can return many thousands of Fields. Normally Fields require a DB call to fetch information about their Table, because a Field's permissions set is the same as its parent Table's. To make API endpoints perform well, we have use two strategies: 1) If a Field's Table is already hydrated, there is no need to manually fetch the information a second time 2) Failing that, we cache the corresponding permissions sets for each Table ID for a few seconds to minimize the number of DB calls that are made. See discussion below for more details.

(defn- perms-objects-set*
  [db-id schema table-id read-or-write]
  #{(case read-or-write
      :read  (perms/data-perms-path db-id schema table-id)
      :write (perms/data-model-write-perms-path db-id schema table-id))})

Cached lookup for the permissions set for a table with table-id. This is done so a single API call or other unit of computation doesn't accidentally end up in a situation where thousands of DB calls end up being made to calculate permissions for a large number of Fields. Thus, the cache only persists for 5 seconds.

Of course, no DB lookups are needed at all if the Field already has a hydrated Table. However, mistakes are possible, and I did not extensively audit every single code pathway that uses sequences of Fields and permissions, so this caching is added as a failsafe in case Table hydration wasn't done.

Please note this only caches one entry PER TABLE ID. Thus, even a million Tables (which is more than I hope we ever see), would require only a few megs of RAM, and again only if every single Table was looked up in a span of 5 seconds.

(def ^:private ^{:arglists '([table-id read-or-write])} cached-perms-object-set
  (memoize/ttl
   ^{::memoize/args-fn (fn [[table-id read-or-write]]
                         [(mdb.connection/unique-identifier) table-id read-or-write])}
   (fn [table-id read-or-write]
     (let [{schema :schema, db-id :db_id} (t2/select-one ['Table :schema :db_id] :id table-id)]
       (perms-objects-set* db-id schema table-id read-or-write)))
   :ttl/threshold 5000))

Calculate set of permissions required to access a Field. For the time being permissions to access a Field are the same as permissions to access its parent Table.

(defmethod mi/perms-objects-set :model/Field
  [{table-id :table_id, {db-id :db_id, schema :schema} :table} read-or-write]
  (if db-id
    ;; if Field already has a hydrated `:table`, then just use that to generate perms set (no DB calls required)
    (perms-objects-set* db-id schema table-id read-or-write)
    ;; otherwise we need to fetch additional info about Field's Table. This is cached for 5 seconds (see above)
    (cached-perms-object-set table-id read-or-write)))
(defmethod serdes/hash-fields :model/Field
  [_field]
  [:name (serdes/hydrated-hash :table)])

---------------------------------------------- Hydration / Util Fns ----------------------------------------------

Return the FieldValues associated with this field.

(defn values
  [{:keys [id]}]
  (t2/select [FieldValues :field_id :values], :field_id id))
(mu/defn nested-field-names->field-id :- [:maybe ms/PositiveInt]
  "Recusively find the field id for a nested field name, return nil if not found.
  Nested field here refer to a field that has another field as its parent_id, like nested field in Mongo DB.
  This is to differentiate from the json nested field in, which the path is defined in metabase_field.nfc_path."
  [table-id    :- ms/PositiveInt
   field-names :- [:sequential ms/NonBlankString]]
  (loop [field-names field-names
         field-id    nil]
    (if (seq field-names)
      (let [field-name (first field-names)
            field-id   (t2/select-one-pk :model/Field :name field-name :parent_id field-id :table_id table-id)]
        (if field-id
          (recur (rest field-names) field-id)
          nil))
      field-id)))

Select instances of model related by field_id FK to a Field in fields, and return a map of Field ID -> model instance. This only returns a single instance for each Field! Duplicates are discarded!

(select-field-id->instance [(Field 1) (Field 2)] FieldValues) ;; -> {1 #FieldValues{...}, 2 #FieldValues{...}}

(select-field-id->instance [(Field 1) (Field 2)] FieldValues :type :full) -> returns Fieldvalues of type :full for fields: [(Field 1) (Field 2)]

(defn- select-field-id->instance
  [fields model & conditions]
  (let [field-ids (set (map :id fields))]
    (m/index-by :field_id (when (seq field-ids)
                            (apply t2/select model :field_id [:in field-ids] conditions)))))
(mi/define-batched-hydration-method with-values
  :values
  "Efficiently hydrate the `FieldValues` for a collection of `fields`."
  [fields]
  ;; In 44 we added a new concept of Advanced FieldValues, so FieldValues are no longer have an one-to-one relationship
  ;; with Field. See the doc in [[metabase.models.field-values]] for more.
  ;; Adding an explicity filter by :type =:full for FieldValues here bc I believe this hydration does not concern
  ;; the new Advanced FieldValues.
  (let [id->field-values (select-field-id->instance fields FieldValues :type :full)]
    (for [field fields]
      (assoc field :values (get id->field-values (:id field) [])))))
(mi/define-batched-hydration-method with-normal-values
  :normal_values
  "Efficiently hydrate the `FieldValues` for visibility_type normal `fields`."
  [fields]
  (let [id->field-values (select-field-id->instance (filter field-values/field-should-have-field-values? fields)
                                                    [FieldValues :id :human_readable_values :values :field_id]
                                                    :type :full)]
    (for [field fields]
      (assoc field :values (get id->field-values (:id field) [])))))
(mi/define-batched-hydration-method with-dimensions
  :dimensions
  "Efficiently hydrate the `Dimension` for a collection of `fields`.
  NOTE! Despite the name, this only returns at most one dimension. This is for historic reasons; see #13350 for more
  details.
  Despite the weirdness, this used to be even worse -- due to a bug in the code, this originally returned a *map* if
  there was a matching Dimension, or an empty vector if there was not. In 0.46.0 I fixed this to return either a
  vector with the matching Dimension, or an empty vector. At least the response shape is consistent now. Maybe in the
  future we can change this key to `:dimension` and return it that way. -- Cam"
  [fields]
  (let [id->dimensions (select-field-id->instance fields Dimension)]
    (for [field fields
          :let  [dimension (get id->dimensions (:id field))]]
      (assoc field :dimensions (if dimension [dimension] [])))))
(methodical/defmethod t2.hydrate/simple-hydrate [#_model :default #_k :has_field_values]
  "Infer what the value of the `has_field_values` should be for Fields where it's not set. See documentation for
  [[metabase.lib.schema.metadata/column-has-field-values-options]] for a more detailed explanation of what these
  values mean.
  This does one important thing: if `:has_field_values` is already present and set to `:auto-list`, it is replaced by
  `:list` -- presumably because the frontend doesn't need to know `:auto-list` even exists?
  See [[lib.field/infer-has-field-values]] for more info."
  [_model k field]
  (when field
    (let [has-field-values (lib.field/infer-has-field-values (lib.metadata.jvm/instance->metadata field :metadata/column))]
      (assoc field k has-field-values))))
(methodical/defmethod t2.hydrate/needs-hydration? [#_model :default #_k :has_field_values]
  "Always (re-)hydrate `:has_field_values`. This is used to convert an existing value of `:auto-list` to
  `:list` (see [[infer-has-field-values]])."
  [_model _k _field]
  true)

Efficiently checks if each field is readable and returns only readable fields

(defn readable-fields-only
  [fields]
  (for [field (t2/hydrate fields :table)
        :when (mi/can-read? field)]
    (dissoc field :table)))
(mi/define-batched-hydration-method with-targets
  :target
  "Efficiently hydrate the FK target fields for a collection of `fields`."
  [fields]
  (let [target-field-ids (set (for [field fields
                                    :when (and (isa? (:semantic_type field) :type/FK)
                                               (:fk_target_field_id field))]
                                (:fk_target_field_id field)))
        id->target-field (m/index-by :id (when (seq target-field-ids)
                                           (readable-fields-only (t2/select Field :id [:in target-field-ids]))))]
    (for [field fields
          :let  [target-id (:fk_target_field_id field)]]
      (assoc field :target (id->target-field target-id)))))

Hydrates :target on field, but if the :fk_target_field_id field is not writable, :target will be nil.

(defn hydrate-target-with-write-perms
  [field]
  (let [target-field-id (when (isa? (:semantic_type field) :type/FK)
                          (:fk_target_field_id field))
        target-field    (when-let [target-field (and target-field-id (t2/select-one Field :id target-field-id))]
                          (when (mi/can-write? (t2/hydrate target-field :table))
                            target-field))]
    (assoc field :target target-field)))

Return the pieces that represent a path to field, of the form [table-name parent-fields-name* field-name].

(defn qualified-name-components
  [{field-name :name, table-id :table_id, parent-id :parent_id}]
  (conj (vec (if-let [parent (t2/select-one Field :id parent-id)]
               (qualified-name-components parent)
               (let [{table-name :name, schema :schema} (t2/select-one ['Table :name :schema], :id table-id)]
                 (conj (when schema
                         [schema])
                       table-name))))
        field-name))

Return a combined qualified name for field, e.g. table_name.parent_field_name.field_name.

(defn qualified-name
  [field]
  (str/join \. (qualified-name-components field)))

Return the ID of the Table this Field belongs to.

(def ^{:arglists '([field-id])} field-id->table-id
  (mdb.connection/memoize-for-application-db
   (fn [field-id]
     {:pre [(integer? field-id)]}
     (t2/select-one-fn :table_id Field, :id field-id))))

Return the ID of the Database this Field belongs to.

(defn field-id->database-id
  [field-id]
  {:pre [(integer? field-id)]}
  (let [table-id (field-id->table-id field-id)]
    ((requiring-resolve 'metabase.models.table/table-id->database-id) table-id)))

Return the Table associated with this Field.

(defn table
  {:arglists '([field])}
  [{:keys [table_id]}]
  (t2/select-one 'Table, :id table_id))

------------------------------------------------- Serialization -------------------------------------------------

In order to retrieve the dependencies for a field its table_id needs to be serialized as [database schema table], a trio of strings with schema maybe nil.

(defmethod serdes/generate-path "Field" [_ {table_id :table_id field :name}]
  (let [table (when (number? table_id)
                   (t2/select-one 'Table :id table_id))
        db    (when table
                (t2/select-one-fn :name 'Database :id (:db_id table)))
        [db schema table] (if (number? table_id)
                            [db (:schema table) (:name table)]
                            ;; If table_id is not a number, it's already been exported as a [db schema table] triple.
                            table_id)]
    (filterv some? [{:model "Database" :id db}
                    (when schema {:model "Schema" :id schema})
                    {:model "Table"    :id table}
                    {:model "Field"    :id field}])))
(defmethod serdes/entity-id "Field" [_ {:keys [name]}]
  name)
(defmethod serdes/extract-query "Field" [_model-name _opts]
  (let [d (t2/select Dimension)
        dimensions (->> d
                        (group-by :field_id))]
    (eduction (map #(assoc % :dimensions (get dimensions (:id %))))
              (t2/reducible-select Field))))
(defmethod serdes/dependencies "Field" [field]
  ;; Fields depend on their parent Table, plus any foreign Fields referenced by their Dimensions.
  ;; Take the path, but drop the Field section to get the parent Table's path instead.
  (let [this  (serdes/path field)
        table (pop this)
        fks   (some->> field :fk_target_field_id serdes/field->path)
        human (->> (:dimensions field)
                   (keep :human_readable_field_id)
                   (map serdes/field->path)
                   set)]
    (cond-> (set/union #{table} human)
      fks   (set/union #{fks})
      true  (disj this))))
(defn- extract-dimensions [dimensions]
  (->> (for [dim dimensions]
         (-> (into (sorted-map) dim)
             (dissoc :field_id :updated_at) ; :field_id is implied by the nesting under that field.
             (update :human_readable_field_id serdes/*export-field-fk*)))
       (sort-by :created_at)))
(defmethod serdes/extract-one "Field"
  [_model-name _opts field]
  (let [field (if (contains? field :dimensions)
                field
                (assoc field :dimensions (t2/select Dimension :field_id (:id field))))]
    (-> (serdes/extract-one-basics "Field" field)
        (update :dimensions         extract-dimensions)
        (update :table_id           serdes/*export-table-fk*)
        (update :fk_target_field_id serdes/*export-field-fk*)
        (dissoc :fingerprint :last_analyzed :fingerprint_version))))
(defmethod serdes/load-xform "Field"
  [field]
  (-> (serdes/load-xform-basics field)
      (update :table_id           serdes/*import-table-fk*)
      (update :fk_target_field_id serdes/*import-field-fk*)))
(defmethod serdes/load-find-local "Field"
  [path]
  (let [table (serdes/load-find-local (pop path))]
    (t2/select-one Field :name (-> path last :id) :table_id (:id table))))
(defmethod serdes/load-one! "Field" [ingested maybe-local]
  (let [field ((get-method serdes/load-one! :default) (dissoc ingested :dimensions) maybe-local)]
    (doseq [dim (:dimensions ingested)]
      (let [local (t2/select-one Dimension :entity_id (:entity_id dim))
            dim   (assoc dim
                         :field_id    (:id field)
                         :serdes/meta [{:model "Dimension" :id (:entity_id dim)}])]
        (serdes/load-one! dim local)))))
(defmethod serdes/storage-path "Field" [field _]
  (-> field
      serdes/path
      drop-last
      serdes/storage-table-path-prefix
      (concat ["fields" (:name field)])))
 

FieldValues is used to store a cached list of values of Fields that has has_field_values=:auto-list or :list. Check the doc in [[metabase.lib.schema.metadata/column-has-field-values-options]] for more info about has_field_values.

There are 2 main classes of FieldValues: Full and Advanced. - Full FieldValues store a list of distinct values of a Field without any constraints. - Whereas Advanced FieldValues has additional constraints: - sandbox: FieldValues of a field but is sandboxed for a specific user - linked-filter: FieldValues for a param that connects to a Field that is constrained by the values of other Field. It's currently being used on Dashboard or Embedding, but it could be used to power any parameters that connect to a Field.

  • Life cycle
  • Full FieldValues are created by the fingerprint or scanning process. Once it's created the values will be updated by the scanning process that runs daily. Only active FieldValues that have a lastusedat within [[active-field-values-cutoff]] will be updated on sync. FieldValues get a new lastusedat when going through [[get-or-create-full-field-values!]].
  • Advanced FieldValues are created on demand: for example the Sandbox FieldValues are created when a user with sandboxed permission try to get values of a Field. Normally these FieldValues will be deleted after [[advanced-field-values-max-age]] days by the scanning process. But they will also be automatically deleted when the Full FieldValues of the same Field got updated.

There is also more written about how these are used for remapping in the docstrings for [[metabase.models.params.chain-filter]] and [[metabase.query-processor.middleware.add-dimension-projections]].

(ns metabase.models.field-values
  (:require
   [java-time.api :as t]
   [malli.core :as mc]
   [medley.core :as m]
   [metabase.models.interface :as mi]
   [metabase.models.serialization :as serdes]
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli.schema :as ms]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

Fields with less than this many distinct values should automatically be given a semantic type of :type/Category. This no longer has any meaning whatsoever as far as the backend code is concerned; it is used purely to inform frontend behavior such as widget choices.

(def ^Long category-cardinality-threshold
  30)

Fields with less than this many distincy values should be given a has_field_values value of list, which means the Field should have FieldValues.

(def ^Long auto-list-cardinality-threshold
  1000)

The maximum character length for a stored FieldValues entry.

(def ^:private ^Long entry-max-length
  100)

Maximum total length for a FieldValues entry (combined length of all values for the field).

(def ^:dynamic ^Long *total-max-length*
  (long (* auto-list-cardinality-threshold entry-max-length)))

Age of an advanced FieldValues in days. After this time, these field values should be deleted by the delete-expired-advanced-field-values job.

(def ^java.time.Period advanced-field-values-max-age
  (t/days 30))

How many days until a FieldValues is considered inactive. Inactive FieldValues will not be synced until they are used again.

(def ^:private ^java.time.Period active-field-values-cutoff
  (t/days 14))

A class of fieldvalues that has additional constraints/filters.

(def advanced-field-values-types
  #{:sandbox         ;; field values filtered by sandbox permissions
    :impersonation   ;; field values with connection impersonation enforced (db-level roles)
    :linked-filter}) ;; field values with constraints from other linked parameters on dashboard/embedding

field values with constraints from other linked parameters on dashboard/embedding

All FieldValues type.

(def ^:private field-values-types
  (into #{:full} ;; default type for fieldvalues where it contains values for a field without constraints
        advanced-field-values-types))

+----------------------------------------------------------------------------------------------------------------+ | Entity & Lifecycle | +----------------------------------------------------------------------------------------------------------------+

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase.

(def FieldValues
  :model/FieldValues)
(methodical/defmethod t2/table-name :model/FieldValues [_model] :metabase_fieldvalues)
(doto :model/FieldValues
  (derive :metabase/model)
  (derive :hook/timestamped?))
(t2/deftransforms :model/FieldValues
  {:human_readable_values mi/transform-json-no-keywordization
   :values                mi/transform-json
   :type                  mi/transform-keyword})
(defn- assert-valid-human-readable-values [{human-readable-values :human_readable_values}]
  (when-not (mc/validate [:maybe [:sequential [:maybe ms/NonBlankString]]] human-readable-values)
    (throw (ex-info (tru "Invalid human-readable-values: values must be a sequence; each item must be nil or a string")
                    {:human-readable-values human-readable-values
                     :status-code           400}))))
(defn- assert-valid-field-values-type
  [{:keys [type hash_key] :as _field-values}]
  (when type
    (when-not (contains? field-values-types type)
      (throw (ex-info (tru "Invalid field-values type.")
                      {:type        type
                       :stauts-code 400})))
    (when (and (= type :full)
               hash_key)
      (throw (ex-info (tru "Full FieldValues shouldn't have hash_key.")
                      {:type        type
                       :hash_key    hash_key
                       :status-code 400})))
    (when (and (advanced-field-values-types type)
               (empty? hash_key))
      (throw (ex-info (tru "Advanced FieldValues requires a hash_key.")
                      {:type        type
                       :status-code 400})))))

Remove all advanced FieldValues for a field-or-id.

(defn clear-advanced-field-values-for-field!
  [field-or-id]
  (t2/delete! FieldValues :field_id (u/the-id field-or-id)
                          :type     [:in advanced-field-values-types]))

Remove all FieldValues for a field-or-id, including the advanced fieldvalues.

(defn clear-field-values-for-field!
  [field-or-id]
  (t2/delete! FieldValues :field_id (u/the-id field-or-id)))
(t2/define-before-insert :model/FieldValues
  [{:keys [field_id] :as field-values}]
  (u/prog1 (merge {:type :full}
                  field-values)
    (assert-valid-human-readable-values field-values)
    (assert-valid-field-values-type field-values)
    ;; if inserting a new full fieldvalues, make sure all the advanced field-values of this field is deleted
    (when (= (:type <>) :full)
      (clear-advanced-field-values-for-field! field_id))))
(t2/define-before-update :model/FieldValues
  [field-values]
  (let [{:keys [type values hash_key]} (t2/changes field-values)]
    (u/prog1 field-values
      (assert-valid-human-readable-values field-values)
      (when (or type hash_key)
        (throw (ex-info (tru "Can't update type or hash_key for a FieldValues.")
                        {:type        type
                         :hash_key    hash_key
                         :status-code 400})))
      ;; if we're updating the values of a Full FieldValues, delete all Advanced FieldValues of this field
      (when (and values
                 (= (:type field-values) :full))
        (clear-advanced-field-values-for-field! (:field_id field-values))))))
(t2/define-after-select :model/FieldValues
  [field-values]
  (cond-> field-values
    (contains? field-values :human_readable_values)
    (update :human_readable_values (fn [human-readable-values]
                                     (cond
                                       (sequential? human-readable-values)
                                       human-readable-values

                                       ;; in some places human readable values were incorrectly saved as a map. If
                                       ;; that's the case, convert them back to a sequence
                                       (map? human-readable-values)
                                       (do
                                         (assert (:values field-values)
                                                 (tru ":values must be present to fetch :human_readable_values"))
                                         (mapv human-readable-values (:values field-values)))

                                       ;; if the `:human_readable_values` key is present (i.e., if we are fetching the
                                       ;; whole row), but `nil`, then replace the `nil` value with an empty vector. The
                                       ;; client likes this better.
                                       :else
                                       [])))))
(defmethod serdes/hash-fields :model/FieldValues
  [_field-values]
  [(serdes/hydrated-hash :field)])

+----------------------------------------------------------------------------------------------------------------+ | Utils fns | +----------------------------------------------------------------------------------------------------------------+

If FieldValues have not been accessed recently they are considered inactive.

(defn inactive?
  [field-values]
  (and field-values (t/before? (:last_used_at field-values)
                               (t/minus (t/offset-date-time) active-field-values-cutoff))))

Should this field be backed by a corresponding FieldValues object?

(defn field-should-have-field-values?
  [field-or-field-id]
  (if-not (map? field-or-field-id)
    (let [field-id (u/the-id field-or-field-id)]
      (recur (or (t2/select-one ['Field :base_type :visibility_type :has_field_values] :id field-id)
                 (throw (ex-info (tru "Field {0} does not exist." field-id)
                                 {:field-id field-id, :status-code 404})))))
    (let [{base-type        :base_type
           visibility-type  :visibility_type
           has-field-values :has_field_values} field-or-field-id]
      (boolean
       (and
        (not (contains? #{:retired :sensitive :hidden :details-only} (keyword visibility-type)))
        (not (isa? (keyword base-type) :type/Temporal))
        (#{:list :auto-list} (keyword has-field-values)))))))

Like take but condition by the total length of elements. Assumes the elements are 1-tuples of values with a .toString() method. Returns a stateful transducer when no collection is provided.

;; (take-by-length 6 [["Dog"] ["Cat"] ["Duck"]]) ;; => [["Dog"] ["Cat"]]

(defn take-by-length
  ([max-length]
   (fn [rf]
     (let [current-length (volatile! 0)]
       (fn
         ([] (rf))
         ([result]
          (rf result))
         ([result input]
          (vswap! current-length + (count (str (first input))))
          (if (< @current-length max-length)
            (rf result input)
            (reduced result)))))))
  ([max-length coll]
   (lazy-seq
     (when-let [s (seq coll)]
       (let [f          (first s)
             new-length (- max-length (count (str (first f))))]
         (when-not (neg? new-length)
           (cons f (take-by-length new-length
                                   (rest s)))))))))

Field values and human readable values are lists that are zipped together. If the field values have changed, the human readable values will need to change too. This function reconstructs the human_readable_values to reflect new-values. If a new field value is found, a string version of that is used

(defn fixup-human-readable-values
  [{old-values :values, old-hrv :human_readable_values} new-values]
  (when (seq old-hrv)
    (let [orig-remappings (zipmap old-values old-hrv)]
      (map #(get orig-remappings % (str %)) new-values))))

Returns a list of pairs (or single element vectors if there are no humanreadablevalues) for the given field-values instance.

(defn field-values->pairs
  [{:keys [values human_readable_values]}]
  (if (seq human_readable_values)
    (map vector values human_readable_values)
    (map vector values)))

+----------------------------------------------------------------------------------------------------------------+ | Advanced FieldValues | +----------------------------------------------------------------------------------------------------------------+

Checks if an advanced FieldValues expired.

(defn advanced-field-values-expired?
  [fv]
  {:pre [(advanced-field-values-types (:type fv))]}
  (u.date/older-than? (:created_at fv) advanced-field-values-max-age))

Return a hash-key that will be used for sandboxed fieldvalues.

(defenterprise hash-key-for-sandbox
  metabase-enterprise.sandbox.models.params.field-values
  [_field-id]
  nil)

Return a hash-key that will be used for impersonated fieldvalues.

(defenterprise hash-key-for-impersonation
  metabase-enterprise.advanced-permissions.driver.impersonation
  [_field-id]
  nil)

OSS impl of [[hash-key-for-linked-filters]].

(defn default-hash-key-for-linked-filters
  [field-id constraints]
  (str (hash [field-id
              constraints])))

Return a hash-key that will be used for linked-filters fieldvalues.

(defenterprise hash-key-for-linked-filters
  metabase-enterprise.sandbox.models.params.field-values
  [field-id constraints]
  (default-hash-key-for-linked-filters field-id constraints))

+----------------------------------------------------------------------------------------------------------------+ | CRUD fns | +----------------------------------------------------------------------------------------------------------------+

Fetch a sequence of distinct values for field that are below the [[total-max-length]] threshold. If the values are past the threshold, this returns a subset of possible values values where the total length of all items is less than [[total-max-length]]. It also returns a has_more_values flag, has_more_values = true when the returned values list is a subset of all possible values.

;; (distinct-values (Field 1)) ;; -> {:values [[1], [2], [3]] :hasmorevalues false}

(This function provides the values that normally get saved as a Field's FieldValues. You most likely should not be using this directly in code outside of this namespace, unless it's for a very specific reason, such as certain cases where we fetch ad-hoc FieldValues for GTAP-filtered Fields.)

(defn distinct-values
  [field]
  (classloader/require 'metabase.db.metadata-queries)
  (try
    (let [distinct-values         ((resolve 'metabase.db.metadata-queries/field-distinct-values) field)
          limited-distinct-values (take-by-length *total-max-length* distinct-values)]
      {:values          limited-distinct-values
       ;; has_more_values=true means the list of values we return is a subset of all possible values.
       :has_more_values (or
                          ;; If the `distinct-values` has more elements than `limited-distinct-values`
                          ;; it means the the `distinct-values` has exceeded our [[*total-max-length*]] limits.
                          (> (count distinct-values)
                             (count limited-distinct-values))
                          ;; [[metabase.db.metadata-queries/field-distinct-values]] runs a query
                          ;; with limit = [[metabase.db.metadata-queries/absolute-max-distinct-values-limit]].
                          ;; So, if the returned `distinct-values` has length equal to that exact limit,
                          ;; we assume the returned values is just a subset of what we have in DB.
                          (= (count distinct-values)
                             @(resolve 'metabase.db.metadata-queries/absolute-max-distinct-values-limit)))})
    (catch Throwable e
      (log/error e (trs "Error fetching field values"))
      nil)))

Create or update the full FieldValues object for field. If the FieldValues object already exists, then update values for it; otherwise create a new FieldValues object with the newly fetched values. Returns whether the field values were created/updated/deleted as a result of this call.

Note that if the full FieldValues are create/updated/deleted, it'll delete all the Advanced FieldValues of the same field.

(defn create-or-update-full-field-values!
  [field & [human-readable-values]]
  (let [field-values              (t2/select-one FieldValues :field_id (u/the-id field) :type :full)
        {unwrapped-values :values
         :keys [has_more_values]} (distinct-values field)
        ;; unwrapped-values are 1-tuples, so we need to unwrap their values for storage
        values                    (map first unwrapped-values)
        field-name                (or (:name field) (:id field))]
    (cond
      ;; If this Field is marked `auto-list`, and the number of values in now over
      ;; the [[auto-list-cardinality-threshold]] or the accumulated length of all values exceeded
      ;; the [[*total-max-length*]] threshold we need to unmark it as `auto-list`. Switch it to `has_field_values` =
      ;; `nil` and delete the FieldValues; this will result in it getting a Search Widget in the UI when
      ;; `has_field_values` is automatically inferred by the [[metabase.models.field/infer-has-field-values]] hydration
      ;; function (see that namespace for more detailed discussion)
      ;;
      ;; It would be nicer if we could do this in analysis where it gets marked `:auto-list` in the first place, but
      ;; Fingerprints don't get updated regularly enough that we could detect the sudden increase in cardinality in a
      ;; way that could make this work. Thus, we are stuck doing it here :(
      (and (= :auto-list (keyword (:has_field_values field)))
           (or has_more_values
               (> (count values) auto-list-cardinality-threshold)))
      (do
        (log/info (trs "Field {0} was previously automatically set to show a list widget, but now has {1} values."
                       field-name (count values))
                  (trs "Switching Field to use a search widget instead."))
        (t2/update! 'Field (u/the-id field) {:has_field_values nil})
        (clear-field-values-for-field! field)
        ::fv-deleted)
      (and (= (:values field-values) values)
           (= (:has_more_values field-values) has_more_values))
      (do
        (log/debug (trs "FieldValues for Field {0} remain unchanged. Skipping..." field-name))
        ::fv-skipped)
      ;; if the FieldValues object already exists then update values in it
      (and field-values unwrapped-values)
      (do
       (log/debug (trs "Storing updated FieldValues for Field {0}..." field-name))
       (t2/update! FieldValues (u/the-id field-values)
                   (m/remove-vals nil?
                                  {:has_more_values       has_more_values
                                   :values                values
                                   :human_readable_values (fixup-human-readable-values field-values values)}))
       ::fv-updated)
      ;; if FieldValues object doesn't exist create one
      unwrapped-values
      (do
        (log/debug (trs "Storing FieldValues for Field {0}..." field-name))
        (t2/insert! FieldValues
                    :type :full
                    :field_id              (u/the-id field)
                    :has_more_values       has_more_values
                    :values                values
                    :human_readable_values human-readable-values)
        ::fv-created)
      ;; otherwise this Field isn't eligible, so delete any FieldValues that might exist
      :else
      (do
        (clear-field-values-for-field! field)
        ::fv-deleted))))

Create FieldValues for a Field if they should exist but don't already exist. Returns the existing or newly created FieldValues for Field. Updates :lastusedat so sync will know this is active.

(defn get-or-create-full-field-values!
  {:arglists '([field] [field human-readable-values])}
  [{field-id :id field-values :values :as field} & [human-readable-values]]
  {:pre [(integer? field-id)]}
  (when (field-should-have-field-values? field)
    (let [existing (or (not-empty field-values)
                       (t2/select-one FieldValues :field_id field-id :type :full))]
      (if (or (not existing) (inactive? existing))
        (case (create-or-update-full-field-values! field human-readable-values)
          ::fv-deleted
          nil
          ::fv-created
          (t2/select-one FieldValues :field_id field-id :type :full)
          (do
            (when existing
              (t2/update! FieldValues (:id existing) {:last_used_at :%now}))
            (t2/select-one FieldValues :field_id field-id :type :full)))
        (do
          (t2/update! FieldValues (:id existing) {:last_used_at :%now})
          existing)))))

+----------------------------------------------------------------------------------------------------------------+ | On Demand | +----------------------------------------------------------------------------------------------------------------+

Given a collection of table-ids return a map of Table ID to whether or not its Database is subject to 'On Demand' FieldValues updating. This means the FieldValues for any Fields belonging to the Database should be updated only when they are used in new Dashboard or Card parameters.

(defn- table-ids->table-id->is-on-demand?
  [table-ids]
  (let [table-ids            (set table-ids)
        table-id->db-id      (when (seq table-ids)
                               (t2/select-pk->fn :db_id 'Table :id [:in table-ids]))
        db-id->is-on-demand? (when (seq table-id->db-id)
                               (t2/select-pk->fn :is_on_demand 'Database
                                 :id [:in (set (vals table-id->db-id))]))]
    (into {} (for [table-id table-ids]
               [table-id (-> table-id table-id->db-id db-id->is-on-demand?)]))))

Update the FieldValues for any Fields with field-ids if the Field should have FieldValues and it belongs to a Database that is set to do 'On-Demand' syncing.

(defn update-field-values-for-on-demand-dbs!
  [field-ids]
  (let [fields (when (seq field-ids)
                 (filter field-should-have-field-values?
                         (t2/select ['Field :name :id :base_type :effective_type :coercion_strategy
                                     :semantic_type :visibility_type :table_id :has_field_values]
                           :id [:in field-ids])))
        table-id->is-on-demand? (table-ids->table-id->is-on-demand? (map :table_id fields))]
    (doseq [{table-id :table_id, :as field} fields]
      (when (table-id->is-on-demand? table-id)
        (log/debug
         (trs "Field {0} ''{1}'' should have FieldValues and belongs to a Database with On-Demand FieldValues updating."
                 (u/the-id field) (:name field)))
        (create-or-update-full-field-values! field)))))

+----------------------------------------------------------------------------------------------------------------+ | Serialization | +----------------------------------------------------------------------------------------------------------------+

(defmethod serdes/generate-path "FieldValues" [_ {:keys [field_id]}]
  (let [field (t2/select-one 'Field :id field_id)]
    (conj (serdes/generate-path "Field" field)
          {:model "FieldValues" :id "0"})))
(defmethod serdes/dependencies "FieldValues" [fv]
  ;; Take the path, but drop the FieldValues section at the end, to get the parent Field's path instead.
  [(pop (serdes/path fv))])
(defmethod serdes/extract-one "FieldValues" [_model-name _opts fv]
  (-> (serdes/extract-one-basics "FieldValues" fv)
      (dissoc :field_id)))
(defmethod serdes/load-xform "FieldValues" [fv]
  (let [[db schema table field :as field-ref] (map :id (pop (serdes/path fv)))
        field-ref (if field
                    field-ref
                    ;; It's too short, so no schema. Shift them over and add a nil schema.
                    [db nil schema table])]
    (-> (serdes/load-xform-basics fv)
        (assoc :field_id (serdes/*import-field-fk* field-ref))
        (update :type keyword))))
(defmethod serdes/load-find-local "FieldValues" [path]
  ;; Delegate to finding the parent Field, then look up its corresponding FieldValues.
  (let [field (serdes/load-find-local (pop path))]
    (t2/select-one FieldValues :field_id (:id field))))
(defmethod serdes/load-update! "FieldValues" [_ ingested local]
  ;; It's illegal to change the :type and :hash_key fields, and there's a pre-update check for this.
  ;; This drops those keys from the incoming FieldValues iff they match the local one. If they are actually different,
  ;; this preserves the new value so the normal error is produced.
  (let [ingested (cond-> ingested
                   (= (:type ingested)     (:type local))     (dissoc :type)
                   (= (:hash_key ingested) (:hash_key local)) (dissoc :hash_key))]
    ((get-method serdes/load-update! "") "FieldValues" ingested local)))
(def ^:private field-values-slug "___fieldvalues")
(defmethod serdes/storage-path "FieldValues" [fv _]
  ;; [path to table "fields" "field-name___fieldvalues"] since there's zero or one FieldValues per Field, and Fields
  ;; don't have their own directories.
  (let [hierarchy    (serdes/path fv)
        field        (last (drop-last hierarchy))
        table-prefix (serdes/storage-table-path-prefix (drop-last 2 hierarchy))]
    (concat table-prefix
            ["fields" (str (:id field) field-values-slug)])))
 

Logic related to humanization of table names and other identifiers, e.g. taking an identifier like my_table and returning a human-friendly one like My Table.

There are currently two implementations of humanization logic, previously three. Which implementation is used is determined by the Setting humanization-strategy. :simple, which merely replaces underscores and dashes with spaces, and :none, which predictibly is merely an identity function that does nothing to the results.

There used to also be :advanced, which was the default until enough customers complained that we first fixed it and then the fix wasn't good enough so we removed it.

(ns metabase.models.humanization
  (:require
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.util :as u]
   [metabase.util.humanization :as u.humanization]
   [metabase.util.i18n :refer [deferred-tru trs tru]]
   [metabase.util.log :as log]
   [schema.core :as s]
   [toucan2.core :as t2]))
(declare humanization-strategy)

Convert a name, such as num_toucans, to a human-readable name, such as Num Toucans. With one arg, this uses the strategy defined by the Setting humanization-strategy. With two args, you may specify a custom strategy (intended mainly for the internal implementation):

(humanization-strategy! :simple) (name->human-readable-name "cool_toucans") ;-> "Cool Toucans" ;; this is the same as: (name->human-readable-name (humanization-strategy) "cool_toucans") ;-> "Cool Toucans" ;; specifiy a different strategy: (name->human-readable-name :none "cooltoucans") ;-> "cooltoucans"

(defn name->human-readable-name
  ([s]
   (name->human-readable-name (humanization-strategy) s))
  ([strategy s]
   (u.humanization/name->human-readable-name strategy s)))

Update all non-custom display names of all instances of model (e.g. Table or Field).

(defn- re-humanize-names!
  [old-strategy model]
  (run! (fn [{id :id, internal-name :name, display-name :display_name}]
          (let [old-strategy-display-name (name->human-readable-name old-strategy internal-name)
                new-strategy-display-name (name->human-readable-name internal-name)
                custom-display-name?      (not= old-strategy-display-name display-name)]
            (when (and (not= display-name new-strategy-display-name)
                       (not custom-display-name?))
              (log/info (trs "Updating display name for {0} ''{1}'': ''{2}'' -> ''{3}''"
                             (name model) internal-name display-name new-strategy-display-name))
              (t2/update! model id
                {:display_name new-strategy-display-name}))))
        (t2/reducible-select [model :id :name :display_name])))

Update the non-custom display names of all Tables & Fields in the database using new values obtained from the (obstensibly swapped implementation of) name->human-readable-name.

(s/defn ^:private re-humanize-table-and-field-names!
  [old-strategy :- s/Keyword]
  (doseq [model ['Table 'Field]]
    (re-humanize-names! old-strategy model)))
(defn- set-humanization-strategy! [new-value]
  (let [new-strategy (keyword (or new-value :simple))]
    ;; check to make sure `new-strategy` is a valid strategy, or throw an Exception it is it not.
    (when-not (get-method u.humanization/name->human-readable-name new-strategy)
      (throw (IllegalArgumentException.
               (tru "Invalid humanization strategy ''{0}''. Valid strategies are: {1}"
                    new-strategy (keys (methods u.humanization/name->human-readable-name))))))
    (let [old-strategy (setting/get-value-of-type :keyword :humanization-strategy)]
      ;; ok, now set the new value
      (setting/set-value-of-type! :keyword :humanization-strategy new-value)
      ;; now rehumanize all the Tables and Fields using the new strategy.
      ;; TODO: Should we do this in a background thread because it is potentially slow?
      (log/info (trs "Changing Table & Field names humanization strategy from ''{0}'' to ''{1}''"
                     (name old-strategy) (name new-strategy)))
      (re-humanize-table-and-field-names! old-strategy))))
(defsetting ^{:added "0.28.0"} humanization-strategy
  (deferred-tru
    (str "To make table and field names more human-friendly, Metabase will replace dashes and underscores in them "
         "with spaces. We’ll capitalize each word while at it, so ‘last_visited_at’ will become ‘Last Visited At’."))
  :type       :keyword
  :default    :simple
  :visibility :settings-manager
  :audit      :raw-value
  :getter     (fn []
                (let [strategy (setting/get-value-of-type :keyword :humanization-strategy)
                      valid-values (set (keys (methods u.humanization/name->human-readable-name)))
                      valid-strategy? (contains? valid-values strategy)]
                  (when (not valid-strategy?) (log/warn (u/format-color :yellow "Invalid humanization strategy '%s'. Defaulting to 'simple'" strategy)))
                  (if valid-strategy? strategy :simple)))
  :setter     set-humanization-strategy!)
 
(ns metabase.models.interface
  (:require
   [buddy.core.codecs :as codecs]
   [cheshire.core :as json]
   [cheshire.generate :as json.generate]
   [clojure.core.memoize :as memoize]
   [clojure.spec.alpha :as s]
   [clojure.walk :as walk]
   [malli.core :as mc]
   [malli.error :as me]
   [metabase.db.connection :as mdb.connection]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.schema :as mbql.s]
   [metabase.models.dispatch :as models.dispatch]
   [metabase.models.json-migration :as jm]
   [metabase.plugins.classloader :as classloader]
   [metabase.util :as u]
   [metabase.util.cron :as u.cron]
   [metabase.util.encryption :as encryption]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   [metabase.util.malli.registry :as mr]
   [methodical.core :as methodical]
   [potemkin :as p]
   [taoensso.nippy :as nippy]
   [toucan2.core :as t2]
   [toucan2.model :as t2.model]
   [toucan2.protocols :as t2.protocols]
   [toucan2.tools.before-insert :as t2.before-insert]
   [toucan2.tools.hydrate :as t2.hydrate]
   [toucan2.tools.identity-query :as t2.identity-query]
   [toucan2.util :as t2.u])
  (:import
   (java.io BufferedInputStream ByteArrayInputStream DataInputStream)
   (java.sql Blob)
   (java.util.zip GZIPInputStream)
   (toucan2.instance Instance)))
(set! *warn-on-reflection* true)
#_{:clj-kondo/ignore [:deprecated-var]}
(p/import-vars
 [models.dispatch
  toucan-instance?
  InstanceOf
  InstanceOf:Schema
  instance-of?
  model
  instance])

This is dynamically bound to true when deserializing. A few pieces of the Toucan magic are undesirable for deserialization. Most notably, we don't want to generate an :entity_id, as that would lead to duplicated entities on a future deserialization.

(def ^:dynamic *deserializing?*
  false)

+----------------------------------------------------------------------------------------------------------------+ | Toucan Extensions | +----------------------------------------------------------------------------------------------------------------+

[[define-simple-hydration-method]] and [[define-batched-hydration-method]]

(s/def ::define-hydration-method
  (s/cat :fn-name       symbol?
         :hydration-key keyword?
         :docstring     string?
         :fn-tail       (s/alt :arity-1 :clojure.core.specs.alpha/params+body
                               :arity-n (s/+ (s/spec :clojure.core.specs.alpha/params+body)))))
(defonce ^:private defined-hydration-methods
  (atom {}))
(defn- define-hydration-method [hydration-type fn-name hydration-key fn-tail]
  {:pre [(#{:hydrate :batched-hydrate} hydration-type)]}
  ;; Let's be EXTRA nice and make sure there are no duplicate hydration keys!
  (let [fn-symb (symbol (str (ns-name *ns*)) (name fn-name))]
    (when-let [existing-fn-symb (get @defined-hydration-methods hydration-key)]
      (when (not= fn-symb existing-fn-symb)
        (throw (ex-info (format "Hydration key %s already exists at %s" hydration-key existing-fn-symb)
                        {:hydration-key       hydration-key
                         :existing-definition existing-fn-symb}))))
    (swap! defined-hydration-methods assoc hydration-key fn-symb))
  `(do
     (defn ~fn-name
       ~@fn-tail)
     ~(case hydration-type
        :hydrate
        `(methodical/defmethod t2.hydrate/simple-hydrate
           [:default ~hydration-key]
           [~'_model k# row#]
           (assoc row# k# (~fn-name row#)))
        :batched-hydrate
        `(methodical/defmethod t2.hydrate/batched-hydrate
           [:default ~hydration-key]
           [~'_model ~'_k rows#]
           (~fn-name rows#)))))

Define a Toucan hydration function (Toucan 1) or method (Toucan 2) to do 'simple' hydration (this function is called for each individual object that gets hydrated). This helper is in place to make the switch to Toucan 2 easier to accomplish. Toucan 2 uses multimethods instead of regular functions with :hydrate metadata. When we switch to Toucan 2, we won't need to rewrite all of our hydration methods at once -- we can just change the implementation of this function, and eventually remove it entirely.

(defmacro define-simple-hydration-method
  {:style/indent :defn}
  [fn-name hydration-key & fn-tail]
  (define-hydration-method :hydrate fn-name hydration-key fn-tail))
(s/fdef define-simple-hydration-method
  :args ::define-hydration-method
  :ret  any?)

Like [[define-simple-hydration-method]], but defines a Toucan 'batched' hydration function (Toucan 1) or method (Toucan 2). 'Batched' hydration means this function can be used to hydrate a sequence of objects in one call.

See docstring for [[define-simple-hydration-method]] for more information as to why this macro exists.

(defmacro define-batched-hydration-method
  {:style/indent :defn}
  [fn-name hydration-key & fn-tail]
  (define-hydration-method :batched-hydrate fn-name hydration-key fn-tail))
(s/fdef define-batched-hydration-method
  :args ::define-hydration-method
  :ret  any?)

+----------------------------------------------------------------------------------------------------------------+ | Toucan 2 Extensions | +----------------------------------------------------------------------------------------------------------------+ --- transforms methods

Default in function for columns given a Toucan type :json. Serializes object as JSON.

(defn json-in
  [obj]
  (if (string? obj)
    obj
    (json/generate-string obj)))
(defn- json-out [s keywordize-keys?]
  (if (string? s)
    (try
      (json/parse-string s keywordize-keys?)
      (catch Throwable e
        (log/error e "Error parsing JSON")
        s))
    s))

Default out function for columns given a Toucan type :json. Parses serialized JSON string and keywordizes keys.

(defn json-out-with-keywordization
  [obj]
  (json-out obj true))

Out function for columns given a Toucan type :json-no-keywordization. Similar to :json-out but does leaves keys as strings.

(defn json-out-without-keywordization
  [obj]
  (json-out obj false))

Transform for json.

(def transform-json
  {:in  json-in
   :out json-out-with-keywordization})

metabase-query type is for outer queries like Card.dataset_query. Normalizes them on the way in & out

(defn- maybe-normalize [query]
  (cond-> query
    (seq query) mbql.normalize/normalize))

Wraps normalization fn f and returns a version that gracefully handles Exceptions during normalization. When invalid queries (etc.) come out of the Database, it's best we handle normalization failures gracefully rather than letting the Exception cause the entire API call to fail because of one bad object. (See #8914 for more details.)

(defn catch-normalization-exceptions
  [f]
  (fn [query]
    (try
      (doall (f query))
      (catch Throwable e
        (log/error e (tru "Unable to normalize:") "\n"
                   (u/pprint-to-str 'red query))
        nil))))

Normalize parameters or parameter-mappings when coming out of the application database or in via an API request.

(defn normalize-parameters-list
  [parameters]
  (or (mbql.normalize/normalize-fragment [:parameters] parameters)
      []))

Transform for metabase-query.

(def transform-metabase-query
  {:in  (comp json-in maybe-normalize)
   :out (comp (catch-normalization-exceptions maybe-normalize) json-out-with-keywordization)})

Transform for parameters list.

(def transform-parameters-list
  {:in  (comp json-in normalize-parameters-list)
   :out (comp (catch-normalization-exceptions normalize-parameters-list) json-out-with-keywordization)})

Transform field refs

(def transform-field-ref
  {:in  json-in
   :out (comp (catch-normalization-exceptions mbql.normalize/normalize-field-ref) json-out-with-keywordization)})

Transform the Card result metadata as it comes out of the DB. Convert columns to keywords where appropriate.

(defn- result-metadata-out
  [metadata]
  ;; TODO -- can we make this whole thing a lazy seq?
  (when-let [metadata (not-empty (json-out-with-keywordization metadata))]
    (seq (map mbql.normalize/normalize-source-metadata metadata))))

Transform for card.result_metadata like columns.

(def transform-result-metadata
  {:in  json-in
   :out result-metadata-out})

Transform for keywords.

(def transform-keyword
  {:in  u/qualified-name
   :out keyword})

Transform for json-no-keywordization

(def transform-json-no-keywordization
  {:in  json-in
   :out json-out-without-keywordization})

Serialize encrypted json.

(def encrypted-json-in
  (comp encryption/maybe-encrypt json-in))

Deserialize encrypted json.

(defn encrypted-json-out
  [v]
  (let [decrypted (encryption/maybe-decrypt v)]
    (try
      (json/parse-string decrypted true)
      (catch Throwable e
        (if (or (encryption/possibly-encrypted-string? decrypted)
                (encryption/possibly-encrypted-bytes? decrypted))
          (log/error e "Could not decrypt encrypted field! Have you forgot to set MB_ENCRYPTION_SECRET_KEY?")
          (log/error e "Error parsing JSON"))  ; same message as in `json-out`
        v))))

cache the decryption/JSON parsing because it's somewhat slow (~500µs vs ~100µs on a fast computer) cache the decrypted JSON for one hour

(def ^:private cached-encrypted-json-out (memoize/ttl encrypted-json-out :ttl/threshold (* 60 60 1000)))

Transform for encrypted json.

(def transform-encrypted-json
  {:in  encrypted-json-in
   :out cached-encrypted-json-out})

Transform for encrypted text.

(def transform-encrypted-text
  {:in  encryption/maybe-encrypt
   :out encryption/maybe-decrypt})

The frontend uses JSON-serialized versions of MBQL clauses as keys in :column_settings. This normalizes them to modern MBQL clauses so things work correctly.

(defn normalize-visualization-settings
  [viz-settings]
  (letfn [(normalize-column-settings-key [k]
            (some-> k u/qualified-name json/parse-string mbql.normalize/normalize json/generate-string))
          (normalize-column-settings [column-settings]
            (into {} (for [[k v] column-settings]
                       [(normalize-column-settings-key k) (walk/keywordize-keys v)])))
          (mbql-field-clause? [form]
            (and (vector? form)
                 (#{"field-id" "fk->" "datetime-field" "joined-field" "binning-strategy" "field"
                    "aggregation" "expression"}
                  (first form))))
          (normalize-mbql-clauses [form]
            (walk/postwalk
             (fn [form]
               (cond-> form
                 (mbql-field-clause? form) mbql.normalize/normalize))
             form))]
    (cond-> (walk/keywordize-keys (dissoc viz-settings "column_settings" "graph.metrics"))
      (get viz-settings "column_settings") (assoc :column_settings (normalize-column-settings (get viz-settings "column_settings")))
      true                                 normalize-mbql-clauses
      ;; exclude graph.metrics from normalization as it may start with
      ;; the word "expression" but it is not MBQL (metabase#15882)
      (get viz-settings "graph.metrics")   (assoc :graph.metrics (get viz-settings "graph.metrics")))))
(jm/def-json-migration migrate-viz-settings*)
(def ^:private viz-settings-current-version 2)
(defmethod ^:private migrate-viz-settings* [1 2] [viz-settings _]
  (let [{percent? :pie.show_legend_perecent ;; [sic]
         legend?  :pie.show_legend} viz-settings]
    (if-let [new-value (cond
                         legend?  "inside"
                         percent? "legend")]
      (assoc viz-settings :pie.percent_visibility new-value)
      viz-settings))) ;; if nothing was explicitly set don't default to "off", let the FE deal with it

if nothing was explicitly set don't default to "off", let the FE deal with it

(defn- migrate-viz-settings
  [viz-settings]
  (let [new-viz-settings (migrate-viz-settings* viz-settings viz-settings-current-version)]
    (cond-> new-viz-settings
      (not= new-viz-settings viz-settings) (jm/update-version viz-settings-current-version))))

migrate-viz settings was introduced with v. 2, so we'll never be in a situation where we can downgrade from 2 to 1. See sample code in SHA d597b445333f681ddd7e52b2e30a431668d35da8

Transform for viz-settings.

(def transform-visualization-settings
  {:in  (comp json-in migrate-viz-settings)
   :out (comp migrate-viz-settings normalize-visualization-settings json-out-without-keywordization)})
(def ^{:arglists '([s])} ^:private validate-cron-string
  (let [validator (mc/validator u.cron/CronScheduleString)]
    (fn [s]
      (when (validator s)
        s))))

Transform for encrypted json.

(def transform-cron-string
  {:in  validate-cron-string
   :out identity})
(def ^:private MetricSegmentDefinition
  [:map
   [:filter      {:optional true} [:maybe mbql.s/Filter]]
   [:aggregation {:optional true} [:maybe [:sequential mbql.s/Aggregation]]]])
(def ^:private ^{:arglists '([definition])} validate-metric-segment-definition
  (let [explainer (mr/explainer MetricSegmentDefinition)]
    (fn [definition]
      (if-let [error (explainer definition)]
        (let [humanized (me/humanize error)]
          (throw (ex-info (tru "Invalid Metric or Segment: {0}" (pr-str humanized))
                          {:error     error
                           :humanized humanized})))
        definition))))

metric-segment-definition is, predictably, for Metric/Segment :definitions, which are just the inner MBQL query

(defn- normalize-metric-segment-definition [definition]
  (when (seq definition)
    (u/prog1 (mbql.normalize/normalize-fragment [:query] definition)
      (validate-metric-segment-definition <>))))

Transform for inner queries like those in Metric definitions.

(def transform-metric-segment-definition
  {:in  (comp json-in normalize-metric-segment-definition)
   :out (comp (catch-normalization-exceptions normalize-metric-segment-definition) json-out-with-keywordization)})
(defn- blob->bytes [^Blob b]
  (.getBytes ^Blob b 0 (.length ^Blob b)))
(defn- maybe-blob->bytes [v]
  (if (instance? Blob v)
    (blob->bytes v)
    v))

Transform for secret value.

(def transform-secret-value
  {:in  (comp encryption/maybe-encrypt-bytes codecs/to-bytes)
   :out (comp encryption/maybe-decrypt maybe-blob->bytes)})

Decompress compressed-bytes.

(defn decompress
  [compressed-bytes]
  (if (instance? Blob compressed-bytes)
    (recur (blob->bytes compressed-bytes))
    (with-open [bis     (ByteArrayInputStream. compressed-bytes)
                bif     (BufferedInputStream. bis)
                gz-in   (GZIPInputStream. bif)
                data-in (DataInputStream. gz-in)]
      (nippy/thaw-from-in! data-in))))

Transform for compressed fields.

#_{:clj-kondo/ignore [:unused-public-var]}
(def transform-compressed
  {:in identity
   :out decompress})

--- predefined hooks

Return a HoneySQL form for a SQL function call to get current moment in time. Currently this is now() for Postgres and H2 and now(6) for MySQL/MariaDB (now() for MySQL only return second resolution; now(6) uses the max (nanosecond) resolution).

(defn now
  []
  (classloader/require 'metabase.driver.sql.query-processor)
  ((resolve 'metabase.driver.sql.query-processor/current-datetime-honeysql-form) (mdb.connection/db-type)))
(defn- add-created-at-timestamp [obj & _]
  (cond-> obj
    (not (:created_at obj)) (assoc :created_at (now))))
(defn- add-updated-at-timestamp [obj]
  ;; don't stomp on `:updated_at` if it's already explicitly specified.
  (let [changes-already-include-updated-at? (if (t2/instance? obj)
                                              (:updated_at (t2/changes obj))
                                              (:updated_at obj))]
    (cond-> obj
      (not changes-already-include-updated-at?) (assoc :updated_at (now)))))
(t2/define-before-insert :hook/timestamped?
  [instance]
  (-> instance
      add-updated-at-timestamp
      add-created-at-timestamp))
(t2/define-before-update :hook/timestamped?
  [instance]
  (-> instance
      add-updated-at-timestamp))
(t2/define-before-insert :hook/created-at-timestamped?
  [instance]
  (-> instance
      add-created-at-timestamp))
(t2/define-before-insert :hook/updated-at-timestamped?
  [instance]
  (-> instance
      add-updated-at-timestamp))
(t2/define-before-update :hook/updated-at-timestamped?
  [instance]
  (-> instance
      add-updated-at-timestamp))
(defn- add-entity-id [obj & _]
  (if (or (contains? obj :entity_id)
          *deserializing?*)
    ;; Don't generate a new entity_id if either: (a) there's already one set; or (b) we're deserializing.
    ;; Generating them at deserialization time can lead to duplicated entities if they're deserialized again.
    obj
    (assoc obj :entity_id (u/generate-nano-id))))
(t2/define-before-insert :hook/entity-id
  [instance]
  (-> instance
      add-entity-id))
(methodical/prefer-method! #'t2.before-insert/before-insert :hook/timestamped? :hook/entity-id)

Returns the changes used for pre-update hooks. This is to match the input of pre-update for toucan1 methods

--- helper fns

(defn pre-update-changes
  [row]
  (t2.protocols/with-current row (merge (t2.model/primary-key-values-map row)
                                        (t2.protocols/changes row))))

Do [[toucan2.tools.after-select]] stuff for row map object using methods for modelable.

(defn do-after-select
  [modelable row-map]
  {:pre [(map? row-map)]}
  (let [model (t2/resolve-model modelable)]
    (try
      (t2/select-one model (t2.identity-query/identity-query [row-map]))
      (catch Throwable e
        (throw (ex-info (format "Error doing after-select for model %s: %s" model (ex-message e))
                        {:model model}
                        e))))))

+----------------------------------------------------------------------------------------------------------------+ | New Permissions Stuff | +----------------------------------------------------------------------------------------------------------------+

Helper dispatch function for multimethods. Dispatches on the first arg, using [[models.dispatch/model]].

(def ^{:arglists '([x & _args])} dispatch-on-model
  t2.u/dispatch-on-first-arg)

Return a set of permissions object paths that a user must have access to in order to access this object. This should be something like

#{"/db/1/schema/public/table/20/"}

read-or-write will be either :read or :write, depending on which permissions set we're fetching (these will be the same sets for most models; they can ignore this param).

(defmulti perms-objects-set
  {:arglists '([instance read-or-write])}
  dispatch-on-model)
(defmethod perms-objects-set :default
  [_instance _read-or-write]
  nil)

Return whether [[metabase.api.common/current-user]] has read permissions for an object. You should typically use one of these implementations:

  • (constantly true)
  • superuser?
  • (partial current-user-has-full-permissions? :read) (you must also implement [[perms-objects-set]] to use this)
  • (partial current-user-has-partial-permissions? :read) (you must also implement [[perms-objects-set]] to use this)
(defmulti can-read?
  {:arglists '([instance] [model pk])}
  dispatch-on-model)

Return whether [[metabase.api.common/current-user]] has write permissions for an object. You should typically use one of these implementations:

  • (constantly true)
  • superuser?
  • (partial current-user-has-full-permissions? :write) (you must also implement [[perms-objects-set]] to use this)
  • (partial current-user-has-partial-permissions? :write) (you must also implement [[perms-objects-set]] to use this)
(defmulti can-write?
  {:arglists '([instance] [model pk])}
  dispatch-on-model)
#_{:clj-kondo/ignore [:unused-private-var]}
(define-simple-hydration-method ^:private hydrate-can-write
  :can_write
  "Hydration method for `:can_write`."
  [instance]
  (can-write? instance))

NEW! Check whether or not current user is allowed to CREATE a new instance of model with properties in map m.

Because this method was added YEARS after [[can-read?]] and [[can-write?]], most models do not have an implementation for this method, and instead POST API endpoints themselves contain the appropriate permissions logic (ick). Implement this method as you come across models that are missing it.

(defmulti can-create?
  {:added "0.32.0", :arglists '([model m])}
  dispatch-on-model)
(defmethod can-create? :default
  [model _m]
  (throw
   (NoSuchMethodException.
    (str (format "%s does not yet have an implementation for [[can-create?]]. " (name model))
         "Please consider adding one. See dox for [[can-create?]] for more details."))))

NEW! Check whether or not the current user is allowed to update an object and by updating properties to values in the changes map. This is equivalent to checking whether you're allowed to perform

(toucan2.core/update! model id changes)

This method is appropriate for powering PUT API endpoints. Like [[can-create?]] this method was added YEARS after most of the current API endpoints were written, so it is used in very few places, and this logic is determined ad-hoc in the API endpoints themselves. Use this method going forward!

(defmulti can-update?
  {:added "0.36.0", :arglists '([instance changes])}
  dispatch-on-model)
(defmethod can-update? :default
  [instance _changes]
  (throw
   (NoSuchMethodException.
    (str (format "%s does not yet have an implementation for `can-update?`. " (name (models.dispatch/model instance)))
         "Please consider adding one. See dox for `can-update?` for more details."))))

Is [[metabase.api.common/current-user]] is a superuser? Ignores args. Intended for use as an implementation of [[can-read?]] and/or [[can-write?]].

(defn superuser?
  [& _]
  @(requiring-resolve 'metabase.api.common/*is-superuser?*))
(defn- current-user-permissions-set []
  @@(requiring-resolve 'metabase.api.common/*current-user-permissions-set*))
(defn- current-user-has-root-permissions? []
  (contains? (current-user-permissions-set) "/"))
(defn- check-perms-with-fn
  ([fn-symb read-or-write a-model object-id]
   (or (current-user-has-root-permissions?)
       (check-perms-with-fn fn-symb read-or-write (t2/select-one a-model (first (t2/primary-keys a-model)) object-id))))
  ([fn-symb read-or-write object]
   (and object
        (check-perms-with-fn fn-symb (perms-objects-set object read-or-write))))
  ([fn-symb perms-set]
   (let [f (requiring-resolve fn-symb)]
     (assert f)
     (u/prog1 (f (current-user-permissions-set) perms-set)
       (log/tracef "Perms check: %s -> %s" (pr-str (list fn-symb (current-user-permissions-set) perms-set)) <>)))))

Implementation of [[can-read?]]/[[can-write?]] for the old permissions system. true if the current user has full permissions for the paths returned by its implementation of [[perms-objects-set]]. (read-or-write is either :read or :write and passed to [[perms-objects-set]]; you'll usually want to partially bind it in the implementation map).

(def ^{:arglists '([read-or-write model object-id] [read-or-write object] [perms-set])}
  current-user-has-full-permissions?
  (partial check-perms-with-fn 'metabase.models.permissions/set-has-full-permissions-for-set?))

Implementation of [[can-read?]]/[[can-write?]] for the old permissions system. true if the current user has partial permissions for the paths returned by its implementation of [[perms-objects-set]]. (read-or-write is either :read or :write and passed to [[perms-objects-set]]; you'll usually want to partially bind it in the implementation map).

(def ^{:arglists '([read-or-write model object-id] [read-or-write object] [perms-set])}
  current-user-has-partial-permissions?
  (partial check-perms-with-fn 'metabase.models.permissions/set-has-partial-permissions-for-set?))
(defmethod can-read? ::read-policy.always-allow
  ([_instance]
   true)
  ([_model _pk]
   true))
(defmethod can-write? ::write-policy.always-allow
  ([_instance]
   true)
  ([_model _pk]
   true))
(defmethod can-read? ::read-policy.partial-perms-for-perms-set
  ([instance]
   (current-user-has-partial-permissions? :read instance))
  ([model pk]
   (current-user-has-partial-permissions? :read model pk)))
(defmethod can-read? ::read-policy.full-perms-for-perms-set
  ([instance]
   (current-user-has-full-permissions? :read instance))
  ([model pk]
   (current-user-has-full-permissions? :read model pk)))
(defmethod can-write? ::write-policy.partial-perms-for-perms-set
  ([instance]
   (current-user-has-partial-permissions? :write instance))
  ([model pk]
   (current-user-has-partial-permissions? :write model pk)))
(defmethod can-write? ::write-policy.full-perms-for-perms-set
  ([instance]
   (current-user-has-full-permissions? :write instance))
  ([model pk]
   (current-user-has-full-permissions? :write model pk)))
(defmethod can-read? ::read-policy.superuser
  ([_instance]
   (superuser?))
  ([_model _pk]
   (superuser?)))
(defmethod can-write? ::write-policy.superuser
  ([_instance]
   (superuser?))
  ([_model _pk]
   (superuser?)))
(defmethod can-create? ::create-policy.superuser
  [_model _m]
  (superuser?))

[[to-json]]

Serialize an instance to JSON.

(methodical/defmulti to-json
  {:arglists            '([instance json-generator])
   :defmethod-arities   #{2}
   :dispatch-value-spec (some-fn keyword? symbol?)} ; dispatch value should be either keyword model name or symbol
  t2.u/dispatch-on-first-arg)
(methodical/defmethod to-json :default
  "Default method for encoding instances of a Toucan model to JSON."
  [instance json-generator]
  (json.generate/encode-map instance json-generator))
(json.generate/add-encoder
 Instance
 #'to-json)

etc

Trigger errors when hydrate encounters a key that has no corresponding method defined.

(reset! t2.hydrate/global-error-on-unknown-key true)
(methodical/defmethod t2.hydrate/fk-keys-for-automagic-hydration :default
  "In Metabase the FK key used for automagic hydration should use underscores (work around upstream Toucan 2 issue)."
  [_original-model dest-key _hydrated-key]
  [(u/->snake_case_en (keyword (str (name dest-key) "_id")))])
 
(ns metabase.models.json-migration)

Set the updated version if the column-value has data. Doesn't do anything if it's empty since empty values are assumed to result in version-appropriate default behavior and don't need an explicit version key.

(defn update-version
  [column-value desired-version]
  (if (seq column-value)
    (assoc column-value :version desired-version)
    column-value))

Create a multi-method with the given name that will perform JSON migrations. Individual cases (with appropriate logic!) must be defined by the user. The resulting multi-method accepts two arguments: the value of the column and the desired version. Versioning is assumed to start at 1 and be stored in the JSON blob under the :version key (and no version at all is assumed to be 1 as well). Updating the version is not handled here; in practice you should probably chain the migration method together with update-version (defined above). Non-upgrades (e.g., upgrading a value from version 2 to version 2) are handled and treated as a no-op.

For example, imagine a User model with a JSON column called login_settings. This originally contained a boolean key remember_me that persisted a session for 30 days, but the number of days is now configurable per user. The migration code would look like this:

(def login-settings-version 2)

(def-json-migration migrate-login-settings*)

(defmethod migrate-login-settings* [1 2] [login-settings _version]
  (assoc login-settings :remember_me_days (if (:remember_me login-settings) 30 0)))

(defn migrate-login-settings
  [login-settings] ;; note that this only takes the one argument, not two
  (-> login-settings
      (migrate-login-settings* login-settings-version)
      (update-version login-settings-version)))

(migrate-login-settings {:remember_me true})                 ;; => {:remember_me_days 30, :version 2, :remember_me true}
(migrate-login-settings {:remember_me false})                ;; => {:remember_me_days 0,  :version 2, :remember_me false}
(migrate-login-settings {:remember_me true, :version 1})     ;; => {:remember_me_days 30, :version 2, :remember_me true}
(migrate-login-settings {:remember_me_days 15, :version 2})  ;; => {:remember_me_days 15, :version 2}
(defmacro def-json-migration
  [name]
  (let [name* name]
    `(do
       (defmulti ^:private ~name*
         "Migrate the column value to the appropriate version."
         {:arglists '([~'column-value ~'desired-version])}
         (fn [~'column-value ~'desired-version]
           (let [~'current-version (or (get ~'column-value :version) 1)]
             (if (= ~'current-version ~'desired-version)
               ::identity
               [~'current-version ~'desired-version]))))
       (defmethod ^:private ~name* ::identity [~'column-value ~'_]
         ~'column-value))))
 
(ns metabase.models.login-history
  (:require
   [java-time.api :as t]
   [metabase.email.messages :as messages]
   [metabase.models.setting :refer [defsetting]]
   [metabase.server.request.util :as request.u]
   [metabase.util.date-2 :as u.date]
   [metabase.util.i18n :as i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [methodical.core :as methodical]
   [toucan2.connection :as t2.conn]
   [toucan2.core :as t2]
   [toucan2.realize :as t2.realize]))
(set! *warn-on-reflection* true)
(defn- timezone-display-name [^java.time.ZoneId zone-id]
  (when zone-id
    (.getDisplayName zone-id
                     java.time.format.TextStyle/SHORT_STANDALONE
                     (i18n/user-locale))))

Return human-friendly versions of the info in one or more LoginHistory instances. Powers the login history API endpoint and login on new device email.

This can potentially take a few seconds to complete, if the request to geocode the API request hangs for one reason or another -- keep that in mind when using this.

(defn human-friendly-infos
  [history-items]
  (let [ip-addresses (map :ip_address history-items)
        ip->info     (request.u/geocode-ip-addresses ip-addresses)]
    (for [history-item history-items
          :let         [{location-description :description, timezone :timezone} (get ip->info (:ip_address history-item))]]
      (-> history-item
          (assoc :location location-description
                 :timezone (timezone-display-name timezone))
          (update :timestamp (fn [timestamp]
                               (if (and timestamp timezone)
                                 (t/zoned-date-time (u.date/with-time-zone-same-instant timestamp timezone) timezone)
                                 timestamp)))
          (update :device_description request.u/describe-user-agent)))))

Should we send users a notification email the first time they log in from a new device? (Default: true). This is currently only configurable via environment variable so users who gain access to an admin's credentials cannot disable this Setting and access their account without them knowing.

(defsetting send-email-on-first-login-from-new-device
  ;; no need to i18n -- this isn't user-facing
  :type       :boolean
  :visibility :internal
  :setter     :none
  :default    true)

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase.

(def LoginHistory
  :model/LoginHistory)
(methodical/defmethod t2/table-name :model/LoginHistory [_model] :login_history)
(doto :model/LoginHistory
  (derive :metabase/model))
(t2/define-after-select :model/LoginHistory
  [{session-id :session_id, :as login-history}]
  ;; session ID is sensitive, so it's better if we don't even return it. Replace it with a more generic `active` key.
  (cond-> (t2.realize/realize login-history)
    (contains? login-history :session_id) (assoc :active (boolean session-id))
    true                                  (dissoc :session_id)))
(defn- first-login-ever? [{user-id :user_id}]
  (some-> (t2/select [LoginHistory :id] :user_id user-id {:limit 2})
          count
          (= 1)))
(defn- first-login-on-this-device? [{user-id :user_id, device-id :device_id}]
  (some-> (t2/select [LoginHistory :id] :user_id user-id, :device_id device-id, {:limit 2})
          count
          (= 1)))

If set to send emails on first login from new devices, that is the case, and its not the users first login, send an email from a separate thread.

(defn- maybe-send-login-from-new-device-email
  [login-history]
  (when (and (send-email-on-first-login-from-new-device)
             (first-login-on-this-device? login-history)
             (not (first-login-ever? login-history)))
    ;; if there's an existing open connection (and there seems to be one, but I'm not 100% sure why) we can't try to use
    ;; it across threads since it can close at any moment! So unbind it so the future can get its own thread.
    (binding [t2.conn/*current-connectable* nil]
      (future
        ;; off thread for both IP lookup and email sending. Either one could block and slow down user login (#16169)
        (try
          (let [[info] (human-friendly-infos [login-history])]
            (messages/send-login-from-new-device-email! info))
          (catch Throwable e
            (log/error e (trs "Error sending ''login from new device'' notification email"))))))))
(t2/define-after-insert :model/LoginHistory
  [login-history]
  (maybe-send-login-from-new-device-email login-history)
  login-history)
(t2/define-before-update :model/LoginHistory [_login-history]
  (throw (RuntimeException. (tru "You can''t update a LoginHistory after it has been created."))))
 

A Metric is a saved MBQL 'macro' expanding to a combination of :aggregation and/or :filter clauses. It is passed in as an :aggregation clause but is replaced by the expand-macros middleware with the appropriate clauses.

(ns metabase.models.metric
  (:require
   [clojure.set :as set]
   [medley.core :as m]
   [metabase.lib.core :as lib]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.jvm :as lib.metadata.jvm]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.lib.query :as lib.query]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.audit-log :as audit-log]
   [metabase.models.interface :as mi]
   [metabase.models.revision :as revision]
   [metabase.models.serialization :as serdes]
   [metabase.models.table :as table]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [methodical.core :as methodical]
   [toucan2.core :as t2]
   [toucan2.tools.hydrate :as t2.hydrate]))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase.

(def Metric
  :model/Metric)
(methodical/defmethod t2/table-name :model/Metric [_model] :metric)
(doto :model/Metric
  (derive :metabase/model)
  (derive :hook/timestamped?)
  (derive :hook/entity-id)
  (derive ::mi/read-policy.full-perms-for-perms-set)
  (derive ::mi/write-policy.superuser)
  (derive ::mi/create-policy.superuser))
(t2/deftransforms :model/Metric
  {:definition mi/transform-metric-segment-definition})
(t2/define-before-update :model/Metric
  [{:keys [creator_id id], :as metric}]
  (u/prog1 (t2/changes metric)
    ;; throw an Exception if someone tries to update creator_id
    (when (contains? <> :creator_id)
      (when (not= (:creator_id <>) (t2/select-one-fn :creator_id Metric :id id))
        (throw (UnsupportedOperationException. (tru "You cannot update the creator_id of a Metric.")))))))
(t2/define-before-delete :model/Metric
  [{:keys [id] :as _metric}]
  (t2/delete! :model/Revision :model "Metric" :model_id id))
(defmethod mi/perms-objects-set Metric
  [metric read-or-write]
  (let [table (or (:table metric)
                  (t2/select-one ['Table :db_id :schema :id] :id (u/the-id (:table_id metric))))]
    (mi/perms-objects-set table read-or-write)))
(mu/defn ^:private definition-description :- [:maybe ::lib.schema.common/non-blank-string]
  "Calculate a nice description of a Metric's definition."
  [metadata-provider :- lib.metadata/MetadataProvider
   {:keys [definition], table-id :table_id, :as _metric} :- (ms/InstanceOf :model/Metric)]
  (when (seq definition)
    (try
      (let [database-id (u/the-id (lib.metadata.protocols/database metadata-provider))
            definition  (merge {:source-table table-id}
                               definition)
            query       (lib.query/query-from-legacy-inner-query metadata-provider database-id definition)]
        (lib/describe-query query))
      (catch Throwable e
        (log/error e (tru "Error calculating Metric description: {0}" (ex-message e)))
        nil))))
(mu/defn ^:private warmed-metadata-provider :- lib.metadata/MetadataProvider
  [database-id :- ::lib.schema.id/database
   metrics     :- [:maybe [:sequential (ms/InstanceOf :model/Metric)]]]
  (let [metadata-provider (doto (lib.metadata.jvm/application-database-metadata-provider database-id)
                            (lib.metadata.protocols/store-metadatas!
                             :metadata/metric
                             (map #(lib.metadata.jvm/instance->metadata % :metadata/metric)
                                  metrics)))
        segment-ids       (into #{} (mbql.u/match (map :definition metrics)
                                      [:segment (id :guard integer?) & _]
                                      id))
        segments          (lib.metadata.protocols/bulk-metadata metadata-provider :metadata/segment segment-ids)
        field-ids         (mbql.u/referenced-field-ids (into []
                                                             (comp cat (map :definition))
                                                             [metrics segments]))
        fields            (lib.metadata.protocols/bulk-metadata metadata-provider :metadata/column field-ids)
        table-ids         (into #{}
                                cat
                                [(map :table-id fields)
                                 (map :table-id segments)
                                 (map :table_id metrics)])]
    ;; this is done for side-effects
    (lib.metadata.protocols/bulk-metadata metadata-provider :metadata/table table-ids)
    metadata-provider))
(mu/defn ^:private metrics->table-id->warmed-metadata-provider :- fn?
  [metrics :- [:maybe [:sequential (ms/InstanceOf :model/Metric)]]]
  (let [table-id->db-id             (when-let [table-ids (not-empty (into #{} (map :table_id metrics)))]
                                      (t2/select-pk->fn :db_id :model/Table :id [:in table-ids]))
        db-id->metadata-provider    (memoize
                                     (mu/fn db-id->warmed-metadata-provider :- lib.metadata/MetadataProvider
                                       [database-id :- ::lib.schema.id/database]
                                       (let [metrics-for-db (filter (fn [metric]
                                                                      (= (table-id->db-id (:table_id metric))
                                                                         database-id))
                                                                    metrics)]
                                         (warmed-metadata-provider database-id metrics-for-db))))]
    (mu/fn table-id->warmed-metadata-provider :- lib.metadata/MetadataProvider
      [table-id :- ::lib.schema.id/table]
      (-> table-id table-id->db-id db-id->metadata-provider))))
(methodical/defmethod t2.hydrate/batched-hydrate [Metric :definition_description]
  [_model _key metrics]
  (let [table-id->warmed-metadata-provider (metrics->table-id->warmed-metadata-provider metrics)]
    (for [metric metrics
          :let    [metadata-provider (table-id->warmed-metadata-provider (:table_id metric))]]
      (assoc metric :definition_description (definition-description metadata-provider metric)))))

--------------------------------------------------- REVISIONS ----------------------------------------------------

(defmethod revision/serialize-instance Metric
  [_model _id instance]
  (dissoc instance :created_at :updated_at))
(defmethod revision/diff-map Metric
  [model metric1 metric2]
  (if-not metric1
    ;; model is the first version of the metric
    (m/map-vals (fn [v] {:after v}) (select-keys metric2 [:name :description :definition]))
    ;; do our diff logic
    (let [base-diff ((get-method revision/diff-map :default)
                     model
                     (select-keys metric1 [:name :description :definition])
                     (select-keys metric2 [:name :description :definition]))]
      (cond-> (merge-with merge
                          (m/map-vals (fn [v] {:after v}) (:after base-diff))
                          (m/map-vals (fn [v] {:before v}) (:before base-diff)))
        (or (get-in base-diff [:after :definition])
            (get-in base-diff [:before :definition])) (assoc :definition {:before (get metric1 :definition)
                                                                          :after  (get metric2 :definition)})))))

------------------------------------------------- SERIALIZATION --------------------------------------------------

(defmethod serdes/hash-fields Metric
  [_metric]
  [:name (serdes/hydrated-hash :table) :created_at])
(defmethod serdes/extract-one "Metric"
  [_model-name _opts metric]
  (-> (serdes/extract-one-basics "Metric" metric)
      (update :table_id   serdes/*export-table-fk*)
      (update :creator_id serdes/*export-user*)
      (update :definition serdes/export-mbql)))
(defmethod serdes/load-xform "Metric" [metric]
  (-> metric
      serdes/load-xform-basics
      (update :table_id   serdes/*import-table-fk*)
      (update :creator_id serdes/*import-user*)
      (update :definition serdes/import-mbql)))
(defmethod serdes/dependencies "Metric" [{:keys [definition table_id]}]
  (into [] (set/union #{(serdes/table->path table_id)}
                      (serdes/mbql-deps definition))))
(defmethod serdes/storage-path "Metric" [metric _ctx]
  (let [{:keys [id label]} (-> metric serdes/path last)]
    (-> metric
        :table_id
        serdes/table->path
        serdes/storage-table-path-prefix
        (concat ["metrics" (serdes/storage-leaf-file-name id label)]))))

------------------------------------------------ Audit Log --------------------------------------------------------

(defmethod audit-log/model-details :model/Metric
  [metric _event-type]
  (let [table-id (:table_id metric)
        db-id    (table/table-id->database-id table-id)]
    (assoc
     (select-keys metric [:name :description :revision_message])
     :table_id    table-id
     :database_id db-id)))
 

Intersection table for Metric and Field; this is used to keep track of the top 0-3 important fields for a metric as shown in the Getting Started guide.

(ns metabase.models.metric-important-field
  (:require
   [metabase.models.interface :as mi]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase.

(def MetricImportantField
  :model/MetricImportantField)
(methodical/defmethod t2/table-name :model/MetricImportantField [_model] :metric_important_field)
(doto :model/MetricImportantField
  (derive :metabase/model)
  (derive ::mi/read-policy.always-allow)
  (derive ::mi/write-policy.superuser))
(t2/deftransforms :model/MetricImportantField
 {:definition mi/transform-json})
 
(ns metabase.models.model-index
  (:require
   [clojure.set :as set]
   [clojure.string :as str]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.schema :as mbql.s]
   [metabase.models.card :refer [Card]]
   [metabase.models.interface :as mi]
   [metabase.query-processor :as qp]
   [metabase.sync.schedules :as sync.schedules]
   [metabase.util.cron :as u.cron]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

model lifecycle ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all the ModelIndex symbol in our codebase.

(def ModelIndex
  :model/ModelIndex)

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all the ModelIndexValue symbol in our codebase.

(def ModelIndexValue
  :model/ModelIndexValue)
(methodical/defmethod t2/table-name :model/ModelIndex [_model] :model_index)
(methodical/defmethod t2/table-name :model/ModelIndexValue [_model] :model_index_value)
(derive :model/ModelIndex :metabase/model)
(derive :model/ModelIndexValue :metabase/model)
(derive :model/ModelIndex :hook/created-at-timestamped?)
(t2/deftransforms ModelIndex
  {:pk_ref    mi/transform-field-ref
   :value_ref mi/transform-field-ref})
(t2/define-before-delete ModelIndex
  [model-index]
  (let [remove-refresh-job (requiring-resolve 'metabase.task.index-values/remove-indexing-job)]
    (remove-refresh-job model-index)))

Maximum number of values we will index. Actually take one more than this to test if there are more than the threshold.

(def max-indexed-values
  5000)

indexing functions

Filter function for valid tuples for indexing: an id and a value.

(defn valid-tuples?
  [[id v]] (and id v))
(mu/defn ^:private fix-expression-refs :- mbql.s/Field
  "Convert expression ref into a field ref.
Expression refs (`[:expression \"full-name\"]`) are how the _query_ refers to a custom column. But nested queries
don't, (and shouldn't) care that those are expressions. They are just another field. The field type is always
`:type/Text` enforced by the endpoint to create model indexes."
  [field-ref :- mbql.s/Field]
  (case (first field-ref)
    :field field-ref
    :expression (let [[_ expression-name] field-ref]
                  ;; api validated that this is a text field when the model-index was created. When selecting the
                  ;; expression we treat it as a field.
                  [:field expression-name {:base-type :type/Text}])
    (throw (ex-info (trs "Invalid field ref for indexing: {0}" field-ref)
                    {:field-ref field-ref
                     :valid-clauses [:field :expression]}))))
(defn- fetch-values
  [model-index]
  (let [model     (t2/select-one Card :id (:model_id model-index))
        value-ref (-> model-index
                      :value_ref
                      mbql.normalize/normalize-field-ref
                      fix-expression-refs)]
    (try [nil (->> (qp/process-query
                    {:database (:database_id model)
                     :type     :query
                     :query    {:source-table (format "card__%d" (:id model))
                                :breakout     [(:pk_ref model-index) value-ref]
                                :limit        (inc max-indexed-values)}})
                   :data :rows (filter valid-tuples?))]
         (catch Exception e
           (log/warn (trs "Error fetching indexed values for model {0}" (:id model)) e)
           [(ex-message e) []]))))

Find additions and deletions in indexed values. source-values are from the db, indexed-values are what we currently have indexed.

We have to identity values no longer in the set, values that must be added to the index, and primary keys which now have a different value. Updates will come out as a deletion and an addition. In the future we could make these an update if desired.

(defn find-changes
  [{:keys [current-index source-values]}]
  (let [current (set current-index)
        ;; into {} to ensure that each id appears only once. Later values "win".
        source  (set (into {} source-values))]
    {:additions (set/difference source current)
     :deletions (set/difference current source)}))

Add indexed values to the modelindexvalue table.

(defn add-values!
  [model-index]
  (let [[error-message values-to-index] (fetch-values model-index)
        current-index-values               (into #{}
                                                 (map (juxt :model_pk :name))
                                                 (t2/select ModelIndexValue
                                                            :model_index_id (:id model-index)))]
    (if-not (str/blank? error-message)
      (t2/update! ModelIndex (:id model-index) {:state           "error"
                                                :error           error-message
                                                :indexed_at :%now})
      (try
        (t2/with-transaction [_conn]
          (let [{:keys [additions deletions]} (find-changes {:current-index current-index-values
                                                             :source-values values-to-index})]
            (when (seq deletions)
              (t2/delete! ModelIndexValue
                          :model_index_id (:id model-index)
                          :pk_ref [:in (->> deletions (map first))]))
            (when (seq additions)
              (t2/insert! ModelIndexValue
                          (map (fn [[id v]]
                                 {:name           v
                                  :model_pk       id
                                  :model_index_id (:id model-index)})
                               additions))))
          (t2/update! ModelIndex (:id model-index)
                      {:indexed_at :%now
                       :state           (if (> (count values-to-index) max-indexed-values)
                                          "overflow"
                                          "indexed")}))
        (catch Exception e
          (t2/update! ModelIndex (:id model-index)
                      {:state           "error"
                       :error           (ex-message e)
                       :indexed_at :%now}))))))

creation

Default sync schedule for indexed values. Defaults to randomly once a day.

(defn default-schedule
  []
  (u.cron/schedule-map->cron-string (sync.schedules/randomly-once-a-day)))

Create a model index

(defn create
  [{:keys [model-id pk-ref value-ref creator-id]}]
  (first (t2/insert-returning-instances! ModelIndex
                                         [{:model_id   model-id
                                           ;; todo: sanitize these?
                                           :pk_ref     pk-ref
                                           :value_ref  value-ref
                                           :schedule   (default-schedule)
                                           :state      "initial"
                                           :creator_id creator-id}])))
 

TODO -- this should be moved to metabase-enterprise.content-verification.models.moderation-review since it's a premium-only model.

(ns metabase.models.moderation-review
  (:require
   [metabase.db.query :as mdb.query]
   [metabase.models.interface :as mi]
   [metabase.models.permissions :as perms]
   [metabase.moderation :as moderation]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [methodical.core :as methodical]
   [schema.core :as s]
   [toucan2.core :as t2]))

Schema enum of the acceptable values for the status column

(def statuses
  #{"verified" nil})

Schema of valid statuses

(def Statuses
  [:maybe (into [:enum] statuses)])

Schema for a ModerationReview that's being updated (so most keys are optional)

currently unused, but I'm leaving this in commented out because it serves as documentation

(comment
  (def ReviewChanges
    {(s/optional-key :id)                  mu/IntGreaterThanZero
     (s/optional-key :moderated_item_id)   mu/IntGreaterThanZero
     (s/optional-key :moderated_item_type) moderation/moderated-item-types
     (s/optional-key :status)              Statuses
     (s/optional-key :text)                [:maybe :string]
     s/Any                                 :any}))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase.

(def ModerationReview
  :model/ModerationReview)
(methodical/defmethod t2/table-name :model/ModerationReview [_model] :moderation_review)
(doto :model/ModerationReview
  (derive :metabase/model)
  ;;; TODO: this is wrong, but what should it be?
  (derive ::perms/use-parent-collection-perms)
  (derive :hook/timestamped?))
(t2/deftransforms :model/ModerationReview
  {:moderated_item_type mi/transform-keyword})

The amount of moderation reviews we will keep on hand.

(def max-moderation-reviews
  10)

Delete extra reviews to maintain an invariant of only max-moderation-reviews. Called before inserting so actuall insures there are one fewer than that so you can add afterwards.

(s/defn delete-extra-reviews!
  [item-id :- s/Int item-type :- s/Str]
  (let [ids (into #{} (comp (map :id)
                            (drop (dec max-moderation-reviews)))
                  (mdb.query/query {:select   [:id]
                                    :from     [:moderation_review]
                                    :where    [:and
                                               [:= :moderated_item_id item-id]
                                               [:= :moderated_item_type item-type]]
                                    ;; cannot put the offset in this query as mysql doesnt place nice. It requires a limit
                                    ;; as well which we do not want to give. The offset is only 10 though so its not a huge
                                    ;; savings and we run this on every entry so the max number is 10, delete the extra,
                                    ;; and insert a new one to arrive at 10 again, our invariant.
                                    :order-by [[:id :desc]]}))]
    (when (seq ids)
      (t2/delete! ModerationReview :id [:in ids]))))

Create a new ModerationReview

(mu/defn create-review!
  [params :-
   [:map
    [:moderated_item_id       ms/PositiveInt]
    [:moderated_item_type     moderation/moderated-item-types]
    [:moderator_id            ms/PositiveInt]
    [:status              {:optional true} Statuses]
    [:text                {:optional true} [:maybe :string]]]]
  (t2/with-transaction [_conn]
   (delete-extra-reviews! (:moderated_item_id params) (:moderated_item_type params))
   (t2/update! ModerationReview {:moderated_item_id   (:moderated_item_id params)
                                 :moderated_item_type (:moderated_item_type params)}
               {:most_recent false})
   (first (t2/insert-returning-instances! ModerationReview (assoc params :most_recent true)))))
 
(ns metabase.models.native-query-snippet
  (:require
   [medley.core :as m]
   [metabase.models.collection :as collection]
   [metabase.models.interface :as mi]
   [metabase.models.native-query-snippet.permissions :as snippet.perms]
   [metabase.models.serialization :as serdes]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru tru]]
   [metabase.util.malli :as mu]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

----------------------------------------------- Entity & Lifecycle -----------------------------------------------

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase.

(def NativeQuerySnippet
  :model/NativeQuerySnippet)
(methodical/defmethod t2/table-name :model/NativeQuerySnippet [_model] :native_query_snippet)
(doto :model/NativeQuerySnippet
  (derive :metabase/model)
  (derive :hook/timestamped?)
  (derive :hook/entity-id))
(defmethod collection/allowed-namespaces :model/NativeQuerySnippet
  [_]
  #{:snippets})
(t2/define-before-insert :model/NativeQuerySnippet [snippet]
  (u/prog1 snippet
    (collection/check-collection-namespace NativeQuerySnippet (:collection_id snippet))))
(t2/define-before-update :model/NativeQuerySnippet
  [{:keys [creator_id id], :as snippet}]
  (u/prog1 (t2/changes snippet)
    ;; throw an Exception if someone tries to update creator_id
    (when (contains? <> :creator_id)
      (when (not= (:creator_id <>) (t2/select-one-fn :creator_id NativeQuerySnippet :id id))
        (throw (UnsupportedOperationException. (tru "You cannot update the creator_id of a NativeQuerySnippet.")))))
    (collection/check-collection-namespace NativeQuerySnippet (:collection_id snippet))))
(defmethod serdes/hash-fields NativeQuerySnippet
  [_snippet]
  [:name (serdes/hydrated-hash :collection) :created_at])
(defmethod mi/can-read? NativeQuerySnippet
  [& args]
  (apply snippet.perms/can-read? args))
(defmethod mi/can-write? NativeQuerySnippet
  [& args]
  (apply snippet.perms/can-write? args))
(defmethod mi/can-create? NativeQuerySnippet
  [& args]
  (apply snippet.perms/can-create? args))
(defmethod mi/can-update? NativeQuerySnippet
  [& args]
  (apply snippet.perms/can-update? args))

---------------------------------------------------- Schemas -----------------------------------------------------

Schema checking that snippet names do not include "}" or start with spaces.

(def NativeQuerySnippetName
  (mu/with-api-error-message
    [:fn (fn [x]
           ((every-pred
             string?
             (complement #(boolean (re-find #"^\s+" %)))
             (complement #(boolean (re-find #"}" %))))
            x))]
    (deferred-tru "snippet names cannot include '}' or start with spaces")))

------------------------------------------------- Serialization --------------------------------------------------

(defmethod serdes/extract-query "NativeQuerySnippet" [_ opts]
  (serdes/extract-query-collections NativeQuerySnippet opts))
(defmethod serdes/extract-one "NativeQuerySnippet"
  [_model-name _opts snippet]
  (-> (serdes/extract-one-basics "NativeQuerySnippet" snippet)
      (update :creator_id serdes/*export-user*)
      (m/update-existing :collection_id #(serdes/*export-fk* % 'Collection))))
(defmethod serdes/load-xform "NativeQuerySnippet" [snippet]
  (-> snippet
      serdes/load-xform-basics
      (update :creator_id serdes/*import-user*)
      (m/update-existing :collection_id #(serdes/*import-fk* % 'Collection))))
(defmethod serdes/dependencies "NativeQuerySnippet"
  [{:keys [collection_id]}]
  (if collection_id
    [[{:model "Collection" :id collection_id}]]
    []))
(defmethod serdes/storage-path "NativeQuerySnippet" [snippet ctx]
  ;; Intended path here is ["snippets" "<nested ... collections>" "<snippet_eid_and_slug>"]
  ;; We just the default path, then pull it apart.
  ;; The default is ["collections" "<nested ... collections>" "nativequerysnippets" "<base_name>"]
  (let [basis  (serdes/storage-default-collection-path snippet ctx)
        file   (last basis)
        colls  (->> basis rest (drop-last 2))] ; Drops the "collections" at the start, and the last two.
    (concat ["snippets"] colls [file])))
(defmethod serdes/load-one! "NativeQuerySnippet" [ingested maybe-local]
  ;; if we got local snippet in db and it has same name as incoming one, we can be sure
  ;; there will be no conflicts and skip the query to the db
  (if (and (not= (:name ingested) (:name maybe-local))
           (t2/exists? :model/NativeQuerySnippet
                       :name (:name ingested) :entity_id [:!= (:entity_id ingested)]))
    (recur (update ingested :name str " (copy)")
           maybe-local)
    (serdes/default-load-one! ingested maybe-local)))
 

NativeQuerySnippets have different permissions implementations. In Metabase CE, anyone can read/edit/create all NativeQuerySnippets if they have native query perms for at least one database. EE has a more advanced implementation.

(ns metabase.models.native-query-snippet.permissions
  (:require
   [metabase.api.common :as api]
   [metabase.models.permissions :as perms]
   [metabase.public-settings.premium-features :refer [defenterprise]]))

Checks whether the current user has native query permissions for any database.

(defn has-any-native-permissions?
  []
  (perms/set-has-any-native-query-permissions? @api/*current-user-permissions-set*))

Can the current User read this snippet?

(defenterprise can-read?
  metabase-enterprise.snippet-collections.models.native-query-snippet.permissions
  ([_]
   (has-any-native-permissions?))
  ([_ _]
   (has-any-native-permissions?)))

Can the current User edit this snippet?

(defenterprise can-write?
  metabase-enterprise.snippet-collections.models.native-query-snippet.permissions
  ([_]
   (has-any-native-permissions?))
  ([_ _]
   (has-any-native-permissions?)))

Can the current User save a new Snippet with the values in m?

(defenterprise can-create?
  metabase-enterprise.snippet-collections.models.native-query-snippet.permissions
  [_ _]
  (has-any-native-permissions?))

Can the current User apply a map of changes to a snippet?

(defenterprise can-update?
  metabase-enterprise.snippet-collections.models.native-query-snippet.permissions
  [_ _]
  (has-any-native-permissions?))
 
(ns metabase.models.parameter-card
  (:require
   [metabase.models.interface :as mi]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase.

----------------------------------------------- Entity & Lifecycle -----------------------------------------------

(def ParameterCard
  :model/ParameterCard)
(methodical/defmethod t2/table-name :model/ParameterCard [_model] :parameter_card)
(doto :model/ParameterCard
  (derive :metabase/model)
  (derive :hook/timestamped?))
(t2/deftransforms :model/ParameterCard
 {:parameterized_object_type mi/transform-keyword})

Set of valid parameterizedobjecttype for a ParameterCard

(defonce 
  valid-parameterized-object-type #{"dashboard" "card"})
(defn- validate-parameterized-object-type
  [{:keys [parameterized_object_type] :as _parameter-card}]
  (when-not (valid-parameterized-object-type parameterized_object_type)
    (throw (ex-info (tru "invalid parameterized_object_type")
                    {:allowed-types valid-parameterized-object-type}))))
(t2/define-before-insert :model/ParameterCard
  [pc]
  (u/prog1 pc
    (validate-parameterized-object-type pc)))
(t2/define-before-update :model/ParameterCard
  [pc]
  (u/prog1 (t2/changes pc)
    (when (:parameterized_object_type <>)
      (validate-parameterized-object-type <>))))

Delete all ParameterCard for a give Parameterized Object and NOT listed in the optional parameter-ids-still-in-use.

(defn delete-all-for-parameterized-object!
  ([parameterized-object-type parameterized-object-id]
   (delete-all-for-parameterized-object! parameterized-object-type parameterized-object-id []))
  ([parameterized-object-type parameterized-object-id parameter-ids-still-in-use]
   (let [conditions (concat [:parameterized_object_type parameterized-object-type
                             :parameterized_object_id parameterized-object-id]
                            (when (seq parameter-ids-still-in-use)
                              [:parameter_id [:not-in parameter-ids-still-in-use]]))]
     (apply t2/delete! ParameterCard conditions))))
(defn- upsert-from-parameters!
  [parameterized-object-type parameterized-object-id parameters]
  (doseq [{:keys [values_source_config id]} parameters]
    (let [card-id    (:card_id values_source_config)
          conditions {:parameterized_object_id   parameterized-object-id
                      :parameterized_object_type parameterized-object-type
                      :parameter_id              id}]
      (or (pos? (t2/update! ParameterCard conditions {:card_id card-id}))
          (t2/insert! ParameterCard (merge conditions {:card_id card-id}))))))

From a parameters list on card or dashboard, create, update, or delete appropriate ParameterCards for each parameter in the dashboard

(mu/defn upsert-or-delete-from-parameters!
  [parameterized-object-type :- ms/NonBlankString
   parameterized-object-id   :- ms/PositiveInt
   parameters                :- [:maybe [:sequential ms/Parameter]]]
  (let [upsertable?           (fn [{:keys [values_source_type values_source_config id]}]
                                (and values_source_type id (:card_id values_source_config)
                                     (= values_source_type "card")))
        upsertable-parameters (filter upsertable? parameters)]
    (upsert-from-parameters! parameterized-object-type parameterized-object-id upsertable-parameters)
    (delete-all-for-parameterized-object! parameterized-object-type parameterized-object-id (map :id upsertable-parameters))))
 

Utility functions for dealing with parameters for Dashboards and Cards.

Parameter are objects that exists on Dashboard/Card. In FE terms, we call it "Widget". The values of a parameter is provided so the Widget can show a list of options to the user.

There are 3 mains ways to provide values to a parameter: - chain-filter: see [metabase.models.params.chain-filter] - field-values: see [metabase.models.params.field-values] - custom-values: see [metabase.models.params.custom-values]

(ns metabase.models.params
  (:require
   [clojure.set :as set]
   [malli.core :as mc]
   [medley.core :as m]
   [metabase.db.util :as mdb.u]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.field-values :as field-values]
   [metabase.models.interface :as mi]
   [metabase.models.params.field-values :as params.field-values]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

+----------------------------------------------------------------------------------------------------------------+ | SHARED | +----------------------------------------------------------------------------------------------------------------+

Receive a Paremeterized Object and check if its parameters is valid.

(defn assert-valid-parameters
  [{:keys [parameters]}]
  (when-not (mc/validate [:maybe [:sequential ms/Parameter]] parameters)
    (throw (ex-info (tru ":parameters must be a sequence of maps with :id and :type keys")
                    {:parameters parameters}))))

Receive a Paremeterized Object and check if its parameters is valid.

(defn assert-valid-parameter-mappings
  [{:keys [parameter_mappings]}]
  (when-not (mc/validate [:maybe [:sequential ms/ParameterMapping]] parameter_mappings)
    (throw (ex-info (tru ":parameter_mappings must be a sequence of maps with :parameter_id and :type keys")
                    {:parameter_mappings parameter_mappings}))))
(mu/defn unwrap-field-clause :- [:maybe mbql.s/field]
  "Unwrap something that contains a `:field` clause, such as a template tag.
  Also handles unwrapped integers for legacy compatibility.
    (unwrap-field-clause [:field 100 nil]) ; -> [:field 100 nil]"
  [field-form]
  (if (integer? field-form)
    [:field field-form nil]
    (mbql.u/match-one field-form :field)))
(mu/defn unwrap-field-or-expression-clause :- mbql.s/Field
  "Unwrap a `:field` clause or expression clause, such as a template tag. Also handles unwrapped integers for
  legacy compatibility."
  [field-or-ref-form]
  (or (unwrap-field-clause field-or-ref-form)
      (mbql.u/match-one field-or-ref-form :expression)))

Wrap a raw Field ID in a :field clause if needed.

(defn wrap-field-id-if-needed
  [field-id-or-form]
  (cond
    (mbql.u/mbql-clause? field-id-or-form)
    field-id-or-form
    (integer? field-id-or-form)
    [:field field-id-or-form nil]
    :else
    field-id-or-form))

Whether to ignore permissions for the current User and return all FieldValues for the Fields being parameterized by Cards and Dashboards. This determines how :param_values gets hydrated for Card and Dashboard. Normally, this is false, but the public and embed versions of the API endpoints can bind this to true to bypass normal perms checks (since there is no current User) and get all values.

(def ^:dynamic *ignore-current-user-perms-and-return-all-field-values*
  false)
(defn- field-ids->param-field-values-ignoring-current-user
  [param-field-ids]
  (not-empty
   (into {}
         (map (comp (juxt :field_id identity)
                    #(select-keys % [:field_id :human_readable_values :values])
                    field-values/get-or-create-full-field-values!))
         (t2/hydrate (t2/select :model/Field :id [:in (set param-field-ids)]) :values))))

Given a collection of param-field-ids return a map of FieldValues for the Fields they reference. This map is returned by various endpoints as :param_values, if param-field-ids is empty, return nil

(defn- field-ids->param-field-values
  [param-field-ids]
  (when (seq param-field-ids)
    ((if *ignore-current-user-perms-and-return-all-field-values*
       field-ids->param-field-values-ignoring-current-user
       params.field-values/field-id->field-values-for-current-user) param-field-ids)))

Fetch the :field clause from dashcard referenced by template-tag.

(template-tag->field-form [:template-tag :company] some-dashcard) ; -> [:field 100 nil]

(defn- template-tag->field-form
  [[_ tag] card]
  (get-in card [:dataset_query :native :template-tags (u/qualified-name tag) :dimension]))
(mu/defn param-target->field-clause :- [:maybe mbql.s/Field]
  "Parse a Card parameter `target` form, which looks something like `[:dimension [:field-id 100]]`, and return the Field
  ID it references (if any)."
  [target card]
  (let [target (mbql.normalize/normalize target)]
    (when (mbql.u/is-clause? :dimension target)
      (let [[_ dimension] target
            field-form    (if (mbql.u/is-clause? :template-tag dimension)
                            (template-tag->field-form dimension card)
                            dimension)]
        ;; Being extra safe here since we've got many reports on this cause loading dashboard to fail
        ;; for unknown reasons. See #8917
        (if field-form
          (try
           (unwrap-field-or-expression-clause field-form)
           (catch Exception e
             (log/error e "Failed unwrap field form" field-form)))
          (log/error "Could not find matching field clause for target:" target))))))

Return the fields that are PK Fields.

(defn- pk-fields
  [fields]
  (filter #(isa? (:semantic_type %) :type/PK) fields))
(def ^:private Field:params-columns-only
  "Form for use in Toucan `t2/select` expressions (as a drop-in replacement for using `Field`) that returns Fields with
  only the columns that are appropriate for returning in public/embedded API endpoints, which make heavy use of the
  functions in this namespace. Use `conj` to add additional Fields beyond the ones already here. Use `rest` to get
  just the column identifiers, perhaps for use with something like `select-keys`. Clutch!
    (t2/select Field:params-columns-only)"
  ['Field :id :table_id :display_name :base_type :semantic_type :has_field_values])

Given a sequence of fields, return a map of Table ID -> to a :type/Name Field in that Table, if one exists. In cases where more than one name Field exists for a Table, this just adds the first one it finds.

(defn- fields->table-id->name-field
  [fields]
  (when-let [table-ids (seq (map :table_id fields))]
    (m/index-by :table_id (-> (t2/select Field:params-columns-only
                                :table_id      [:in table-ids]
                                :semantic_type (mdb.u/isa :type/Name))
                              ;; run [[metabase.lib.field/infer-has-field-values]] on these Fields so their values of
                              ;; `has_field_values` will be consistent with what the FE expects. (e.g. we'll return
                              ;; `:list` instead of `:auto-list`.)
                              (t2/hydrate :has_field_values)))))
(mi/define-batched-hydration-method add-name-field
  :name_field
  "For all `fields` that are `:type/PK` Fields, look for a `:type/Name` Field belonging to the same Table. For each
  Field, if a matching name Field exists, add it under the `:name_field` key. This is so the Fields can be used in
  public/embedded field values search widgets. This only includes the information needed to power those widgets, and
  no more."
  [fields]
  (let [table-id->name-field (fields->table-id->name-field (pk-fields fields))]
    (for [field fields]
      ;; add matching `:name_field` if it's a PK
      (assoc field :name_field (when (isa? (:semantic_type field) :type/PK)
                                 (table-id->name-field (:table_id field)))))))

We hydrate the :human_readable_field for each Dimension using the usual hydration logic, so it contains columns we don't want to return. The two functions below work to remove the unneeded ones.

Strip nonpublic columns from a dimension and from its hydrated human-readable Field.

(defn- remove-dimension-nonpublic-columns
  [dimension]
  (some-> dimension
          (update :human_readable_field #(select-keys % (rest Field:params-columns-only)))
          ;; these aren't exactly secret but you the frontend doesn't need them either so while we're at it let's go
          ;; ahead and strip them out
          (dissoc :created_at :updated_at)))

Strip nonpublic columns from the hydrated human-readable Field in the hydrated Dimensions in fields.

(defn- remove-dimensions-nonpublic-columns
  [fields]
  (for [field fields]
    (update field :dimensions (partial map remove-dimension-nonpublic-columns))))

Get the Fields (as a map of Field ID -> Field) that shoudl be returned for hydrated :param_fields for a Card or Dashboard. These only contain the minimal amount of information necessary needed to power public or embedded parameter widgets.

(mu/defn ^:private param-field-ids->fields
  [field-ids :- [:maybe [:set ms/PositiveInt]]]
  (when (seq field-ids)
    (m/index-by :id (-> (t2/select Field:params-columns-only :id [:in field-ids])
                        (t2/hydrate :has_field_values :name_field [:dimensions :human_readable_field])
                        remove-dimensions-nonpublic-columns))))

Add a :param_values map (Field ID -> FieldValues) containing FieldValues for the Fields referenced by the parameters of a Card or a Dashboard. Implementations are in respective sections below.

(defmulti ^:private ^{:hydrate :param_values} param-values
  t2/model)
#_{:clj-kondo/ignore [:unused-private-var]}
(mi/define-simple-hydration-method ^:private hydrate-param-values
  :param_values
  "Hydration method for `:param_fields`."
  [instance]
  (param-values instance))

Add a :param_fields map (Field ID -> Field) for all of the Fields referenced by the parameters of a Card or Dashboard. Implementations are below in respective sections.

(defmulti ^:private ^{:hydrate :param_fields} param-fields
  t2/model)
#_{:clj-kondo/ignore [:unused-private-var]}
(mi/define-simple-hydration-method ^:private hydrate-param-fields
  :param_fields
  "Hydration method for `:param_fields`."
  [instance]
  (param-fields instance))

+----------------------------------------------------------------------------------------------------------------+ | DASHBOARD-SPECIFIC | +----------------------------------------------------------------------------------------------------------------+

(mu/defn ^:private dashcards->parameter-mapping-field-clauses :- [:maybe [:set mbql.s/Field]]
  "Return set of any Fields referenced directly by the Dashboard's `:parameters` (i.e., 'explicit' parameters) by
  looking at the appropriate `:parameter_mappings` entries for its Dashcards."
  [dashcards]
  (when-let [fields (seq (for [dashcard dashcards
                               param    (:parameter_mappings dashcard)
                               :let     [field-clause (param-target->field-clause (:target param) (:card dashcard))]
                               :when    field-clause]
                           field-clause))]
    (set fields)))
(declare card->template-tag-field-ids)

Return the IDs of any Fields referenced in the 'implicit' template tag field filter parameters for native queries in cards.

(defn- cards->card-param-field-ids
  [cards]
  (reduce set/union #{} (map card->template-tag-field-ids cards)))
(mu/defn dashcards->param-field-ids :- [:set ms/PositiveInt]
  "Return a set of Field IDs referenced by parameters in Cards in the given `dashcards`, or `nil` if none are referenced. This
  also includes IDs of Fields that are to be found in the 'implicit' parameters for SQL template tag Field filters.
  `dashcards` must be hydrated with :card."
  [dashcards]
  (set/union
   (set (mbql.u/match (seq (dashcards->parameter-mapping-field-clauses dashcards))
          [:field (id :guard integer?) _]
          id))
   (cards->card-param-field-ids (map :card dashcards))))

Retrieve a map relating paramater ids to field ids.

(defn get-linked-field-ids
  [dashcards]
  (letfn [(targets [params card]
            (into {}
                  (for [param params
                        :let  [clause (param-target->field-clause (:target param)
                                                                  card)
                               ids (mbql.u/match clause
                                     [:field (id :guard integer?) _]
                                     id)]
                        :when (seq ids)]
                    [(:parameter_id param) (set ids)])))]
    (->> dashcards
         (mapv (fn [{params :parameter_mappings card :card}] (targets params card)))
         (apply merge-with into {}))))

Return a map of Field ID to FieldValues (if any) for any Fields referenced by Cards in dashboard, or nil if none are referenced or none of them have FieldValues.

(defn- dashboard->param-field-values
  [dashboard]
  (field-ids->param-field-values (dashcards->param-field-ids (:dashcards dashboard))))
(defmethod param-values :model/Dashboard [dashboard]
  (dashboard->param-field-values dashboard))
(defmethod param-fields :model/Dashboard [dashboard]
  (-> (t2/hydrate dashboard [:dashcards :card])
      :dashcards
      dashcards->param-field-ids
      param-field-ids->fields))

+----------------------------------------------------------------------------------------------------------------+ | CARD-SPECIFIC | +----------------------------------------------------------------------------------------------------------------+

(mu/defn card->template-tag-field-clauses :- [:set mbql.s/field]
  "Return a set of `:field` clauses referenced in template tag parameters in `card`."
  [card]
  (set (for [[_ {dimension :dimension}] (get-in card [:dataset_query :native :template-tags])
             :when                      dimension
             :let                       [field (unwrap-field-clause dimension)]
             :when                      field]
         field)))
(mu/defn card->template-tag-field-ids :- [:set ms/PositiveInt]
  "Return a set of Field IDs referenced in template tag parameters in `card`. This is mostly used for determining
  Fields referenced by Cards for purposes other than processing queries. Filters out `:field` clauses using names."
  [card]
  (set (mbql.u/match (seq (card->template-tag-field-clauses card))
         [:field (id :guard integer?) _]
         id)))
(defmethod param-values :model/Card [card]
  (-> card card->template-tag-field-ids field-ids->param-field-values))
(defmethod param-fields :model/Card [card]
  (-> card card->template-tag-field-ids param-field-ids->fields))
 

Generate and run an MBQL query to return possible values of a given Field based on the values of other related Fields.

Remapping

The main Field for which we search for values can optionally be remapped. ADDITIONAL CONSTRAINTS DO NOT SUPPORT REMAPPING! There are three types of remapping:

  1. Human-readable values remapping where you go assign string values to things like enum integers

  2. Implicit PK Field-> [Name] Field remapping. This happens automatically for any Field with :type/PK semantic type that has another Field with :type/Name semantic type in the same Table. e.g. venue.id is automatically remapped (displayed) as venue.name.

  3. Explicit FK Field->Field remapping. FK Fields can be manually remapped to a Field in the Table they point to. e.g. venue.category_id -> category.name. This is done by creating a Dimension for the Field in question with a human_readable_field_id. There is a big explanation of how this works in [[metabase.query-processor.middleware.add-dimension-projections]] -- see that namespace for more details.

Here's some examples of what this namespace does. Suppose you do

;; find values of Field 1 starting with 'Cam' that are possible when Field 2 = "abc" (chain-filter-search 1 {2 "abc"} "Cam")

Depending on the remapping situation, one of four things happens.

A) Human-readable values remapping

If Field 1 has human-readable values, we find those values that contain the string 'Cam' and then generate a query to restrict results to the matching original values. e.g. if Field 1 is "venue.category_id" and is human-readable-remapped with something like

{1 "Mexican", 2 "Camping Food", 3 "Campbell's Soup"}

and you do the search above, then we generate a query that looks something like:

SELECT category_id FROM venue WHERE id IN (2, 3) AND field_2 = "abc"

(we then convert these values back to [value human-readable-value] pairs in Clojure-land)

B) Field->Field remapping (either type)

Suppose Field 1 is venue.category_id which has a remapping "name" Field category.name. For the example search above, the resulting query looks something like:

SELECT venue.category_id, category.name FROM venue LEFT JOIN category ON venue.category_id = category.id WHERE lower(category.name) LIKE 'cam%' AND field_2 = "abc"

C) No remappings

Life is easy. Suppose Field 1 is category.name. The resulting query is something like:

SELECT name FROM category WHERE lower(name) LIKE '%cam' AND field_2 = "abc"

(ns metabase.models.params.chain-filter
  (:require
   [clojure.core.memoize :as memoize]
   [clojure.set :as set]
   [clojure.string :as str]
   [honey.sql :as sql]
   [metabase.db.connection :as mdb.connection]
   [metabase.db.query :as mdb.query]
   [metabase.db.util :as mdb.u]
   [metabase.driver.common.parameters.dates :as params.dates]
   [metabase.mbql.util :as mbql.u]
   [metabase.models :refer [Field FieldValues Table]]
   [metabase.models.field :as field]
   [metabase.models.field-values :as field-values]
   [metabase.models.params :as params]
   [metabase.models.params.chain-filter.dedupe-joins :as dedupe]
   [metabase.models.params.field-values :as params.field-values]
   [metabase.models.table :as table]
   [metabase.query-processor :as qp]
   [metabase.types :as types]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

so the hydration method for name_field is loaded

(comment params/keep-me)

for [[memoize/ttl]] keys

(comment mdb.connection/keep-me)

Schema for a constraint on a field.

(def Constraint
  [:map
   [:field-id ms/PositiveInt]
   [:op :keyword]
   [:value :any]
   [:options {:optional true} [:maybe map?]]])

Schema for a list of Constraints.

(def Constraints
  [:sequential Constraint])

Whether to chain filter via joins where we must follow relationships in reverse, e.g. child -> parent (e.g. Restaurant -> Category instead of the usual Category -> Restuarant*)

This switch mostly exists because I'm not 100% sure what the right behavior is.

(def ^:dynamic *enable-reverse-joins*
  true)
(defn- joined-table-alias [table-id]
  (format "table_%d" table-id))

Whether Field with field-id is a temporal Field such as a Date or Datetime. Cached for 10 minutes to avoid hitting the DB too much since this is unlike to change often, if ever.

(def ^:private ^{:arglists '([field-id])} temporal-field?
  (memoize/ttl
   ^{::memoize/args-fn (fn [[field-id]]
                         [(mdb.connection/unique-identifier) field-id])}
   (fn [field-id]
     (types/temporal-field? (t2/select-one [Field :base_type :semantic_type] :id field-id)))
   :ttl/threshold (u/minutes->ms 10)))

Generate a single MBQL :filter clause for a Field and value (or multiple values, if value is a collection).

(mu/defn ^:private filter-clause
  [source-table-id
   {:keys [field-id op value options]} :- Constraint]
  (let [field-clause (let [this-field-table-id (field/field-id->table-id field-id)]
                       [:field field-id (when-not (= this-field-table-id source-table-id)
                                          {:join-alias (joined-table-alias this-field-table-id)})])]
    (if (and (temporal-field? field-id)
             (string? value))
      (u/ignore-exceptions
        (params.dates/date-string->filter value field-id))
      (cond-> [op field-clause]
        ;; we don't want to skip our value, even if its nil
        true (into (if value (u/one-or-many value) [nil]))
        (seq options) (conj options)))))
(defn- name-for-logging [model id]
  (format "%s %d %s" (name model) id (u/format-color 'blue (pr-str (t2/select-one-fn :name model :id id)))))
(defn- format-join-for-logging [join]
  (format "%s %s -> %s %s"
          (name-for-logging Table (-> join :lhs :table))
          (name-for-logging Field (-> join :lhs :field))
          (name-for-logging Table (-> join :rhs :table))
          (name-for-logging Field (-> join :rhs :field))))
(defn- format-joins-for-logging [joins]
  (str/join "\n"
            (map-indexed (fn [i join]
                           (format "%d. %s" (inc i) (format-join-for-logging join)))
                         joins)))
(defn- add-filters [query source-table-id joined-table-ids constraints]
  (reduce
   (fn [query {:keys [field-id] :as constraint}]
     ;; only add a where clause for the Field if it's part of the source Table or if we're actually joining against
     ;; the Table it belongs to. This Field might not even be part of the same Database in which case we can ignore
     ;; it.
     (let [field-table-id (field/field-id->table-id field-id)]
       (if (or (= field-table-id source-table-id)
               (contains? joined-table-ids field-table-id))
         (let [clause (filter-clause source-table-id constraint)]
           (log/tracef "Added filter clause for %s %s: %s"
                       (name-for-logging Table field-table-id)
                       (name-for-logging Field field-id)
                       clause)
           (update query :filter mbql.u/combine-filter-clauses clause))
         (do
           (log/tracef "Not adding filter clause for %s %s because we did not join against its Table"
                       (name-for-logging Table field-table-id)
                       (name-for-logging Field field-id))
           query))))
   query
   constraints))

Amount of time to cache results of find-joins. Since FK relationships in Tables are unlikely to change very often (actually, only when the DB is synced again) we can cache them for a while and avoid a complicated app DB call.

(def ^:private find-joins-cache-duration-ms
  ;; 5 minutes seems reasonable
  (u/minutes->ms 5))
(defn- database-fk-relationships* [database-id enable-reverse-joins?]
  (let [rows (mdb.query/query {:select    [[:fk-field.id :f1]
                                           [:fk-table.id :t1]
                                           [:pk-field.id :f2]
                                           [:pk-field.table_id :t2]]
                               :from      [[:metabase_field :fk-field]]
                               :left-join [[:metabase_table :fk-table]    [:= :fk-field.table_id :fk-table.id]
                                           [:metabase_database :database] [:= :fk-table.db_id :database.id]
                                           [:metabase_field :pk-field]    [:= :fk-field.fk_target_field_id :pk-field.id]]
                               :where     [:and
                                           [:= :database.id database-id]
                                           [:not= :fk-field.fk_target_field_id nil]]})]
    (reduce
     (partial merge-with merge)
     {}
     (for [{:keys [t1 f1 t2 f2]} rows]
       (merge
        {t1 {t2 [{:lhs {:table t1, :field f1}, :rhs {:table t2, :field f2}}]}}
        (let [reverse-join {:lhs {:table t2, :field f2}, :rhs {:table t1, :field f1}}]
          (if enable-reverse-joins?
            {t2 {t1 [reverse-join]}}
            (log/tracef "Not including reverse join (disabled) %s" (format-join-for-logging reverse-join)))))))))

Return a sequence of FK relationships that exist in a database, in the format

lhs-table-id -> rhs-table-id -> [join-info*]

where join-info is of the format

{:lhs {:table , :field }, :rhs {:table , :field }}

'lhs' refers to the Table and Field on the left-hand-side of the join, and 'rhs' refers to the Table on the right-hand-side of the join. Of course, you can join in either direction (e.g. FROM B JOIN A ... or `FROM A JOIN B), so bothA -> BandB -> A` versions of the relationship are returned; having both possibilities simplifies the implementation of find-joins below.

(def ^:private ^{:arglists '([database-id enable-reverse-joins?])} database-fk-relationships
  (memoize/ttl
   ^{::memoize/args-fn (fn [[database-id enable-reverse-joins?]]
                         [(mdb.connection/unique-identifier) database-id enable-reverse-joins?])}
   database-fk-relationships*
   :ttl/threshold find-joins-cache-duration-ms))

A breadth first traversal of graph, not probing any paths that are over max-depth in length.

(defn- traverse-graph
  [graph start end max-depth]
  (letfn [(transform [path] (let [edges (partition 2 1 path)]
                              (not-empty (vec (mapcat (fn [[x y]] (get-in graph [x y])) edges)))))]
    (loop [paths (conj clojure.lang.PersistentQueue/EMPTY [start])
           seen  #{start}]
      (let [path (peek paths)
            node (peek path)]
        (cond (nil? node)
              nil
              ;; found a path, bfs finds shortest first
              (= node end)
              (transform path)
              ;; abandon this path. A bit hazy on how seen and max depth interact.
              (= (count path) max-depth)
              (recur (pop paths) seen)
              ;; probe further and throw them on the queue
              :else
              (let [next-nodes (->> (get graph node)
                                    keys
                                    (remove seen))]
                (recur (into (pop paths) (for [n next-nodes] (conj path n)))
                       (set/union seen (set next-nodes)))))))))
(def ^:private max-traversal-depth 5)
(defn- find-joins* [database-id source-table-id other-table-id enable-reverse-joins?]
  (let [fk-relationships (database-fk-relationships database-id enable-reverse-joins?)]
    ;; find series of joins needed to get from LHS -> RHS. `path` is the tables we're already joining against when
    ;; recursing so we don't end up coming up with circular joins.
    ;;
    ;; the general idea here is to see if LHS can join directly against RHS, otherwise recursively try all of the
    ;; tables LHS can join against and see if we can find a path that way.
    (u/prog1 (traverse-graph fk-relationships source-table-id other-table-id max-traversal-depth)
      (when (seq <>)
        (log/tracef (format-joins-for-logging <>))))))

Find the joins that must be done to make fields in Table with other-table-id accessible in a query whose primary (source) Table is the Table with source-table-id. Information about joins is returned in the format

[{:lhs {:table , :field }, :rhs {table , :field }} ...]

e.g.

;; 'airport' is the source Table; find the joins needed to include 'country' Table (find-joins my-database-id ) ;; -> ;; 3 joins needed: airport -> municipality; municipality -> region; region -> country [{:lhs {:table , :field } :rhs {:table , :field }} {:lhs {:table , :field } :rhs {:table , :field }} {:lhs {:table , :field } :rhs {:table , :field }}]

(def ^:private ^{:arglists '([database-id source-table-id other-table-id]
                             [database-id source-table-id other-table-id enable-reverse-joins?])} find-joins
  (let [f (memoize/ttl
           ^{::memoize/args-fn (fn [[database-id source-table-id other-table-id enable-reverse-joins?]]
                                 [(mdb.connection/unique-identifier)
                                  database-id
                                  source-table-id
                                  other-table-id
                                  enable-reverse-joins?])}
           find-joins*
           :ttl/threshold find-joins-cache-duration-ms)]
    (fn
      ([database-id source-table-id other-table-id]
       (f database-id source-table-id other-table-id *enable-reverse-joins*))
      ([database-id source-table-id other-table-id enable-reverse-joins?]
       (f database-id source-table-id other-table-id enable-reverse-joins?)))))
(def ^:private ^{:arglists '([source-table other-table-ids enable-reverse-joins?])} find-all-joins*
  (memoize/ttl
   ^{::memoize/args-fn (fn [[source-table-id other-table-ids enable-reverse-joins?]]
                         [(mdb.connection/unique-identifier) source-table-id other-table-ids enable-reverse-joins?])}
   (fn [source-table-id other-table-ids enable-reverse-joins?]
     (let [db-id     (table/table-id->database-id source-table-id)
           all-joins (mapcat #(find-joins db-id source-table-id % enable-reverse-joins?)
                             other-table-ids)]
       (when (seq all-joins)
         (log/tracef "Deduplicating for source %s; Tables to keep: %s\n%s"
                     (name-for-logging Table source-table-id)
                     (str/join ", " (map (partial name-for-logging Table)
                                         other-table-ids))
                     (format-joins-for-logging all-joins))
         (u/prog1 (vec (dedupe/dedupe-joins source-table-id all-joins other-table-ids))
           (when-not (= all-joins <>)
             (log/tracef "Deduplicated:\n%s" (format-joins-for-logging <>)))))))
   :ttl/threshold find-joins-cache-duration-ms))

Find the complete set of joins we need to do for source-table-id to join against Fields in field-ids.

(defn- find-all-joins
  [source-table-id field-ids]
  (when-let [other-table-ids (not-empty (disj (set (map field/field-id->table-id (set field-ids)))
                                              source-table-id))]
    (find-all-joins* source-table-id other-table-ids *enable-reverse-joins*)))

Add joins to the MBQL query we're generating. The Field for which we are returning values is the "source Field", and the Table it belongs to is the source Table; field-ids is a set of Fields belonging to Tables other than the source Table.

When we generate joins, we must determine the other Tables we must join against so that we have access to the other Fields. The relationship between these other Tables and the source Table may go in either direction, i.e. the source Table may have a FK to the other Table, or the other Table might have an FK to the source Table. e.g. the join condition may be either:

sourcetable.fk = othertable.pk -- or sourcetable.pk = othertable.fk

Since we're not sure which way the relationship goes, resolve-fk-id fetches all possible relationships between the two Tables and we generate the appropriate join against the other Table.

(defn- add-joins
  [query source-table-id joins]
  (reduce
   (fn [query {{lhs-table-id :table, lhs-field-id :field} :lhs, {rhs-table-id :table, rhs-field-id :field} :rhs}]
     (let [join {:source-table rhs-table-id
                 :condition    [:=
                                [:field lhs-field-id (when-not (= lhs-table-id source-table-id)
                                                       {:join-alias (joined-table-alias lhs-table-id)})]
                                [:field rhs-field-id {:join-alias (joined-table-alias rhs-table-id)}]]
                 :alias        (joined-table-alias rhs-table-id)}]
       (log/tracef "Adding join against %s\n%s"
                   (name-for-logging Table rhs-table-id) (u/pprint-to-str join))
       (update query :joins concat [join])))
   query
   joins))
(def ^:private Options
  ;; if original-field-id is specified, we'll include this in the results. For Field->Field remapping.
  [:map {:closed true}
   [:original-field-id {:optional true} [:maybe ms/PositiveInt]]
    ;; return at most the lesser of `limit` (if specified) and `max-results`.
   [:limit {:optional true} [:maybe ms/PositiveInt]]])
(def ^:private max-results 1000)

Generate the MBQL query powering chain-filter.

(mu/defn ^:private chain-filter-mbql-query
  [field-id                          :- ms/PositiveInt
   constraints                       :- [:maybe Constraints]
   {:keys [original-field-id limit]} :- [:maybe Options]]
  {:database (field/field-id->database-id field-id)
   :type     :query
   :query    (let [source-table-id       (field/field-id->table-id field-id)
                   joins                 (find-all-joins source-table-id (cond-> (set (map :field-id constraints))
                                                                           original-field-id (conj original-field-id)))
                   joined-table-ids      (set (map #(get-in % [:rhs :table]) joins))
                   original-field-clause (when original-field-id
                                           (let [original-table-id (field/field-id->table-id original-field-id)]
                                             [:field
                                              original-field-id
                                              (when-not (= source-table-id original-table-id)
                                                {:join-alias (joined-table-alias original-table-id)})]))]
               (when original-field-id
                 (log/tracef "Finding values of %s, remapped from %s."
                             (name-for-logging Field field-id)
                             (name-for-logging Field original-field-id))
                 (log/tracef "MBQL clause for %s is %s"
                             (name-for-logging Field original-field-id) (pr-str original-field-clause)))
               (when (seq joins)
                 (log/tracef "Generating joins and filters for source %s with joins info\n%s"
                             (name-for-logging Table source-table-id) (pr-str joins)))
               (-> (merge {:source-table source-table-id
                           ;; original-field-id is used to power Field->Field breakouts. We include both remapped and
                           ;; original
                           :breakout     (if original-field-clause
                                           [original-field-clause [:field field-id nil]]
                                           [[:field field-id nil]])
                           ;; return the lesser of limit (if set) or max results
                           :limit        ((fnil min Integer/MAX_VALUE) limit max-results)}
                          (when original-field-clause
                            { ;; don't return rows that don't have values for the original Field. e.g. if
                             ;; venues.category_id is remapped to categories.name and we do a search with query 's',
                             ;; we only want to return [category_id name] tuples where [category_id] is not nil
                             ;;
                             ;; TODO -- would this be more efficient if we just did an INNER JOIN against the original
                             ;; Table instead of a LEFT JOIN with this additional filter clause? Would that still
                             ;; work?
                             :filter    [:not-null original-field-clause]
                             ;; for Field->Field remapping we want to return pairs of [original-value remapped-value],
                             ;; but sort by [remapped-value]
                             :order-by [[:asc [:field field-id nil]]]}))
                   (add-joins source-table-id joins)
                   (add-filters source-table-id joined-table-ids constraints)))
   :middleware {:disable-remaps? true}})

------------------------ Chain filter (powers GET /api/dashboard/:id/params/:key/values) -------------------------

(mu/defn ^:private unremapped-chain-filter :- ms/FieldValuesResult
  "Chain filtering without all the fancy remapping stuff on top of it."
  [field-id    :- ms/PositiveInt
   constraints :- [:maybe Constraints]
   options     :- [:maybe Options]]
  (let [mbql-query (chain-filter-mbql-query field-id constraints options)]
    (log/debugf "Chain filter MBQL query:\n%s" (u/pprint-to-str 'magenta mbql-query))
    (try
      (let [query-limit (get-in mbql-query [:query :limit])
            values      (qp/process-query mbql-query (constantly conj) nil)]
        {:values          values
         ;; It's unlikely that we don't have a query-limit, but better safe than sorry and default it true
         ;; so that calling chain-filter-search on the same field will search from DB.
         :has_more_values (if (nil? query-limit)
                            true
                            (= (count values) query-limit))})
      (catch Throwable e
        (throw (ex-info (tru "Error executing chain filter query")
                        {:field-id    field-id
                         :constraints constraints
                         :mbql-query  mbql-query}
                        e))))))

Schema for the map of actual value -> human-readable value. Cannot be empty.

(def ^:private HumanReadableRemappingMap
  [:map-of {:min 1} :any [:maybe :string]])
(mu/defn ^:private human-readable-remapping-map :- [:maybe HumanReadableRemappingMap]
  [field-id :- ms/PositiveInt]
  (when-let [{orig :values, remapped :human_readable_values} (t2/select-one [FieldValues :values :human_readable_values]
                                                                            {:where [:and
                                                                                     [:= :type "full"]
                                                                                     [:= :field_id field-id]
                                                                                     [:not= :human_readable_values nil]
                                                                                     [:not= :human_readable_values "{}"]]})]
    (when (seq remapped)
      (zipmap orig remapped))))

Convert result values (a sequence of 1-tuples) to a sequence of [v human-readable] pairs by finding the matching remapped values from v->human-readable.

(mu/defn ^:private add-human-readable-values
  [values            :- [:sequential ms/NonRemappedFieldValue]
   v->human-readable :- HumanReadableRemappingMap]
  (map vector
       (map first values)
       (map (fn [[v]]
              (get v->human-readable v (get v->human-readable (str v))))
            values)))

Workaround for https://github.com/seancorfield/honeysql/issues/451. Wrap the subselects in parens, otherwise it will fail on Postgres.

(defn- format-union
  [_clause exprs]
  (let [[sqls args] (sql/format-expr-list exprs)
        sql         (str/join " UNION " sqls)]
    (into [sql] args)))
(sql/register-clause! ::union format-union :union)
(defn- remapped-field-id-query [field-id]
  {:select [[:ids.id :id]]
   :from   [[{::union [;; Explicit FK Field->Field remapping
                       {:select [[:dimension.human_readable_field_id :id]]
                        :from   [[:dimension :dimension]]
                        :where  [:and
                                 [:= :dimension.field_id field-id]
                                 [:not= :dimension.human_readable_field_id nil]]
                        :limit  1}
                       ;; Implicit PK Field-> [Name] Field remapping
                       {:select    [[:dest.id :id]]
                        :from      [[:metabase_field :source]]
                        :left-join [[:metabase_table :table] [:= :source.table_id :table.id]
                                    [:metabase_field :dest] [:= :dest.table_id :table.id]]
                        :where     [:and
                                    [:= :source.id field-id]
                                    (mdb.u/isa :source.semantic_type :type/PK)
                                    (mdb.u/isa :dest.semantic_type :type/Name)]
                        :limit     1}]}
             :ids]]
   :limit  1})

TODO -- add some caching here?

(mu/defn remapped-field-id :- [:maybe ms/PositiveInt]
  "Efficient query to find the ID of the Field we're remapping `field-id` to, if it has either type of Field -> Field
  remapping."
  [field-id :- [:maybe ms/PositiveInt]]
  (:id (t2/query-one (remapped-field-id-query field-id))))

Whether we should use cached FieldValues instead of running a query via the QP.

(defn- use-cached-field-values?
  [field-id]
  (and
    field-id
    (field-values/field-should-have-field-values? field-id)))
(defn- cached-field-values [field-id constraints {:keys [limit]}]
  ;; TODO: why don't we remap the human readable values here?
  (let [{:keys [values has_more_values]}
        (if (empty? constraints)
          (params.field-values/get-or-create-field-values-for-current-user! (t2/select-one Field :id field-id))
          (params.field-values/get-or-create-linked-filter-field-values! (t2/select-one Field :id field-id) constraints))]
    {:values          (cond->> values
                        limit (take limit))
     :has_more_values (or (when limit
                            (< limit (count values)))
                          has_more_values)}))
(mu/defn chain-filter :- ms/FieldValuesResult
  "Fetch a sequence of possible values of Field with `field-id` by restricting the possible values to rows that match
  values of other Fields in the `constraints` map. Powers the `GET /api/dashboard/:id/param/:key/values` chain filter
  API endpoint.
    ;; fetch possible values of venue price (between 1 and 4 inclusive) where category name is 'BBQ'
    (chain-filter %venues.price {%categories.name \"BBQ\"})
    ;; -> {:values          [1 2 3] (there are no BBQ places with price = 4)
           :has_more_values false}
  `options` are key-value options. Currently only one option is supported, `:limit`:
    ;; fetch first 10 values of venues.price
    (chain-filter %venues.price {} :limit 10)
  For remapped columns, this returns results as a sequence of `[value remapped-value]` pairs."
  [field-id    :- ms/PositiveInt
   constraints :- [:maybe Constraints]
   & options]
  (assert (even? (count options)))
  (let [{:as options}         options
        v->human-readable     (human-readable-remapping-map field-id)
        the-remapped-field-id (delay (remapped-field-id field-id))]
    (cond
     ;; This is for fields that have human-readable values defined (e.g. you've went in and specified that enum
     ;; value `1` should be displayed as `BIRD_TYPE_TOUCAN`). `v->human-readable` is a map of actual values in the
     ;; database (e.g. `1`) to the human-readable version (`BIRD_TYPE_TOUCAN`).
     (some? v->human-readable)
     (-> (unremapped-chain-filter field-id constraints options)
         (update :values add-human-readable-values v->human-readable))
     (and (use-cached-field-values? field-id) (nil? @the-remapped-field-id))
     (cached-field-values field-id constraints options)
     ;; This is Field->Field remapping e.g. `venue.category_id `-> `category.name `;
     ;; search by `category.name` but return tuples of `[venue.category_id category.name]`.
     (some? @the-remapped-field-id)
     (unremapped-chain-filter @the-remapped-field-id constraints (assoc options :original-field-id field-id))
     :else
     (unremapped-chain-filter field-id constraints options))))

----------------- Chain filter search (powers GET /api/dashboard/:id/params/:key/search/:query) -----------------

Before running a search query, make sure the Field actually exists and that it's a Text field.

TODO -- if this validation succeeds, we can probably cache that success for a bit so we can avoid unneeded DB calls every time this function is called.

(defn- check-valid-search-field
  [field-id]
  (let [base-type (t2/select-one-fn :base_type Field :id field-id)]
    (when-not base-type
      (throw (ex-info (tru "Field {0} does not exist." field-id)
                      {:field field-id, :status-code 404})))
    (when-not (isa? base-type :type/Text)
      (let [field-name (t2/select-one-fn :name Field :id field-id)]
        (throw (ex-info (tru "Cannot search against non-Text Field {0} {1}" field-id (pr-str field-name))
                        {:status-code 400
                         :field-id    field-id
                         :field       field-name
                         :base-type   base-type}))))))
(mu/defn ^:private unremapped-chain-filter-search
  [field-id    :- ms/PositiveInt
   constraints :- [:maybe Constraints]
   query       :- ms/NonBlankString
   options     :- [:maybe Options]]
  (check-valid-search-field field-id)
  (let [constraints (conj constraints {:field-id field-id
                                       :op       :contains
                                       :value    query
                                       :options  {:case-sensitive false}})]
    (unremapped-chain-filter field-id constraints options)))
(defn- matching-unremapped-values [query v->human-readable]
  (let [query (u/lower-case-en query)]
    (for [[orig remapped] v->human-readable
          :when           (and (string? remapped)
                               (str/includes? (u/lower-case-en remapped) query))]
      orig)))

Chain filter search, but for Fields that have human-readable values defined (e.g. you've went in and specified that enum value 1 should be displayed as BIRD_TYPE_TOUCAN). v->human-readable is a map of actual values in the database (e.g. 1) to the human-readable version (BIRD_TYPE_TOUCAN).

(mu/defn ^:private human-readable-values-remapped-chain-filter-search
  [field-id          :- ms/PositiveInt
   v->human-readable :- HumanReadableRemappingMap
   constraints       :- [:maybe Constraints]
   query             :- ms/NonBlankString
   options           :- [:maybe Options]]
  (or (when-let [unremapped-values (not-empty (matching-unremapped-values query v->human-readable))]
        (let [constraints (conj constraints {:field-id field-id
                                             :op       :=
                                             :value    (set unremapped-values)
                                             :options  nil})
              result      (unremapped-chain-filter field-id constraints options)]
          (update result :values add-human-readable-values v->human-readable)))
      {:values          []
       :has_more_values false}))
(defn- search-cached-field-values? [field-id constraints]
  (and (use-cached-field-values? field-id)
       (isa? (t2/select-one-fn :base_type Field :id field-id) :type/Text)
       (apply t2/exists? FieldValues (mapcat
                                       identity
                                       (merge {:field_id field-id, :values [:not= nil], :human_readable_values nil}
                                              ;; if we are doing a search, make sure we only use field values
                                              ;; when we're certain the fieldvalues we stored are all the possible values.
                                              ;; otherwise, we should search directly from DB
                                              {:has_more_values false}
                                              (if-not (empty? constraints)
                                                {:type     "linked-filter"
                                                 :hash_key (params.field-values/hash-key-for-advanced-field-values :linked-filter field-id constraints)}
                                                (if-let [hash-key (params.field-values/hash-key-for-advanced-field-values :sandbox field-id nil)]
                                                  {:type    "sandbox"
                                                   :hash_key hash-key}
                                                  {:type "full"})))))))
(defn- cached-field-values-search
  [field-id query constraints {:keys [limit]}]
  (let [{:keys [values has_more_values]} (cached-field-values field-id constraints nil)
        query                            (u/lower-case-en query)]
    {:values (cond->> (filter (fn [s]
                                (when s
                                  (str/includes? (u/lower-case-en s) query)))
                              values)
               limit (take limit))
     :has_more_values has_more_values}))
(mu/defn chain-filter-search :- ms/FieldValuesResult
  "Convenience version of `chain-filter` that adds a constraint to only return values of Field with `field-id`
  containing String `query`. Powers the `search/:query` version of the chain filter endpoint."
  [field-id          :- ms/PositiveInt
   constraints       :- [:maybe Constraints]
   query             :- [:maybe ms/NonBlankString]
   & options]
  (assert (even? (count options)))
  (let [{:as options}         options
        v->human-readable     (delay (human-readable-remapping-map field-id))
        the-remapped-field-id (delay (remapped-field-id field-id))]
    (cond
     (str/blank? query)
     (apply chain-filter field-id constraints options)
     (some? @v->human-readable)
     (human-readable-values-remapped-chain-filter-search field-id @v->human-readable constraints query options)
     (and (search-cached-field-values? field-id constraints) (nil? @the-remapped-field-id))
     (cached-field-values-search field-id query constraints options)
     (some? @the-remapped-field-id)
     (unremapped-chain-filter-search @the-remapped-field-id constraints query (assoc options :original-field-id field-id))
     :else
     (unremapped-chain-filter-search field-id constraints query options))))

------------------ Filterable Field IDs (powers GET /api/dashboard/params/valid-filter-fields) -------------------

Return the subset of filter-ids we can actually use in a chain-filter query to fetch values of Field with id.

;; maybe we can't filter against Field 2 because there's no FK-> relationship (filterable-field-ids 1 #{2 3 4}) ; -> #{3 4}

(mu/defn filterable-field-ids
  [field-id         :- ms/PositiveInt
   filter-field-ids :- [:maybe [:set ms/PositiveInt]]]
  (when (seq filter-field-ids)
    (let [mbql-query (chain-filter-mbql-query field-id
                                              (for [id filter-field-ids]
                                                {:field-id id :op := :value nil})
                                              nil)]
      (set (mbql.u/match (-> mbql-query :query :filter)
             [:field (id :guard integer?) _] id)))))
 
(ns metabase.models.params.chain-filter.dedupe-joins
  (:require
   [clojure.core.logic :as l]
   [clojure.set :as set]))

A relation such that the left-hand side (LHS) of join is lhs.

(defn- lhso
  [join lhs]
  (l/featurec join {:lhs {:table lhs}}))

A relation such that the right-hand side (RHS) of join is rhs.

(defn- rhso
  [join rhs]
  (l/featurec join {:rhs {:table rhs}}))

A psuedo-relation such that goal g succeeds for at least one item in coll.

(defn- anyg
  [g coll]
  (l/conda
   ((l/fresh [head]
      (l/firsto coll head)
      (g head)))
   ((l/fresh [more]
      (l/resto coll more)
      (anyg g more)))))

A relation such that joins has a join whose RHS is rhs.

(defn- has-joino
  [joins rhs]
  (anyg #(rhso % rhs) joins))

True if join-1 can be considered a 'parent' of join-2 -- if the Table made available by join-1 (its RHS) is needed for join-2 (its LHS).

(defn- parent-joino
  [join-1 join-2]
  (l/fresh [id]
    (rhso join-1 id)
    (lhso join-2 id)))

A relation such that sublist is all items in lst up to (but not including) item.

(defn- list-beforeo
  [lst sublist item]
  #_:clj-kondo/ignore
  (l/matcha [lst sublist]
    ([[] []])
    ([[item . _] []])
    ([[?x . ?list-more] [?x . ?sublist-more]]
     (list-beforeo ?list-more ?sublist-more item))))

A relationship such that the parent join of join appears before it in joins.

(defn- parent-beforeo
  [joins join]
  (l/fresh [joins-before parent]
    (list-beforeo joins joins-before join)
    (parent-joino parent join)
    (l/membero parent joins-before)))

A relationship such that all RHS tables in joins are distinct.

(defn- distinct-rhso
  [joins]
  (let [rhses (vec (l/lvars (count joins)))]
    (dorun (map rhso joins rhses))
    (l/all
     (l/distincto rhses))))

Remove unnecessary joins from a collection of in-joins.

keep-ids = the IDs of Tables that we want to keep joins for. Joins that are not needed to keep these Tables may be removed.

(defn dedupe-joins
  [source-id in-joins keep-ids]
  ;; we can't keep any joins that don't exist in `in-joins`, so go ahead and remove IDs for those joins if they're not
  ;; present
  (let [keep-ids (set/intersection (set keep-ids)
                                   (set (map #(get-in % [:rhs :table]) in-joins)))]
    (first
     (some
      seq
      (for [num-joins (range (count keep-ids) (inc (count in-joins)))]
        (let [out-joins (vec (l/lvars num-joins))]
          (l/run 1 [q]
            (l/== q out-joins)
            ;; every join in out-joins must be present in the original non-deduped set of joins
            (l/everyg (fn [join]
                        (l/membero join in-joins))
                      out-joins)
            ;; no duplicate joins (this is mostly for optimization since we also deduplicate RHSes below)
            (l/distincto out-joins)
            ;; a join for every rhs must be present
            (l/everyg (fn [id]
                        (has-joino out-joins id))
                      keep-ids)
            ;; no duplicate rhses
            (distinct-rhso out-joins)
            ;; joins must be in order (e.g. parent join must come first)
            (l/everyg (fn [join]
                        (l/conda
                         ;; either the LHS is the source Table...
                         ((lhso join source-id))
                         ;; or its LHS must have already been joined
                         ((parent-beforeo out-joins join))))
                      out-joins))))))))
 

Custom values for Parameters.

A parameter with custom values will need to define a source: - static-list: the values is pre-defined and stored inside parameter's config - card: the values is a column from a saved question

(ns metabase.models.params.custom-values
  (:require
   [clojure.string :as str]
   [metabase.models.card :refer [Card]]
   [metabase.models.interface :as mi]
   [metabase.query-processor :as qp]
   [metabase.query-processor.util :as qp.util]
   [metabase.search.util :as search.util]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

Filters for values that match query.

Values could have 2 shapes - [[value1], [value2]] - [[value2, label2], [value2, label2]] - we search using label in this case

------------------------------------------------- source=static-list --------------------------------------------------

(defn- query-matches
  [query values]
  (let [normalized-query (search.util/normalize query)]
    (filter (fn [v] (str/includes? (search.util/normalize (if (= (count v) 1)
                                                            (first v)
                                                            (second v)))
                                   normalized-query)) values)))
(defn- static-list-values
  [{values-source-options :values_source_config :as _param} query]
  (when-let [values (:values values-source-options)]
    (let [wrapped-values (map (fn [v] (if-not (sequential? v) [v] v)) values)]
      {:values          (if query
                          (query-matches query wrapped-values)
                          wrapped-values)
       :has_more_values false})))

---------------------------------------------------- source=card ------------------------------------------------------

Maximum number of rows returned when running a card. It's 1000 because it matches with the limit for chain-filter. Maybe we should lower it for the sake of displaying a parameter dropdown.

(def ^:dynamic *max-rows*
  1000)
(defn- values-from-card-query
  [card value-field query]
  (let [value-base-type (:base_type (qp.util/field->field-info value-field (:result_metadata card)))
        expressions (get-in card [:dataset_query :query :expressions])]
    {:database (:database_id card)
     :type     :query
     :query    (merge
                 (cond-> {:source-table (format "card__%d" (:id card))
                          :breakout     [value-field]
                          :limit        *max-rows*}
                   expressions
                   (assoc :expressions expressions))
                 {:filter [:and
                           [(if (isa? value-base-type :type/Text)
                              :not-empty
                              :not-null)
                            value-field]
                           (when query
                             (if-not (isa? value-base-type :type/Text)
                               [:= value-field query]
                               [:contains [:lower value-field] (u/lower-case-en query)]))]})
     :middleware {:disable-remaps? true}}))

Get distinct values of a field from a card.

(values-from-card 1 [:field "name" nil] "red") ;; will execute a mbql that looks like ;; {:source-table (format "card__%d" card-id) ;; :fields [value-field] ;; :breakout [value-field] ;; :filter [:contains [:lower value-field] "red"] ;; :limit max-rows} => {:values [["Red Medicine"]] :hasmorevalues false}

(mu/defn values-from-card
  ([card value-field]
   (values-from-card card value-field nil))
  ([card            :- (ms/InstanceOf Card)
    value-field     :- ms/Field
    query           :- [:any]]
   (let [mbql-query   (values-from-card-query card value-field query)
         result       (qp/process-query mbql-query)
         values       (get-in result [:data :rows])]
     {:values         values
      ;; if the row_count returned = the limit we specified, then it's probably has more than that
      :has_more_values (= (:row_count result)
                          (get-in mbql-query [:query :limit]))})))

Given a param and query returns the values.

(defn card-values
  [{config :values_source_config :as _param} query]
  (let [card-id (:card_id config)
        card    (t2/select-one Card :id card-id)]
    (values-from-card card (:value_field config) query)))
(defn- can-get-card-values?
  [card value-field]
  (boolean
    (and (not (:archived card))
         (some? (qp.util/field->field-info value-field (:result_metadata card))))))

--------------------------------------------- Putting it together ----------------------------------------------

(mu/defn parameter->values :- ms/FieldValuesResult
  "Given a parameter with a custom-values source, return the values.
  `default-case-thunk` is a 0-arity function that returns values list when:
  - :values_source_type = card but the card is archived or the card no longer contains the value-field.
  - :values_source_type = nil."
  [parameter query default-case-thunk]
  (case (:values_source_type parameter)
    "static-list" (static-list-values parameter query)
    "card"        (let [card (t2/select-one Card :id (get-in parameter [:values_source_config :card_id]))]
                    (when-not (mi/can-read? card)
                      (throw (ex-info "You don't have permissions to do that." {:status-code 403})))
                    (if (can-get-card-values? card (get-in parameter [:values_source_config :value_field]))
                      (card-values parameter query)
                      (default-case-thunk)))
    nil           (default-case-thunk)
    (throw (ex-info (tru "Invalid parameter source {0}" (:values_source_type parameter))
                    {:status-code 400
                     :parameter parameter}))))
 

Code related to fetching FieldValues for Fields to populate parameter widgets. Always used by the field values (GET /api/field/:id/values) endpoint; used by the chain filter endpoints under certain circumstances.

(ns metabase.models.params.field-values
  (:require
   [medley.core :as m]
   [metabase.models.field :as field]
   [metabase.models.field-values :as field-values :refer [FieldValues]]
   [metabase.models.interface :as mi]
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.util :as u]
   [toucan2.core :as t2]))

OSS implementation; used as a fallback for the EE implementation if the field isn't sandboxed.

(defn default-get-or-create-field-values-for-current-user!
  [field]
  (field-values/get-or-create-full-field-values! field))

Fetch cached FieldValues for a field, creating them if needed if the Field should have FieldValues.

(defenterprise get-or-create-field-values-for-current-user!*
  metabase-enterprise.sandbox.models.params.field-values
  [field]
  (default-get-or-create-field-values-for-current-user! field))

Whether the current User has permissions to fetch FieldValues for a field.

(defn current-user-can-fetch-field-values?
  [field]
  ;; read permissions for a Field = partial permissions for its parent Table (including EE segmented permissions)
  (mi/can-read? field))

Format a FieldValues to use by params functions. ;; (postprocess-field-values (t2/select-one FieldValues :id 1) (Field 1)) ;; => {:values [[1] [2] [3] [4]] :field_id 1 :hasmorevalues boolean}

(defn- postprocess-field-values
  [field-values field]
  (if field-values
    (-> field-values
        (assoc :values (field-values/field-values->pairs field-values))
        (select-keys [:values :field_id :has_more_values]))
    {:values [], :field_id (u/the-id field), :has_more_values false}))

OSS implementation; used as a fallback for the EE implementation for any fields that aren't subject to sandboxing.

(defn default-field-id->field-values-for-current-user
  [field-ids]
  (when (seq field-ids)
    (not-empty
     (let [fields       (-> (t2/select :model/Field :id [:in (set field-ids)])
                            (field/readable-fields-only)
                            (t2/hydrate :values))
           field-values (->> (map #(select-keys (field-values/get-or-create-full-field-values! %)
                                                [:field_id :human_readable_values :values])
                                  fields)
                             (keep not-empty))]
       (m/index-by :field_id field-values)))))

Fetch existing FieldValues for a sequence of field-ids for the current User. Values are returned as a map of {field-id FieldValues-instance} Returns nil if field-ids is empty of no matching FieldValues exist.

(defenterprise field-id->field-values-for-current-user
  metabase-enterprise.sandbox.models.params.field-values
  [field-ids]
  (default-field-id->field-values-for-current-user field-ids))

+----------------------------------------------------------------------------------------------------------------+ | Advanced FieldValues | +----------------------------------------------------------------------------------------------------------------+

(defn- fetch-advanced-field-values
  [fv-type field constraints]
  {:pre [(field-values/advanced-field-values-types fv-type)]}
  (case fv-type
    :linked-filter
    (do
      (classloader/require 'metabase.models.params.chain-filter)
      (let [{:keys [values has_more_values]} ((resolve 'metabase.models.params.chain-filter/unremapped-chain-filter)
                                              (:id field) constraints {})
            ;; we have a hard limit for how many values we want to store in FieldValues,
            ;; let's make sure we respect that limit here.
            ;; For a more detailed docs on this limt check out [[field-values/distinct-values]]
            limited-values                   (field-values/take-by-length field-values/*total-max-length* values)]
        {:values          limited-values
         :has_more_values (or (> (count values)
                                 (count limited-values))
                              has_more_values)}))
    (field-values/distinct-values field)))

Returns hash-key for Advanced FieldValues by types.

(defn hash-key-for-advanced-field-values
  [fv-type field-id constraints]
  (case fv-type
    :linked-filter
    (field-values/hash-key-for-linked-filters field-id constraints)
    :sandbox
    (field-values/hash-key-for-sandbox field-id)
    :impersonation
    (field-values/hash-key-for-impersonation field-id)))

Fetch and create a FieldValues for field with type fv-type. The humanreadablevalues of Advanced FieldValues will be automatically fixed up based on the list of values and humanreadablevalues of the full FieldValues of the same field.

(defn create-advanced-field-values!
  [fv-type field hash-key constraints]
  (when-let [{wrapped-values :values
              :keys [has_more_values]} (fetch-advanced-field-values fv-type field constraints)]
    (let [;; each value in `wrapped-values` is a 1-tuple, so unwrap the raw values for storage
          values                (map first wrapped-values)
          ;; If the full FieldValues of this field has a human-readable-values, fix it with the new values
          human-readable-values (field-values/fixup-human-readable-values
                                  (t2/select-one FieldValues
                                                 :field_id (:id field)
                                                 :type :full)
                                  values)]
      (first (t2/insert-returning-instances! FieldValues
                                             :field_id (:id field)
                                             :type fv-type
                                             :hash_key hash-key
                                             :has_more_values has_more_values
                                             :human_readable_values human-readable-values
                                             :values values)))))

Fetch an Advanced FieldValues with type fv-type for a field, creating them if needed. If the fetched FieldValues is expired, we delete them then try to create it.

(defn get-or-create-advanced-field-values!
  ([fv-type field]
   (get-or-create-advanced-field-values! fv-type field nil))
  ([fv-type field constraints]
   (let [hash-key (hash-key-for-advanced-field-values fv-type (:id field) constraints)
         fv       (or (t2/select-one FieldValues :field_id (:id field)
                                     :type fv-type
                                     :hash_key hash-key)
                      (create-advanced-field-values! fv-type field hash-key constraints))]
     (cond
       (nil? fv) nil
       ;; If it's expired, delete then try to re-create it
       (field-values/advanced-field-values-expired? fv) (do
                                                          (t2/delete! FieldValues :id (:id fv))
                                                          (recur fv-type field constraints))
       :else fv))))

+----------------------------------------------------------------------------------------------------------------+ | Public functions | +----------------------------------------------------------------------------------------------------------------+

Fetch FieldValues for a field, creating them if needed if the Field should have FieldValues. These are filtered as appropriate for the current User, depending on MB version (e.g. EE sandboxing will filter these values). If the Field has a human-readable values remapping (see documentation at the top of [[metabase.models.params.chain-filter]] for an explanation of what this means), values are returned in the format {:values [[original-value human-readable-value]] :field_id field-id :hasfieldvalues boolean} If the Field does not have human-readable values remapping, values are returned in the format {:values [[value]] :field_id field-id :hasfieldvalues boolean}

(defn get-or-create-field-values-for-current-user!
  [field]
  (-> (get-or-create-field-values-for-current-user!* field)
      (postprocess-field-values field)))

Fetch linked-filter FieldValues for a field, creating them if needed if the Field should have FieldValues. These are filtered as appropriate for the current User, depending on MB version (e.g. EE sandboxing will filter these values). If the Field has a human-readable values remapping (see documentation at the top of [[metabase.models.params.chain-filter]] for an explanation of what this means), values are returned in the format {:values [[original-value human-readable-value]] :field_id field-id :hasfieldvalues boolean} If the Field does not have human-readable values remapping, values are returned in the format {:values [[value]] :field_id field-id :hasfieldvalues boolean}

(defn get-or-create-linked-filter-field-values!
  [field constraints]
  (-> (get-or-create-advanced-field-values! :linked-filter field constraints)
      (postprocess-field-values field)))
 

Low-level Metabase permissions system definition and utility functions.

The Metabase permissions system is based around permissions paths that are granted to individual [[metabase.models.permissions-group]]s.

Core concepts

Permissions are granted to individual [[metabase.models.permissions-group]]s, and Users are members of one or more Permissions Groups. Permissions Groups are like 'roles' in other permissions systems. There are a few 'magic' Permissions Groups: the [[metabase.models.permissions-group/all-users]] Group, of which every User is a member and cannot be removed; and the [[metabase.models.permissions-group/admin]] Group, of which every superuser (i.e., every User with is_superuser) is a member.

The permissions needed to perform an action are represented as slash-delimited path strings, for example /db/1/schema/PUBLIC/. Each slash represents a different part of the permissions path, and each permissions path must start and end with a slash. Permissions use the same path representation for both the permissions required to perform an action and the permissions granted to individual Groups.

Permissions paths use a prefix system where a User is normally allowed to perform any action if one of their Groups has any permissions entry that is a prefix for the permission required to perform that action. For example, if reading Database 1 requires the permission /db/1/read/, then the current User may perform that action if they have /db/1/read/ permissions, or if they have /db/1/, or even full / superuser permissions.

This prefix system allows us to easily and efficiently query the application database to find relevant matching permissions matching an path or path using LIKE; see [[metabase.models.database/pre-delete]] for an example of the sort of efficient queries the prefix system facilitates.

The union of all permissions the current User's gets from all groups of which they are a member are automatically bound to [[metabase.api.common/current-user-permissions-set]] by [[metabase.server.middleware.session/bind-current-user]] for every REST API request, and in other places when queries are ran in a non-API thread (e.g. for scheduled Dashboard Subscriptions).

Different types of permissions

There are two main types of permissions:

  • data permissions -- permissions to view, update, or run ad-hoc or SQL queries against a Database or Table.

  • Collection permissions -- permissions to view/curate/etc. an individual [[metabase.models.collection]] and the items inside it. Collection permissions apply to individual Collections and to any non-Collection items inside that Collection. Child Collections get their own permissions. Many objects such as Cards (a.k.a. Saved Questions) and Dashboards get their permissions from the Collection in which they live.

Enterprise-only permissions and "anti-permissions"

In addition to data permissions and Collection permissions, a User can also be granted four additional types of permissions.

  • root permissions -- permissions for /, i.e. full access for everything. Automatically granted to the [[metabase.models.permissions-group/admin]] group that gets created on first launch. Because / is a prefix for every permissions path, admins have permissions to do everything.

  • segmented permissions -- a special grant for a Table that applies sandboxing, a.k.a. row-level permissions, a.k.a. segmented permissions, to any queries ran by the User when that User does not have full data permissions. Segmented permissions allow a User to run ad-hoc MBQL queries against the Table in question; regardless of whether they have relevant Collection permissions, queries against the sandboxed Table are rewritten to replace the Table itself with a special type of nested query called a [[metabase-enterprise.sandbox.models.group-table-access-policy]], or GTAP. Note that segmented permissions are both additive and subtractive -- they are additive because they grant (sandboxed) ad-hoc query access for a Table, but subtractive in that any access thru a Saved Question will now be sandboxed as well.

    Additional things to know:

    • Sandboxed permissions are only available in Metabase® Enterprise Edition™.

    • Only one GTAP may defined per-Group per-Table (this is an application-DB-level constraint). A User may have multiple applicable GTAPs if they are members of multiple groups that have sandboxed anti-perms for that Table; in that case, the QP signals an error if multiple GTAPs apply to a given Table for the current User (see [[metabase-enterprise.sandbox.query-processor.middleware.row-level-restrictions/assert-one-gtap-per-table]]).

    • Segmented (sandboxing) permissions and GTAPs are tied together, and a Group should be given both (or both should be deleted) at the same time. This is not currently enforced as a hard application DB constraint, but is done in the respective Toucan pre-delete actions. The QP will signal an error if the current user has segmented permissions but no matching GTAP exists.

    • Segmented permissions can also be used to enforce column-level permissions -- any column not returned by the underlying GTAP query is not allowed to be referenced by the parent query thru other means such as filter clauses. See [[metabase-enterprise.sandbox.query-processor.middleware.column-level-perms-check]].

    • GTAPs are not allowed to add columns not present in the original Table, or change their effective type to something incompatible (this constraint is in place so we other things continue to work transparently regardless of whether the Table is swapped out.) See [[metabase-enterprise.sandbox.models.group-table-access-policy/check-columns-match-table]]

  • block "anti-permissions" are per-Group, per-Table grants that tell Metabase to disallow running Saved Questions unless the User has data permissions (in other words, disregard Collection permissions). These are referred to as "anti-permissions" because they are subtractive grants that take away permissions from what the User would otherwise have. See the Determining query permissions section below for more details. As with segmented permissions, block anti-permissions are only available in Metabase® Enterprise Edition™.

  • Application permisisons -- are per-Group permissions that give non-admin users access to features like: change instance's Settings; access Audit, Tools, Troubleshooting ...

Determining CRUD permissions in the REST API

REST API permissions checks are generally done in various metabase.api.* namespaces. Whether the current User can perform various CRUD actions are defined by [[metabase.models.interface/can-read?]] (in the API sense, not in the run-query sense) and [[metabase.models.interface/can-write?]] as well as the newer [[metabase.models.interface/can-create?]] and [[metabase.models.interface/can-update?]] methods. Implementations for these methods live in metabase.model.* namespaces.

The implementation of these methods is up to individual models. The majority of implementations check whether [[metabase.api.common/current-user-permissions-set]] includes permissions for a given path (action) using [[set-has-full-permissions?]], or for a set of paths using [[set-has-full-permissions-for-set?]].

Other implementations check whether a user has partial permissions for a path or set using [[set-has-partial-permissions?]] or [[set-has-partial-permissions-for-set?]]. Partial permissions means that the User has permissions for some subpath of the path in question, e.g. /db/1/read/ is considered to be partial permissions for /db/1/. For example the [[metabase.models.interface/can-read?]] implementation for Database checks whether the current User has any permissions for that Database; a User can fetch Database 1 from API endpoints ("read" it) if they have any permissions starting with /db/1/, for example /db/1/ itself (full permissions) /db/1/native/ (ad-hoc SQL query permissions) or permissions, or /db/1/schema/PUBLIC/table/2/query/ (run ad-hoc queries against Table 2 permissions).

Determining query permissions

Normally, a User is allowed to view (i.e., run the query for) a Saved Question if they have read permissions for the Collection in which Saved Question lives, or if they have data permissions for the Database and Table(s) the Question accesses. The main idea here is that some Users with more permissions can go create a curated set of Saved Questions they deem appropriate for less-privileged Users to see, and put them in a Collection they can see. These Users would still be prevented from poking around things on their own, however.

The Query Processor middleware in [[metabase.query-processor.middleware.permissions]], [[metabase-enterprise.sandbox.query-processor.middleware.row-level-restrictions]], and [[metabase-enterprise.advanced-permissions.models.permissions.block-permissions]] determines whether the current User has permissions to run the current query. Permissions are as follows:

| Data perms? | Coll perms? | Block? | Segmented? | Can run? | | ----------- | ----------- | ------ | ---------- | -------- | | no | no | no | no | ⛔ | | no | no | no | yes | ⚠️ | | no | no | yes | no | ⛔ | | no | no | yes | yes | ⚠️ | | no | yes | no | no | ✅ | | no | yes | no | yes | ⚠️ | | no | yes | yes | no | ⛔ | | no | yes | yes | yes | ⚠️ | | yes | no | no | no | ✅ | | yes | no | no | yes | ✅ | | yes | no | yes | no | ✅ | | yes | no | yes | yes | ✅ | | yes | yes | no | no | ✅ | | yes | yes | no | yes | ✅ | | yes | yes | yes | no | ✅ | | yes | yes | yes | yes | ✅ |

(⚠️ = runs in sandboxed mode)

Known Permissions Paths

See [[path-regex-v1]] for an always-up-to-date list of permissions paths.

/collection/:id/ ; read-write perms for a Coll and its non-Coll children /collection/:id/read/ ; read-only perms for a Coll and its non-Coll children /collection/root/ ; read-write perms for the Root Coll and its non-Coll children /colllection/root/read/ ; read-only perms for the Root Coll and its non-Coll children /collection/namespace/:namespace/root/ ; read-write perms for the Root Coll of a non-default namespace (e.g. SQL Snippets) /collection/namespace/:namespace/root/read/ ; read-only perms for the Root Coll of a non-default namespace (e.g. SQL Snippets) /db/:id/ ; full perms for a Database /db/:id/native/ ; ad-hoc native query perms for a Database /db/:id/schema/ ; ad-hoc MBQL query perms for all schemas in DB (does not include native queries) /db/:id/schema/:name/ ; ad-hoc MBQL query perms for a specific schema /db/:id/schema/:name/table/:id/ ; full perms for a Table /db/:id/schema/:name/table/:id/read/ ; perms to fetch info about this Table from the DB /db/:id/schema/:name/table/:id/query/ ; ad-hoc MBQL query perms for a Table /db/:id/schema/:name/table/:id/query/segmented/ ; allow ad-hoc MBQL queries. Sandbox all queries against this Table. /block/db/:id/ ; disallow queries against this DB unless User has data perms. / ; full root perms

(ns metabase.models.permissions
  (:require
   [clojure.data :as data]
   [clojure.string :as str]
   [clojure.walk :as walk]
   [malli.core :as mc]
   [medley.core :as m]
   [metabase.api.common :refer [*current-user-id*]]
   [metabase.api.permission-graph :as api.permission-graph]
   [metabase.config :as config]
   [metabase.models.interface :as mi]
   [metabase.models.permissions-group :as perms-group]
   [metabase.models.permissions-revision
    :as perms-revision
    :refer [PermissionsRevision]]
   [metabase.models.permissions.parse :as perms-parse]
   [metabase.permissions.util :as perms.u]
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings.premium-features
    :as premium-features
    :refer [defenterprise]]
   [metabase.util :as u]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

+----------------------------------------------------------------------------------------------------------------+ | UTIL FNS | +----------------------------------------------------------------------------------------------------------------+

-------------------------------------------------- Dynamic Vars --------------------------------------------------

Should we allow permissions entries like /? By default, this is disallowed, but you can temporarily disable it here when creating the default entry for Admin.

(def ^:dynamic ^Boolean *allow-root-entries*
  false)

Should we allow changes to be made to permissions belonging to the Admin group? By default this is disabled to prevent accidental tragedy, but you can enable it here when creating the default entry for Admin.

(def ^:dynamic ^Boolean *allow-admin-permissions-changes*
  false)

--------------------------------------------------- Assertions ---------------------------------------------------

Check to make sure the :group_id for permissions entry isn't the admin group.

(defn- assert-not-admin-group
  [{:keys [group_id]}]
  (when (and (= group_id (:id (perms-group/admin)))
             (not *allow-admin-permissions-changes*))
    (throw (ex-info (tru "You cannot create or revoke permissions for the ''Admin'' group.")
             {:status-code 400}))))

Check to make sure the value of :object for permissions entry is valid.

(defn- assert-valid-object
  [{:keys [object]}]
  (when (and object
             (not (perms.u/valid-path? object))
             (or (not= object "/")
                 (not *allow-root-entries*)))
    (throw (ex-info (tru "Invalid permissions object path: ''{0}''." object)
             {:status-code 400, :path object}))))

Check to make sure this permissions entry is something that's allowed to be saved (i.e. it has a valid :object path and it's not for the admin group).

(defn- assert-valid
  [permissions]
  (doseq [f [assert-not-admin-group
             assert-valid-object]]
    (f permissions)))

------------------------------------------------- Path Util Fns --------------------------------------------------

(def ^:private MapOrID
  [:or :map ms/PositiveInt])
(mu/defn data-perms-path :- perms.u/PathSchema
  "Return the [readwrite] permissions path for a Database, schema, or Table. (At the time of this writing, DBs and
  schemas don't have separate `read/` and write permissions; you either have 'data access' permissions for them, or
  you don't. Tables, however, have separate read and write perms.)"
  ([database-or-id :- MapOrID]
   (str "/db/" (u/the-id database-or-id) "/"))
  ([database-or-id :- MapOrID schema-name :- [:maybe :string]]
   (str (data-perms-path database-or-id) "schema/" (perms.u/escape-path-component schema-name) "/"))
  ([database-or-id :- MapOrID schema-name :- [:maybe :string] table-or-id :- MapOrID]
   (str (data-perms-path database-or-id schema-name) "table/" (u/the-id table-or-id) "/")))
(mu/defn adhoc-native-query-path :- perms.u/PathSchema
  "Return the native query read/write permissions path for a database.
   This grants you permissions to run arbitary native queries."
  [database-or-id :- MapOrID]
  (str (data-perms-path database-or-id) "native/"))
(mu/defn all-schemas-path :- perms.u/PathSchema
  "Return the permissions path for a database that grants full access to all schemas."
  [database-or-id :- MapOrID]
  (str (data-perms-path database-or-id) "schema/"))
(mu/defn collection-readwrite-path :- perms.u/PathSchema
  "Return the permissions path for *readwrite* access for a `collection-or-id`."
  [collection-or-id :- MapOrID]
  (if-not (get collection-or-id :metabase.models.collection.root/is-root?)
    (format "/collection/%d/" (u/the-id collection-or-id))
    (if-let [collection-namespace (:namespace collection-or-id)]
      (format "/collection/namespace/%s/root/" (perms.u/escape-path-component (u/qualified-name collection-namespace)))
      "/collection/root/")))
(mu/defn collection-read-path :- perms.u/PathSchema
  "Return the permissions path for *read* access for a `collection-or-id`."
  [collection-or-id :- MapOrID]
  (str (collection-readwrite-path collection-or-id) "read/"))
(mu/defn table-read-path :- perms.u/PathSchema
  "Return the permissions path required to fetch the Metadata for a Table."
  ([table-or-id]
   (if (integer? table-or-id)
     (recur (t2/select-one ['Table :db_id :schema :id] :id table-or-id))
     (table-read-path (:db_id table-or-id) (:schema table-or-id) table-or-id)))
  ([database-or-id schema-name table-or-id]
   {:post [(perms.u/valid-path? %)]}
   (str (data-perms-path (u/the-id database-or-id) schema-name (u/the-id table-or-id)) "read/")))
(mu/defn table-query-path :- perms.u/PathSchema
  "Return the permissions path for *full* query access for a Table. Full query access means you can run any (MBQL) query
  you wish against a given Table, with no GTAP-specified mandatory query alterations."
  ([table-or-id]
   (if (integer? table-or-id)
     (recur (t2/select-one ['Table :db_id :schema :id] :id table-or-id))
     (table-query-path (:db_id table-or-id) (:schema table-or-id) table-or-id)))
  ([database-or-id schema-name table-or-id]
   (str (data-perms-path (u/the-id database-or-id) schema-name (u/the-id table-or-id)) "query/")))
(mu/defn table-sandboxed-query-path :- perms.u/PathSchema
  "Return the permissions path for *segmented* query access for a Table. Segmented access means running queries against
  the Table will automatically replace the Table with a GTAP-specified question as the new source of the query,
  obstensibly limiting access to the results."
  ([table-or-id]
   (if (integer? table-or-id)
     (recur (t2/select-one ['Table :db_id :schema :id] :id table-or-id))
     (table-sandboxed-query-path (:db_id table-or-id) (:schema table-or-id) table-or-id)))
  ([database-or-id schema-name table-or-id]
   (str (data-perms-path (u/the-id database-or-id) schema-name (u/the-id table-or-id)) "query/segmented/")))
(mu/defn database-block-perms-path :- perms.u/PathSchema
  "Return the permissions path for the Block 'anti-permissions'. Block anti-permissions means a User cannot run a query
  against a Database unless they have data permissions, regardless of whether segmented permissions would normally give
  them access or not."
  [database-or-id :- MapOrID]
  (str "/block" (data-perms-path database-or-id)))
(mu/defn base->feature-perms-path :- perms.u/PathSchema
  "Returns the permissions path to use for a given permission type (e.g. download) and value (e.g. full or limited),
  given the 'base' permissions path for an entity (the base path is equivalent to the one used for data access
  permissions)."
  [perm-type perm-value base-path]
  (case [perm-type perm-value]
    [:download :full]
    (str "/download" base-path)
    [:download :limited]
    (str "/download/limited" base-path)
    [:data-model :all]
    (str "/data-model" base-path)
    [:details :yes]
    (str "/details" base-path)
    [:execute :all]
    (str "/execute" base-path)))
(mu/defn feature-perms-path :- perms.u/PathSchema
  "Returns the permissions path to use for a given feature-level permission type (e.g. download) and value (e.g. full
  or limited), for a database, schema or table."
  [perm-type perm-value & path-components]
  (base->feature-perms-path perm-type perm-value (apply data-perms-path path-components)))
(mu/defn native-feature-perms-path :- perms.u/PathSchema
  "Returns the native permissions path to use for a given feature-level permission type (e.g. download) and value
  (e.g. full or limited)."
  [perm-type perm-value database-or-id]
  (base->feature-perms-path perm-type perm-value (adhoc-native-query-path database-or-id)))
(mu/defn data-model-write-perms-path :- perms.u/PathSchema
  "Returns the permission path required to edit the table specified by the provided args, or a field in the table.
  If Enterprise Edition code is available, and a valid :advanced-permissions token is present, returns the data model
  permissions path for the table. Otherwise, defaults to the root path ('/'), thus restricting writes to admins."
  [& path-components]
  (let [f (when config/ee-available?
            (classloader/require 'metabase-enterprise.advanced-permissions.models.permissions)
            (resolve 'metabase-enterprise.advanced-permissions.models.permissions/data-model-write-perms-path))]
    (if (and f (premium-features/enable-advanced-permissions?))
      (apply f path-components)
      "/")))
(mu/defn db-details-write-perms-path :- perms.u/PathSchema
  "Returns the permission path required to edit the table specified by the provided args, or a field in the table.
  If Enterprise Edition code is available, and a valid :advanced-permissions token is present, returns the DB details
  permissions path for the table. Otherwise, defaults to the root path ('/'), thus restricting writes to admins."
  [db-id]
  (let [f (when config/ee-available?
            (classloader/require 'metabase-enterprise.advanced-permissions.models.permissions)
            (resolve 'metabase-enterprise.advanced-permissions.models.permissions/db-details-write-perms-path))]
    (if (and f (premium-features/enable-advanced-permissions?))
      (f db-id)
      "/")))
(mu/defn application-perms-path :- perms.u/PathSchema
  "Returns the permissions path for *full* access a application permission."
  [perm-type]
  (case perm-type
    :setting
    "/application/setting/"
    :monitoring
    "/application/monitoring/"
    :subscription
    "/application/subscription/"))

-------------------------------------------- Permissions Checking Fns --------------------------------------------

Does permissions-path grant full access for path?

(defn is-permissions-for-object?
  [permissions-path path]
  (str/starts-with? path permissions-path))

Does permissions-path grant access full access for path or for a descendant of path?

(defn is-partial-permissions-for-object?
  [permissions-path path]
  (or (is-permissions-for-object? permissions-path path)
      (str/starts-with? permissions-path path)))

Does permissions-set grant full access to object with path?

(defn set-has-full-permissions?
  ^Boolean [permissions-set path]
  (boolean (some #(is-permissions-for-object? % path) permissions-set)))

Does permissions-set grant access full access to object with path or to a descendant of it?

(defn set-has-partial-permissions?
  ^Boolean [permissions-set path]
  (boolean (some #(is-partial-permissions-for-object? % path) permissions-set)))
(mu/defn set-has-full-permissions-for-set? :- :boolean
  "Do the permissions paths in `permissions-set` grant *full* access to all the object paths in `paths-set`?"
  [permissions-set paths-set]
  (every? (partial set-has-full-permissions? permissions-set)
          paths-set))
(mu/defn set-has-partial-permissions-for-set? :- :boolean
  "Do the permissions paths in `permissions-set` grant *partial* access to all the object paths in `paths-set`?
   (`permissions-set` must grant partial access to *every* object in `paths-set` set)."
  [permissions-set paths-set]
  (every? (partial set-has-partial-permissions? permissions-set)
          paths-set))
(mu/defn set-has-any-native-query-permissions? :- :boolean
  "Do the permission paths in `permission-set` grant native query access to any database?"
  [permissions-set]
  (boolean
    ;; Matches "/", "/db/:id/", or "/db/:id/native/"
    (some
     #(first (re-find #"^/(db/\d+/(native/)?)?$" %))
     permissions-set)))
(mu/defn set-has-application-permission-of-type? :- :boolean
  "Does `permissions-set` grant *full* access to a application permission of type `perm-type`?"
  [permissions-set perm-type]
  (set-has-full-permissions? permissions-set (application-perms-path perm-type)))
(mu/defn perms-objects-set-for-parent-collection :- [:set perms.u/PathSchema]
  "Implementation of `perms-objects-set` for models with a `collection_id`, such as Card, Dashboard, or Pulse.
  This simply returns the `perms-objects-set` of the parent Collection (based on `collection_id`) or for the Root
  Collection if `collection_id` is `nil`."
  ([this read-or-write]
   (perms-objects-set-for-parent-collection nil this read-or-write))
  ([collection-namespace :- [:maybe ms/KeywordOrString]
    this                 :- [:map
                             [:collection_id [:maybe ms/PositiveInt]]]
    read-or-write        :- [:enum :read :write]]
   ;; based on value of read-or-write determine the approprite function used to calculate the perms path
   (let [path-fn (case read-or-write
                   :read  collection-read-path
                   :write collection-readwrite-path)]
     ;; now pass that function our collection_id if we have one, or if not, pass it an object representing the Root
     ;; Collection
     #{(path-fn (or (:collection_id this)
                    {:metabase.models.collection.root/is-root? true
                     :namespace                                collection-namespace}))})))
(doto ::use-parent-collection-perms
  (derive ::mi/read-policy.full-perms-for-perms-set)
  (derive ::mi/write-policy.full-perms-for-perms-set))
(defmethod mi/perms-objects-set ::use-parent-collection-perms
  [instance read-or-write]
  (perms-objects-set-for-parent-collection instance read-or-write))

+----------------------------------------------------------------------------------------------------------------+ | ENTITY + LIFECYCLE | +----------------------------------------------------------------------------------------------------------------+

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase.

(def Permissions
  :model/Permissions)
(methodical/defmethod t2/table-name :model/Permissions [_model] :permissions)
(derive :model/Permissions :metabase/model)
(t2/define-before-insert :model/Permissions
  [permissions]
  (u/prog1 permissions
    (assert-valid permissions)
    (log/debug (u/colorize 'green (trs "Granting permissions for group {0}: {1}"
                                       (:group_id permissions)
                                       (:object permissions))))))
(t2/define-before-update :model/Permissions
  [_]
  (throw (Exception. (tru "You cannot update a permissions entry! Delete it and create a new one."))))
(t2/define-before-delete :model/Permissions
  [permissions]
  (log/debug (u/colorize 'red (trs "Revoking permissions for group {0}: {1}"
                                   (:group_id permissions)
                                   (:object permissions))))
  (assert-not-admin-group permissions))

+----------------------------------------------------------------------------------------------------------------+ | GRAPH SCHEMA | +----------------------------------------------------------------------------------------------------------------+

The stuff below is all for the data permissions graph. We have a separate graph for Collection permissions, and code to work with it lives in [[metabase.models.collection.graph]].

TODO - there is so much stuff related to the perms graph I think we should really move it into a separate metabase.models.permissions.graph.data namespace or something and move the collections graph from [[metabase.models.collection.graph]] to metabase.models.permissions.graph.collection (?)

(def ^:private TablePermissionsGraph
  [:or
   {:error/message "Valid perms graph for a Table"}
   [:enum :none :all]
   [:and
    [:map
     [:read  {:optional true} [:enum :all :none]]
     [:query {:optional true} [:enum :all :segmented :none]]]
    [:fn
     {:error/message "non-empty map"}
     not-empty]]])
(def ^:private SchemaPermissionsGraph
  [:or
   {:error/message "Valid perms graph for a schema"}
   [:enum :none :all]
   [:map-of ms/PositiveInt TablePermissionsGraph]])
(def ^:private NativePermissionsGraph
  [:enum {:error/message "Valid native perms option for a database"} :write :none])

Schema for execution permission values.

(def ExecutePermissions
  [:enum {:error/message "Valid execute perms option type"} :all :none])

The "Strict" versions of the various graphs below are intended for schema checking when updating the permissions graph. In other words, we shouldn't be stopped from returning the graph if it violates the "strict" rules, but we should refuse to update the graph unless it matches the strict schema.

TODO - It might be possible at some point in the future to just use the strict versions everywhere

TODO -- instead of doing schema validation, why don't we just throw an Exception so the API responses are actually somewhat useful?

(def ^:private DownloadTablePermissionsGraph
  [:enum {:error/message "Valid download perms graph for a table"} :full :limited :none])
(def ^:private DownloadSchemaPermissionsGraph
  [:or
   {:error/message "Valid download perms graph for a schema"}
   [:enum :full :limited :none]
   [:map-of ms/PositiveInt DownloadTablePermissionsGraph]])
(def ^:private DownloadNativePermissionsGraph
  [:enum {:error/message "Valid download perms option for native queries over a database"} :full :limited :none])

Schema for a download permissions graph, used in [[metabase-enterprise.advanced-permissions.models.permissions]].

(def DownloadPermissionsGraph
  [:map
   {:error/message "Valid download perms graph for a database"}
   [:native  {:optional true} DownloadNativePermissionsGraph]
   [:schemas {:optional true} [:or
                               [:enum :full :limited :none]
                               [:map-of :string DownloadSchemaPermissionsGraph]]]])
(def ^:private DataModelTablePermissionsGraph
  [:enum {:error/message "Valid data model perms graph for a table"} :all :none])
(def ^:private DataModelSchemaPermissionsGraph
  [:or
   {:error/message "Valid data model perms graph for a schema"}
   [:enum :all :none]
   [:map-of ms/PositiveInt DataModelTablePermissionsGraph]])

Schema for a data model permissions graph, used in [[metabase-enterprise.advanced-permissions.models.permissions]].

(def DataModelPermissionsGraph
  [:map
   {:error/message "Valid data model perms graph for a database"}
   [:schemas [:or
              [:enum :all :none]
              [:map-of :string DataModelSchemaPermissionsGraph]]]])

Schema for a database details permissions, used in [[metabase-enterprise.advanced-permissions.models.permissions]].

(def DetailsPermissions
  [:enum {:error/message "Valid details perms graph for a database"} :yes :no])
(def ^:private ExecutionGroupPermissionsGraph
  [:or
   ExecutePermissions
   [:map-of ms/PositiveInt ExecutePermissions]])
(def ^:private ExecutionPermissionsGraph
  [:map
   [:revision :int]
   [:groups   [:map-of ms/PositiveInt ExecutionGroupPermissionsGraph]]])

+----------------------------------------------------------------------------------------------------------------+ | GRAPH FETCH | +----------------------------------------------------------------------------------------------------------------+

Handle '/' permission

(defn- all-permissions
  [db-ids]
  (into {}
        (map (fn [db-id]
               [db-id {:data       {:native :write :schemas :all}
                       :download   {:native :full  :schemas :full}
                       :data-model {               :schemas :all}
                       :details :yes}])
             db-ids)))
(defn- permissions-by-group-ids [where-clause]
  (let [permissions (t2/select [Permissions [:group_id :group-id] [:object :path]]
                      {:where where-clause})]
    (reduce (fn [m {:keys [group-id path]}]
              (update m group-id conj path))
            {}
            permissions)))

Augment the permissions graph with active connection impersonation policies. OSS implementation returns graph as-is.

(defenterprise add-impersonations-to-permissions-graph
  metabase-enterprise.advanced-permissions.models.connection-impersonation
  [graph]
  graph)
(defn- post-process-graph [graph]
  (->>
   graph
   (walk/postwalk-replace {{:query {:schemas :all}}             {:query {:schemas :all :native :none}}
                           {:query {:schemas :all :native nil}} {:query {:schemas :all :native :none}}})))
(mu/defn generate-graph :- :map
  "Used to generation permission graph from parsed permission paths of v1 and v2 permission graphs for the api layer."
  [db-ids group-id->paths :- [:map-of :int [:* perms.u/Path]]]
  (->> group-id->paths
       (m/map-vals
        (fn [paths]
          (let [permissions-graph (perms-parse/->graph paths)]
            (if (= permissions-graph :all)
              (all-permissions db-ids)
              (:db permissions-graph)))))
       post-process-graph
       add-impersonations-to-permissions-graph))

keep v1 paths, implicitly remove v2

(defn ->v1-paths
  [group-id->permissions]
  (m/map-vals (fn [paths]
                (filter (fn [path] (mc/validate [:re perms.u/path-regex-v1] path)) paths))
              group-id->permissions))

Fetch a graph representing the current data permissions status for every Group and all permissioned databases. See [[metabase.models.collection.graph]] for the Collection permissions graph code. Keeps v1 paths, hence implictly removes v2 paths.

What are v1 and v2 permissions? see: [[classify-path]]. In summary:

   v1 permissions

|--------------------------------| | | v1-data, block | all-other-paths | v2-data, v2-query | | |-----------------------------------| v2 permissions

(defn data-perms-graph
  []
  (let [db-ids             (delay (t2/select-pks-set 'Database))
        group-id->v1-paths (->> (permissions-by-group-ids [:or
                                                           [:= :object (h2x/literal "/")]
                                                           [:like :object (h2x/literal "%/db/%")]])
                                ->v1-paths)]
    {:revision (perms-revision/latest-id)
     :groups   (generate-graph @db-ids group-id->v1-paths)}))

Efficiently returns a data permissions graph, which has all the permissions info for db-id.

(defn data-graph-for-db
  [db-id]
  (let [group-id->permissions (permissions-by-group-ids [:like :object (h2x/literal (str "%/db/" db-id "/%"))])
        group-id->v1-paths (->v1-paths group-id->permissions)]
    {:revision (perms-revision/latest-id)
     :groups (generate-graph [db-id] group-id->v1-paths)}))

Efficiently returns a data permissions graph, which has all the permissions info for the permission group at group-id.

(defn data-graph-for-group
  [group-id]
  (let [db-ids (t2/select-pks-set :model/Database)
        group-id->permissions (permissions-by-group-ids [:= :group_id group-id])
        group-id->paths (select-keys (->v1-paths group-id->permissions) [group-id])]
    {:revision (perms-revision/latest-id)
     :groups (generate-graph db-ids group-id->paths)}))

Fetch a graph representing the current data permissions status for every Group and all permissioned databases. See [[metabase.models.collection.graph]] for the Collection permissions graph code. This version of data-perms-graph removes v1 paths, implicitly keeping Only v2 style paths.

What are v1 and v2 permissions? see: [[classify-path]]. In summary:

   v1 permissions

|--------------------------------| | | v1-data, block | all-other-paths | v2-data, v2-query | | |-----------------------------------| v2 permissions

(defn data-perms-graph-v2
  []
  (let [db-ids             (delay (t2/select-pks-set 'Database))
        group-id->v2-paths (->> (permissions-by-group-ids [:or
                                                           [:= :object (h2x/literal "/")]
                                                           [:like :object (h2x/literal "%/db/%")]])
                                (m/map-vals (fn [paths]
                                              ;; remove v1 paths, implicitly keep v2 paths
                                              (remove (fn [path] (mc/validate perms.u/DataPath path))
                                                      paths))))]
    {:revision (perms-revision/latest-id)
     :groups   (generate-graph @db-ids group-id->v2-paths)}))

Fetch a graph representing the current execution permissions status for every Group and all permissioned databases.

(defn execution-perms-graph
  []
  (let [group-id->paths (permissions-by-group-ids [:or
                                                   [:= :object (h2x/literal "/")]
                                                   [:like :object (h2x/literal "/execute/%")]])
        group-id->graph (m/map-vals
                         (fn [paths]
                           (let [permissions-graph (perms-parse/->graph paths)]
                             (if (#{:all {:execute :all}} permissions-graph)
                               :all
                               (:execute permissions-graph))))
                         group-id->paths)]
    {:revision (perms-revision/latest-id)
     :groups   group-id->graph}))

+----------------------------------------------------------------------------------------------------------------+ | GRAPH UPDATE | +----------------------------------------------------------------------------------------------------------------+

--------------------------------------------------- Helper Fns ---------------------------------------------------

Delete all 'related' permissions for group-or-id (i.e., perms that grant you full or partial access to path). This includes both ancestor and descendant paths. For example:

Suppose we asked this functions to delete related permssions for /db/1/schema/PUBLIC/. Depending on the permissions the group has, it could end up doing something like:

  • deleting /db/1/ permissions (because the ancestor perms implicity grant you full perms for schema/PUBLIC)
  • deleting perms for /db/1/schema/PUBLIC/table/2/ (because Table 2 is a descendant of schema/PUBLIC)

In short, it will delete any permissions that contain /db/1/schema/ as a prefix, or that themeselves are prefixes for /db/1/schema/.

You can optionally include other-conditions, which are anded into the filter clause, to further restrict what is deleted.

NOTE: This function is meant for internal usage in this namespace only; use one of the other functions like revoke-data-perms! elsewhere instead of calling this directly.

(mu/defn delete-related-permissions!
  {:style/indent 2}
  [group-or-id :- [:or :map ms/PositiveInt] path :- perms.u/PathSchema & other-conditions]
  (let [paths (conj (perms.u/->v2-path path) path)
        where {:where (apply list
                             :and
                             [:= :group_id (u/the-id group-or-id)]
                             (into [:or
                                    [:like path (h2x/concat :object (h2x/literal "%"))]]
                                   (map (fn [path-form] [:like :object (str path-form "%")])
                                        paths))
                             other-conditions)}]
    (when-let [revoked (t2/select-fn-set :object Permissions where)]
      (log/debug (u/format-color 'red "Revoking permissions for group %d: %s" (u/the-id group-or-id) revoked))
      (t2/delete! Permissions where))))

Revoke all permissions for group-or-id to object with path-components, including related permissions (i.e, permissions that grant full or partial access to the object in question).

(revoke-data-perms! my-group my-db)

TODO: rename this function to revoke-permissions! and make its behavior consistent with grant-permissions!

(defn revoke-data-perms!
  {:arglists '([group-or-id database-or-id]
               [group-or-id database-or-id schema-name]
               [group-or-id database-or-id schema-name table-or-id])}
  [group-or-id & path-components]
  (delete-related-permissions! group-or-id (apply data-perms-path path-components)))

Revoke all full and limited download permissions for group-or-id to object with path-components.

(defn revoke-download-perms!
  {:arglists '([group-id db-id]
               [group-id db-id schema-name]
               [group-id db-id schema-name table-or-id])}
  [group-or-id & path-components]
  (delete-related-permissions! group-or-id (apply (partial feature-perms-path :download :full) path-components))
  (delete-related-permissions! group-or-id (apply (partial feature-perms-path :download :limited) path-components)))

Grant permissions for group-or-id and return the inserted permissions. Two-arity grants any arbitrary Permissions path. With > 2 args, grants the data permissions from calling [[data-perms-path]].

(defn grant-permissions!
  ([group-or-id db-id schema & more]
   (grant-permissions! group-or-id (apply data-perms-path db-id schema more)))
  ([group-or-id path]
   ;; TEMPORARY HACK: v2 paths won't be in the graph, so they will not be seen in the old graph, so will be
   ;; interpreted as being new, and hence will not get deleted.
   ;; But we can simply delete them here:
   ;; This must be pulled out once the frontend is sending up a proper v2 graph.
   (t2/delete! Permissions :group_id (u/the-id group-or-id) :object [:like "/query/%"])
   (t2/delete! Permissions :group_id (u/the-id group-or-id) :object [:like "/data/%"])
   (try
     (t2/insert-returning-instances! Permissions
                                     (map (fn [path-object]
                                            {:group_id (u/the-id group-or-id) :object path-object})
                                          (distinct (conj (perms.u/->v2-path path) path))))
     ;; on some occasions through weirdness we might accidentally try to insert a key that's already been inserted
     (catch Throwable e
       (log/error e (u/format-color 'red (tru "Failed to grant permissions")))
       ;; if we're running tests, we're doing something wrong here if duplicate permissions are getting assigned,
       ;; mostly likely because tests aren't properly cleaning up after themselves, and possibly causing other tests
       ;; to pass when they shouldn't. Don't allow this during tests
       (when config/is-test?
         (throw e))))))

Revoke all native query permissions for group-or-id to database with database-id.

(defn revoke-native-permissions!
  [group-or-id database-or-id]
  (delete-related-permissions! group-or-id (adhoc-native-query-path database-or-id)))

Grant full readwrite permissions for group-or-id to database with database-id.

(defn grant-native-readwrite-permissions!
  [group-or-id database-or-id]
  (grant-permissions! group-or-id (adhoc-native-query-path database-or-id)))
(defn- group-has-native-perms?
  [group-or-id database-or-id]
  (set-has-full-permissions?
   (t2/select-fn-set :object Permissions :group_id (u/the-id group-or-id))
   (adhoc-native-query-path database-or-id)))

Remove all permissions entries for a DB and any child objects. This does not revoke native permissions; use revoke-native-permssions! to do that.

(defn revoke-db-schema-permissions!
  [group-or-id database-or-id]
  (let [has-native-perms? (group-has-native-perms? group-or-id database-or-id)]
    (delete-related-permissions! group-or-id (data-perms-path database-or-id)
      [:not= :object (adhoc-native-query-path database-or-id)])
    ;; If we've removed native perms as a consequence of deleting a root database path like `/db/1/`, add them back
    (when (and has-native-perms? (not (group-has-native-perms? group-or-id database-or-id)))
      (grant-native-readwrite-permissions! group-or-id database-or-id))))

ID of Audit DB which is loaded when running an EE build. ID is placed in OSS code to facilitate permission checks.

(def audit-db-id
  13371337)

OSS implementation of audit-db/default-audit-collection, which is an enterprise feature, so does nothing in the OSS version.

(defenterprise default-audit-collection
  metabase-enterprise.audit-db [] nil)

OSS implementation of audit-db/default-custom-reports-collection, which is an enterprise feature, so does nothing in the OSS version.

(defenterprise default-custom-reports-collection
  metabase-enterprise.audit-db [] ::noop)

Check that the changes coming in does not attempt to change audit database permission. Admins should change these permissions in application monitoring permissions.

(defn check-audit-db-permissions
  [changes]
  (let [changes-ids (->> changes
                         vals
                         (map keys)
                         (apply concat))]
    (when (some #{audit-db-id} changes-ids)
      (throw (ex-info (tru
                       (str "Audit database permissions can only be changed by updating audit collection permissions."))
                      {:status-code 400})))))

SQL clause to filter namespaces depending on if audit app is enabled or not, and if the namespace is the default one.

(defn audit-namespace-clause
  [namespace-keyword namespace-val]
  (if (and (nil? namespace-val) (premium-features/enable-audit-app?))
    [:or [:= namespace-keyword nil] [:= namespace-keyword "analytics"]]
    [:= namespace-keyword namespace-val]))

Check if an id is one of the audit collection ids.

(defn is-collection-id-audit?
  [id]
  (contains? (set [(:id (default-audit-collection)) (:id (default-custom-reports-collection))]) id))

Check if an instance's parent collection is the audit collection.

(defn is-parent-collection-audit?
  [instance]
  (let [parent-id (:collection_id instance)]
    (and (some? parent-id) (is-collection-id-audit? parent-id))))

Audit instances should only be fetched if audit app is enabled.

(defn can-read-audit-helper
  [model instance]
  (if (and (not (premium-features/enable-audit-app?))
           (case model
             :model/Collection (is-collection-id-audit? (:id instance))
             (is-parent-collection-audit? instance)))
    false
    (case model
      :model/Collection (mi/current-user-has-full-permissions? :read instance)
      (mi/current-user-has-full-permissions? (perms-objects-set-for-parent-collection instance :read)))))

Remove all permissions entries for a Group to access a Application permisisons

(defn revoke-application-permissions!
  [group-or-id perm-type]
  (delete-related-permissions! group-or-id (application-perms-path perm-type)))

Grant full permissions for all schemas belonging to this database. This does not grant native permissions; use grant-native-readwrite-permissions! to do that.

(defn grant-permissions-for-all-schemas!
  [group-or-id database-or-id]
  (grant-permissions! group-or-id (all-schemas-path database-or-id)))

Grant full access to the database, including all schemas and readwrite native access.

(defn grant-full-data-permissions!
  [group-or-id database-or-id]
  (grant-permissions! group-or-id (data-perms-path database-or-id)))

Grant full download permissions to the database.

(defn grant-full-download-permissions!
  [group-or-id database-or-id]
  (grant-permissions! group-or-id (feature-perms-path :download :full database-or-id)))

Grant full permissions for a group to access a Application permisisons.

(defn grant-application-permissions!
  [group-or-id perm-type]
  (grant-permissions! group-or-id (application-perms-path perm-type)))
(defn- is-personal-collection-or-descendant-of-one? [collection]
  (classloader/require 'metabase.models.collection)
  ((resolve 'metabase.models.collection/is-personal-collection-or-descendant-of-one?) collection))

Check whether collection-or-id refers to a Personal Collection; if so, throw an Exception. This is done because we should never be editing granting/etc. permissions for Personal Collections to entire Groups! Their owner will get implicit permissions automatically, and of course admins will be able to see them,but a whole group should never be given some sort of access.

(mu/defn ^:private check-not-personal-collection-or-descendant
  [collection-or-id :- MapOrID]
  ;; don't apply this check to the Root Collection, because it's never personal
  (when-not (:metabase.models.collection.root/is-root? collection-or-id)
    ;; ok, once we've confirmed this isn't the Root Collection, see if it's in the DB with a personal_owner_id
    (let [collection (if (map? collection-or-id)
                       collection-or-id
                       (or (t2/select-one 'Collection :id (u/the-id collection-or-id))
                           (throw (ex-info (tru "Collection does not exist.") {:collection-id (u/the-id collection-or-id)}))))]
      (when (is-personal-collection-or-descendant-of-one? collection)
        (throw (Exception. (tru "You cannot edit permissions for a Personal Collection or its descendants.")))))))

Revoke all access for group-or-id to a Collection.

(mu/defn revoke-collection-permissions!
  [group-or-id :- MapOrID collection-or-id :- MapOrID]
  (check-not-personal-collection-or-descendant collection-or-id)
  (delete-related-permissions! group-or-id (collection-readwrite-path collection-or-id)))

Grant full access to a Collection, which means a user can view all Cards in the Collection and add/remove Cards.

(mu/defn grant-collection-readwrite-permissions!
  [group-or-id :- MapOrID collection-or-id :- MapOrID]
  (check-not-personal-collection-or-descendant collection-or-id)
  (grant-permissions! (u/the-id group-or-id) (collection-readwrite-path collection-or-id)))

Grant read access to a Collection, which means a user can view all Cards in the Collection.

(mu/defn grant-collection-read-permissions!
  [group-or-id :- MapOrID collection-or-id :- MapOrID]
  (check-not-personal-collection-or-descendant collection-or-id)
  (grant-permissions! (u/the-id group-or-id) (collection-read-path collection-or-id)))

Delete GTAPs (sandboxes) that are no longer needed after the permissions graph is updated. This is EE-specific -- OSS impl is a no-op, since sandboxes are an EE-only feature.

(defenterprise ^:private delete-gtaps-if-needed-after-permissions-change!
  metabase-enterprise.sandbox.models.permissions.delete-sandboxes
  [_])

Delete connection impersonation policies that are no longer needed after the permissions graph is updated. This is EE-specific -- OSS impl is a no-op, since connection impersonation is an EE-only feature.

(defenterprise ^:private delete-impersonations-if-needed-after-permissions-change!
  metabase-enterprise.advanced-permissions.models.connection-impersonation
  [_])

----------------------------------------------- Graph Updating Fns -----------------------------------------------

Exception to throw when a permissions operation fails due to missing Enterprise Edition code, or missing a valid token with the advanced-permissions feature.

(defn ee-permissions-exception
  [perm-type]
  (ex-info
    (tru "The {0} permissions functionality is only enabled if you have a premium token with the advanced-permissions feature."
         (str/replace (name perm-type) "-" " "))
    {:status-code 402}))
(defn- download-permissions-set
  [group-id]
  (t2/select-fn-set :object
                   [Permissions :object]
                   {:where [:and
                            [:= :group_id group-id]
                            [:or
                             [:= :object (h2x/literal "/")]
                             [:like :object (h2x/literal "/download/%")]]]}))
(defn- download-permissions-level
  [permissions-set db-id & [schema-name table-id]]
  (cond
   (set-has-full-permissions? permissions-set (feature-perms-path :download :full db-id schema-name table-id))
   :full
   (set-has-full-permissions? permissions-set (feature-perms-path :download :limited db-id schema-name table-id))
   :limited
   :else
   :none))

Native download permissions control the ability of users to download the results of native questions for a given database.

To update native download permissions, we must read the list of tables in the database, and check the group's download permission level for each one. - If they have full download permissions for all tables, they have full native download permissions. - If they have at least limited download permissions for all tables, they have limited native download permissions. - If they have no download permissions for at least one table, they have no native download permissions.

This lives in non-EE code because it needs to be called during sync, in case a new table was discovered or a table was deleted. This ensures that native download perms are always up to date, even on OSS instances, in case they are upgraded to EE.

(mu/defn update-native-download-permissions!
  [group-id :- ms/PositiveInt db-id :- ms/PositiveInt]
  (let [permissions-set (download-permissions-set group-id)
        table-ids-and-schemas (t2/select-pk->fn :schema 'Table :db_id db-id :active [:= true])
        native-perm-level (reduce (fn [lowest-seen-perm-level [table-id table-schema]]
                                    (let [table-perm-level (download-permissions-level permissions-set
                                                                                       db-id
                                                                                       table-schema
                                                                                       table-id)]
                                      (cond
                                        (= table-perm-level :none)
                                        (reduced :none)
                                        (or (= lowest-seen-perm-level :limited)
                                            (= table-perm-level :limited))
                                        :limited
                                        :else
                                        :full)))
                                  :full
                                  (seq table-ids-and-schemas))]
    (doseq [perm-value [:full :limited]]
      ;; We don't want to call `delete-related-permissions!` here because that would also delete prefixes of the native
      ;; downloads path, including `/download/db/:id/`, thus removing download permissions for the entire DB. Instead
      ;; we just delete the native downloads path directly, so that we can replace it with a new value.
      (t2/delete! Permissions :group_id group-id, :object (native-feature-perms-path :download perm-value db-id)))
    (when (not= native-perm-level :none)
      (grant-permissions! group-id (native-feature-perms-path :download native-perm-level db-id)))))
(mu/defn ^:private update-table-read-permissions!
  [group-id       :- ms/PositiveInt
   db-id          :- ms/PositiveInt
   schema         :- :string
   table-id       :- ms/PositiveInt
   new-read-perms :- [:enum :all :none]]
  ((case new-read-perms
     :all  grant-permissions!
     :none revoke-data-perms!) group-id (table-read-path db-id schema table-id)))
(mu/defn ^:private update-table-query-permissions!
  [group-id        :- ms/PositiveInt
   db-id           :- ms/PositiveInt
   schema          :- :string
   table-id        :- ms/PositiveInt
   new-query-perms :- [:enum :all :segmented :none]]
  (case new-query-perms
    :all       (grant-permissions! group-id (table-query-path           db-id schema table-id))
    :segmented (grant-permissions! group-id (table-sandboxed-query-path db-id schema table-id))
    :none      (revoke-data-perms! group-id (table-query-path           db-id schema table-id))))
(mu/defn ^:private update-table-data-access-permissions!
  [group-id        :- ms/PositiveInt
   db-id           :- ms/PositiveInt
   schema          :- :string
   table-id        :- ms/PositiveInt
   new-table-perms :- TablePermissionsGraph]
  (cond
    (= new-table-perms :all)
    (do
      (revoke-data-perms! group-id db-id schema table-id)
      (grant-permissions! group-id db-id schema table-id))
    (= new-table-perms :none)
    (revoke-data-perms! group-id db-id schema table-id)
    (map? new-table-perms)
    (let [{new-read-perms :read, new-query-perms :query} new-table-perms]
      ;; clear out any existing permissions
      (revoke-data-perms! group-id db-id schema table-id)
      ;; then grant/revoke read and query perms as appropriate
      (when new-read-perms  (update-table-read-permissions!  group-id db-id schema table-id new-read-perms))
      (when new-query-perms (update-table-query-permissions! group-id db-id schema table-id new-query-perms)))))
(mu/defn ^:private update-schema-data-access-permissions!
  [group-id         :- ms/PositiveInt
   db-id            :- ms/PositiveInt
   schema           :- :string
   new-schema-perms :- SchemaPermissionsGraph]
  (cond
    (= new-schema-perms :all)  (do (revoke-data-perms! group-id db-id schema)  ; clear out any existing related permissions
                                   (grant-permissions! group-id db-id schema)) ; then grant full perms for the schema
    (= new-schema-perms :none) (revoke-data-perms! group-id db-id schema)
    (map? new-schema-perms)    (doseq [[table-id table-perms] new-schema-perms]
                                 (update-table-data-access-permissions! group-id db-id schema table-id table-perms))))
(mu/defn ^:private update-native-data-access-permissions!
  [group-id :- ms/PositiveInt db-id :- ms/PositiveInt new-native-perms :- NativePermissionsGraph]
  ;; revoke-native-permissions! will delete all entries that would give permissions for native access. Thus if you had
  ;; a root DB entry like `/db/11/` this will delete that too. In that case we want to create a new full schemas entry
  ;; so you don't lose access to all schemas when we modify native access.
  (let [has-full-access? (t2/exists? Permissions :group_id group-id, :object (data-perms-path db-id))]
    (revoke-native-permissions! group-id db-id)
    (when has-full-access?
      (grant-permissions-for-all-schemas! group-id db-id)))
  (case new-native-perms
    :write (grant-native-readwrite-permissions! group-id db-id)
    :none  nil))
(defn- delete-block-perms-for-db!
  [group-id db-id]
  (log/trace "Deleting block permissions entries for Group %d for Database %d" group-id db-id)
  (t2/delete! Permissions :group_id group-id, :object (database-block-perms-path db-id)))
(defn- revoke-schema-and-block-perms!
  [group-id db-id]
  (revoke-db-schema-permissions! group-id db-id)
  (delete-block-perms-for-db! group-id db-id))
(mu/defn ^:private update-db-data-access-permissions!
  [group-id :- pos-int?
   db-id :- pos-int?
   new-db-perms :- api.permission-graph/StrictDataPerms]
  (when-let [new-native-perms (:native new-db-perms)]
    (update-native-data-access-permissions! group-id db-id new-native-perms))
  (when-let [schemas (:schemas new-db-perms)]
    ;; TODO -- consider whether `delete-block-perms-for-this-db!` should be enterprise-only... not sure how to make it
    ;; work, especially if you downgraded from enterprise... FWIW the sandboxing code (for updating the graph) is not enterprise only.
    (condp = schemas
      :all
      (do
        (revoke-schema-and-block-perms! group-id db-id)
        (grant-permissions-for-all-schemas! group-id db-id))
      :none
      (revoke-schema-and-block-perms! group-id db-id)
      ;; Groups using connection impersonation for a DB should be treated the same as if they had full self-service
      ;; data access.
      :impersonated
      (do
        (revoke-schema-and-block-perms! group-id db-id)
        (grant-permissions-for-all-schemas! group-id db-id))
      ;; TODO -- should this code be enterprise only?
      :block
      (do
        (when-not (premium-features/has-feature? :advanced-permissions)
          (throw (ee-permissions-exception :block)))
        (revoke-data-perms! group-id db-id)
        (revoke-download-perms! group-id db-id)
        (grant-permissions! group-id (database-block-perms-path db-id)))
      (when (map? schemas)
        (delete-block-perms-for-db! group-id db-id)
        (doseq [schema (keys schemas)]
          (update-schema-data-access-permissions! group-id db-id schema (get-in new-db-perms [:schemas schema])))))))
(defn- update-feature-level-permission!
  [group-id db-id new-perms perm-type]
  (if-let [update-fn (when config/ee-available?
                       (classloader/require 'metabase-enterprise.advanced-permissions.models.permissions)
                       (resolve (symbol "metabase-enterprise.advanced-permissions.models.permissions"
                                        (str "update-db-" (name perm-type) "-permissions!"))))]
    (update-fn group-id db-id new-perms)
    (throw (ee-permissions-exception perm-type))))
(mu/defn ^:private update-group-permissions!
  [group-id :- pos-int? new-group-perms :- [:maybe api.permission-graph/StrictDbGraph]]
  (doseq [[db-id new-db-perms] new-group-perms
          [perm-type new-perms] new-db-perms]
    (case perm-type
      :data
      (update-db-data-access-permissions! group-id db-id new-perms)
      :download
      (update-feature-level-permission! group-id db-id new-perms :download)
      :data-model
      (update-feature-level-permission! group-id db-id new-perms :data-model)
      :details
      (update-feature-level-permission! group-id db-id new-perms :details))))

Set the global execution permission ("/execute/") for the group with ID group-id to new-perms.

(defn update-global-execution-permission!
  [group-id new-perms]
  (when-not (or (= group-id (:id (perms-group/all-users)))
                (premium-features/has-feature? :advanced-permissions))
    (throw (ee-permissions-exception :execute)))
  (delete-related-permissions! group-id "/execute/")
  (when (= new-perms :all)
    (grant-permissions! group-id "/execute/")))
(mu/defn ^:private update-execution-permissions!
  [group-id :- ms/PositiveInt new-group-perms :- ExecutionGroupPermissionsGraph]
  (if (map? new-group-perms)
    (doseq [[db-id new-db-perms] new-group-perms]
      (update-feature-level-permission! group-id db-id new-db-perms :execute))
    (update-global-execution-permission! group-id new-group-perms)))

Check that the revision number coming in as part of new-graph matches the one from old-graph. This way we can make sure people don't submit a new graph based on something out of date, which would otherwise stomp over changes made in the interim. Return a 409 (Conflict) if the numbers don't match up.

(defn check-revision-numbers
  [old-graph new-graph]
  (when (not= (:revision old-graph) (:revision new-graph))
    (throw (ex-info (tru
                      (str "Looks like someone else edited the permissions and your data is out of date. "
                           "Please fetch new data and try again."))
                    {:status-code 409}))))

Save changes made to permission graph for logging/auditing purposes. This doesn't do anything if *current-user-id* is unset (e.g. for testing or REPL usage). * model -- revision model, should be one of [PermissionsRevision, CollectionPermissionGraphRevision, ApplicationPermissionsRevision] * before -- the graph before the changes * changes -- set of changes applied in this revision.

(defn save-perms-revision!
  [model current-revision before changes]
  (when *current-user-id*
    (first (t2/insert-returning-instances! model
                                           ;; manually specify ID here so if one was somehow inserted in the meantime in the fraction of a second since we
                                           ;; called `check-revision-numbers` the PK constraint will fail and the transaction will abort
                                           :id      (inc current-revision)
                                           :before  before
                                           :after   changes
                                           :user_id *current-user-id*))))

Log changes to the permissions graph.

(defn log-permissions-changes
  [old new]
  (log/debug
   (trs "Changing permissions")
   "\n" (trs "FROM:") (u/pprint-to-str 'magenta old)
   "\n" (trs "TO:")   (u/pprint-to-str 'blue    new)))

Update the data permissions graph, making any changes necessary to make it match NEW-GRAPH. This should take in a graph that is exactly the same as the one obtained by graph with any changes made as needed. The graph is revisioned, so if it has been updated by a third party since you fetched it this function will fail and return a 409 (Conflict) exception. If nothing needs to be done, this function returns nil; otherwise it returns the newly created PermissionsRevision entry.

Code for updating the Collection permissions graph is in [[metabase.models.collection.graph]].

(mu/defn update-data-perms-graph!
  ([new-graph :- api.permission-graph/StrictData]
   (let [old-graph (data-perms-graph)
         [old new] (data/diff (:groups old-graph) (:groups new-graph))
         old       (or old {})
         new       (or new {})]
     (when (or (seq old) (seq new))
       (log-permissions-changes old new)
       (check-revision-numbers old-graph new-graph)
       (check-audit-db-permissions new)
       (t2/with-transaction [_conn]
        (doseq [[group-id changes] new]
          (update-group-permissions! group-id changes))
        (save-perms-revision! PermissionsRevision (:revision old-graph) old new)
        (delete-impersonations-if-needed-after-permissions-change! new)
        (delete-gtaps-if-needed-after-permissions-change! new)))))
  ;; The following arity is provided soley for convenience for tests/REPL usage
  ([ks :- [:vector :any] new-value]
   (update-data-perms-graph! (assoc-in (data-perms-graph) (cons :groups ks) new-value))))

Update the execution permissions graph, making any changes necessary to make it match new-graph. This should take in a graph that is exactly the same as the one obtained by graph with any changes made as needed. The graph is revisioned, so if it has been updated by a third party since you fetched it this function will fail and return a 409 (Conflict) exception. If nothing needs to be done, this function returns nil; otherwise it returns the newly created PermissionsRevision entry.

Code for updating the Collection permissions graph is in [[metabase.models.collection.graph]].

(mu/defn update-execution-perms-graph!
  ([new-graph :- ExecutionPermissionsGraph]
   (let [old-graph (execution-perms-graph)
         [old new] (data/diff (:groups old-graph) (:groups new-graph))
         old       (or old {})]
     (when (or (seq old) (seq new))
       (log-permissions-changes old new)
       (check-revision-numbers old-graph new-graph)
       (t2/with-transaction [_conn]
         (doseq [[group-id changes] new]
           (update-execution-permissions! group-id changes))
         (save-perms-revision! PermissionsRevision (:revision old-graph) old new)))))
  ;; The following arity is provided soley for convenience for tests/REPL usage
  ([ks :- [:any] new-value]
   (update-execution-perms-graph! (assoc-in (execution-perms-graph) (cons :groups ks) new-value))))
 

A PermissionsGroup is a group (or role) that can be assigned certain permissions. Users can be members of one or more of these groups.

A few 'magic' groups exist: [[all-users]], which predicably contains All Users; and [[admin]], which contains all superusers. These groups are 'magic' in the sense that you cannot add users to them yourself, nor can you delete them; they are created automatically. You can, however, set permissions for them.

See documentation in [[metabase.models.permissions]] for more information about the Metabase permissions system.

(ns metabase.models.permissions-group
  (:require
   [honey.sql.helpers :as sql.helpers]
   [metabase.db.connection :as mdb.connection]
   [metabase.db.query :as mdb.query]
   [metabase.models.interface :as mi]
   [metabase.models.setting :as setting]
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase.

(def PermissionsGroup
  :model/PermissionsGroup)
(methodical/defmethod t2/table-name :model/PermissionsGroup [_model] :permissions_group)
(derive :model/PermissionsGroup :metabase/model)

-------------------------------------------- Magic Groups Getter Fns ---------------------------------------------

(defn- magic-group [group-name]
  (mdb.connection/memoize-for-application-db
   (fn []
     (u/prog1 (t2/select-one PermissionsGroup :name group-name)
       ;; normally it is impossible to delete the magic [[all-users]] or [[admin]] Groups -- see
       ;; [[check-not-magic-group]]. This assertion is here to catch us if we do something dumb when hacking on
       ;; the MB code -- to make tests fail fast. For that reason it's not i18n'ed.
       (when-not <>
         (throw (ex-info (format "Fatal error: magic Permissions Group %s has gone missing." (pr-str group-name))
                         {:name group-name})))))))

The name of the "All Users" magic group.

(def all-users-group-name
  "All Users")

Fetch the All Users permissions group

(def ^{:arglists '([])} all-users
  (magic-group all-users-group-name))

The name of the "Administrators" magic group.

(def admin-group-name
  "Administrators")

Fetch the Administrators permissions group

(def ^{:arglists '([])} admin
  (magic-group admin-group-name))

--------------------------------------------------- Validation ---------------------------------------------------

Does a PermissionsGroup with group-name exist in the DB? (case-insensitive)

(defn exists-with-name?
  ^Boolean [group-name]
  {:pre [((some-fn keyword? string?) group-name)]}
  (t2/exists? PermissionsGroup
    :%lower.name (u/lower-case-en (name group-name))))
(defn- check-name-not-already-taken
  [group-name]
  (when (exists-with-name? group-name)
    (throw (ex-info (tru "A group with that name already exists.") {:status-code 400}))))

Make sure we're not trying to edit/delete one of the magic groups, or throw an exception.

(defn- check-not-magic-group
  [{id :id}]
  {:pre [(integer? id)]}
  (doseq [magic-group [(all-users)
                       (admin)]]
    (when (= id (:id magic-group))
      (throw (ex-info (tru "You cannot edit or delete the ''{0}'' permissions group!" (:name magic-group))
               {:status-code 400})))))

--------------------------------------------------- Lifecycle ----------------------------------------------------

(t2/define-before-insert :model/PermissionsGroup
 [{group-name :name, :as group}]
 (u/prog1 group
   (check-name-not-already-taken group-name)))
(t2/define-before-delete :model/PermissionsGroup
  [{id :id, :as group}]
  (check-not-magic-group group)
  ;; Remove from LDAP mappings
  (classloader/require 'metabase.integrations.ldap)
  (setting/set-value-of-type!
    :json :ldap-group-mappings
    (when-let [mappings (setting/get-value-of-type :json :ldap-group-mappings)]
      (zipmap (keys mappings)
              (for [val (vals mappings)]
                (remove (partial = id) val))))))
(t2/define-before-update :model/PermissionsGroup
  [group]
  (let [changes (t2/changes group)]
    (u/prog1 group
      (check-not-magic-group group)
      (when-let [group-name (:name changes)]
        (check-name-not-already-taken group-name)))))

---------------------------------------------------- Util Fns ----------------------------------------------------

(mi/define-simple-hydration-method members
  :members
  "Return `Users` that belong to `group-or-id`, ordered by their name (case-insensitive)."
  [group-or-id]
  (mdb.query/query (cond-> {:select    [:user.first_name
                                        :user.last_name
                                        :user.email
                                        [:user.id :user_id]
                                        [:pgm.id :membership_id]]
                            :from      [[:core_user :user]]
                            :left-join [[:permissions_group_membership :pgm] [:= :user.id :pgm.user_id]]
                            :where     [:and [:= :user.is_active true]
                                        [:= :pgm.group_id (u/the-id group-or-id)]]
                            :order-by  [[[:lower :user.first_name] :asc]
                                        [[:lower :user.last_name] :asc]]}
                     (premium-features/enable-advanced-permissions?)
                     (sql.helpers/select [:pgm.is_group_manager :is_group_manager]))))

Return a set of the IDs of all PermissionsGroups, aside from the admin group.

(defn non-admin-groups
  []
  (t2/select PermissionsGroup :name [:not= admin-group-name]))
 
(ns metabase.models.permissions-group-membership
  (:require
   [metabase.db.query :as mdb.query]
   [metabase.models.permissions-group :as perms-group]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru tru]]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase.

(def PermissionsGroupMembership
  :model/PermissionsGroupMembership)
(methodical/defmethod t2/table-name :model/PermissionsGroupMembership [_model] :permissions_group_membership)
(derive :model/PermissionsGroupMembership :metabase/model)

Exception message when try to remove the last admin.

(def fail-to-remove-last-admin-msg
  (deferred-tru "You cannot remove the last member of the ''Admin'' group!"))

Should we allow people to be added to or removed from the All Users permissions group? By default, this is false, but enable it when adding or deleting users.

(defonce ^:dynamic 
  *allow-changing-all-users-group-members*
  false)

Throw an Exception if we're trying to add or remove a user to the All Users group.

(defn- check-not-all-users-group
  [group-id]
  (when (= group-id (:id (perms-group/all-users)))
    (when-not *allow-changing-all-users-group-members*
      (throw (ex-info (tru "You cannot add or remove users to/from the ''All Users'' group.")
               {:status-code 400})))))

The current number of non-archived admins (superusers).

(defn- admin-count
  []
  (:count
   (first
    (mdb.query/query {:select [[:%count.* :count]]
                      :from   [[:permissions_group_membership :pgm]]
                      :join   [[:core_user :user] [:= :user.id :pgm.user_id]]
                      :where  [:and
                               [:= :pgm.group_id (u/the-id (perms-group/admin))]
                               [:= :user.is_active true]]}))))

Throw an Exception if there is only one admin (superuser) left. The assumption is that the one admin is about to be archived or have their admin status removed.

(defn throw-if-last-admin!
  []
  (when (<= (admin-count) 1)
    (throw (ex-info (str fail-to-remove-last-admin-msg)
                    {:status-code 400}))))
(t2/define-before-delete :model/PermissionsGroupMembership
  [{:keys [group_id user_id]}]
  (check-not-all-users-group group_id)
  ;; Otherwise if this is the Admin group...
  (when (= group_id (:id (perms-group/admin)))
    ;; ...and this is the last membership, throw an exception
    (throw-if-last-admin!)
    ;; ...otherwise we're ok. Unset the `:is_superuser` flag for the user whose membership was revoked
    (t2/update! 'User user_id {:is_superuser false})))
(t2/define-before-insert :model/PermissionsGroupMembership
  [{:keys [group_id], :as membership}]
  (u/prog1 membership
    (check-not-all-users-group group_id)))
(t2/define-after-insert :model/PermissionsGroupMembership
  [{:keys [group_id user_id], :as membership}]
  (u/prog1 membership
    ;; If we're adding a user to the admin group, set the `:is_superuser` flag for the user to whom membership was
    ;; granted
    (when (= group_id (:id (perms-group/admin)))
      (t2/update! :core_user user_id {:is_superuser true}))))
 
(ns metabase.models.permissions-revision
  (:require
   [metabase.models.interface :as mi]
   [metabase.util.i18n :refer [tru]]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase.

(def PermissionsRevision
  :model/PermissionsRevision)
(methodical/defmethod t2/table-name :model/PermissionsRevision [_model] :permissions_revision)
(doto :model/PermissionsRevision
  (derive :metabase/model)
  (derive :hook/created-at-timestamped?))
(t2/deftransforms :model/PermissionsRevision
  {:before mi/transform-json
   :after  mi/transform-json})
(t2/define-before-update :model/PermissionsRevision
  [_]
  (throw (Exception. (tru "You cannot update a PermissionsRevision!"))))

Return the ID of the newest PermissionsRevision, or zero if none have been made yet. (This is used by the permissions graph update logic that checks for changes since the original graph was fetched).

(defn latest-id
  []
  (or (t2/select-one-pk PermissionsRevision {:order-by [[:id :desc]]})
      0))
 

Parses sets of permissions to create a permission graph. Strategy is:

  • Convert strings to parse tree
  • Convert parse tree to path, e.g. ['3' :all] or ['3' :schemas :all]
  • Convert set of paths to a map, the permission graph
(ns metabase.models.permissions.parse
  (:require
   [clojure.core.match :refer [match]]
   [clojure.string :as str]
   [clojure.walk :as walk]
   [instaparse.core :as insta]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]))
(set! *warn-on-reflection* true)

Describes permission strings like /db/3/ or /collection/root/read/

(def ^:private grammar
  "permission = ( all | execute | db | block | download | data-model | details | collection | data-v2 | query-v2)
  all         = <'/'>
  data-v2     = <'/data/db/'> #'\\d+' <'/'> ( native | execute | schemas )?
  query-v2    = <'/query/db/'> #'\\d+' <'/'> ( native | execute | schemas )?
  db          = <'/db/'> #'\\d+' <'/'> ( native | execute | schemas )?
  execute     = <'/execute/'> ( <'db/'> #'\\d+' <'/'> )?
  native      = <'native/'>
  schemas     = <'schema/'> schema?
  schema      = schema-name <'/'> table?
  table       = <'table/'> #'\\d+' <'/'> (table-perm <'/'>)?
  table-perm  = ('read'|'query'|'query/segmented')
  block       = <'/block/db/'> #'\\d+' <'/'>
  download    = <'/download'> ( dl-limited | dl-db)
  dl-limited  = <'/limited'>  dl-db
  dl-db       = <'/db/'> #'\\d+' <'/'> ( dl-native | dl-schemas )?
  dl-native   = <'native/'>
  dl-schemas  = <'schema/'> dl-schema?
  dl-schema   = schema-name <'/'> dl-table?
  dl-table    = <'table/'> #'\\d+' <'/'>
  data-model  = <'/data-model'> dm-db
  dm-db       = <'/db/'> #'\\d+' <'/'> dm-schema?
  dm-schema   = <'schema/'> schema-name <'/'> dm-table?
  dm-table    = <'table/'> #'\\d+' <'/'>
  details  = <'/details'> <'/db/'> #'\\d+' <'/'>
  schema-name = #'(\\\\/|[^/])*' (* schema name can have \\/ but not /*)
  collection  = <'/collection/'> #'[^/]*' <'/'> ('read' <'/'>)?")

Function that parses permission strings

(def ^:private ^{:arglists '([s])} parser
  (insta/parser grammar))
(defn- collection-id
  [id]
  (if (= id "root") :root (Long/parseUnsignedLong id)))

Unescape slashes for things that has been escaped before storing in DB (e.g: DB schema name). To find things that were being escaped: check references of [[metabase.models.permissions/escape-path-component]].

(unescape-path-component "a\/b" => "a/b").

(defn- unescape-path-component
  "Unescape slashes for things that has been escaped before storing in DB (e.g: DB schema name).
  To find things that were being escaped: check references of [[metabase.models.permissions/escape-path-component]].
    (unescape-path-component \"a\\/b\" => \"a/b\")."
  [s]
  (some-> s
          (str/replace "\\/" "/")     ; \/ -> /
          (str/replace "\\\\" "\\"))) ; \\ -> \

If path-or-paths is a single path, append x to the end of it. If it's a vector of paths, append x to each path.

(defn- append-to-all
  [path-or-paths x]
  (if (seqable? (first path-or-paths))
    (map (fn [path] (append-to-all path x)) (seq path-or-paths))
    (into path-or-paths [x])))
(defn- path1
  [tree]
  (match tree
    [:permission t]                (path1 t)
    [:schema-name schema-name]     (unescape-path-component schema-name)
    [:all]                         [:all] ; admin permissions
    [:db db-id]                    (let [db-id (Long/parseUnsignedLong db-id)] [[:db db-id :data :native :write] [:db db-id :data :schemas :all]])
    [:db db-id db-node]            (into [:db (Long/parseUnsignedLong db-id) :data] (path1 db-node))
    [:data-v2 db-id]              (let [db-id (Long/parseUnsignedLong db-id)] [[:db db-id :data :native :write]])
    [:data-v2 db-id db-node]      (into [:db (Long/parseUnsignedLong db-id) :data] (path1 db-node))
    [:query-v2 db-id]              (let [db-id (Long/parseUnsignedLong db-id)] [[:db db-id :query :native :write] [:db db-id :query :schemas :all]])
    [:query-v2 db-id db-node]      (into [:db (Long/parseUnsignedLong db-id) :query] (path1 db-node))
    [:schemas]                     [:schemas :all]
    [:schemas schema]              (into [:schemas] (path1 schema))
    [:schema schema-name]          [(path1 schema-name) :all]
    [:schema schema-name table]    (into [(path1 schema-name)] (path1 table))
    [:table table-id]              [(Long/parseUnsignedLong table-id) :all]
    [:table table-id table-perm]   (into [(Long/parseUnsignedLong table-id)] (path1 table-perm))
    [:table-perm perm]              (case perm
                                      "read"            [:read :all]
                                      "query"           [:query :all]
                                      "query/segmented" [:query :segmented])
    [:native]                      [:native :write]
    ;; block perms. Parse something like /block/db/1/ to {:db {1 {:schemas :block}}}
    [:block db-id]                 [:db (Long/parseUnsignedLong db-id) :data :schemas :block]
    ;; download perms
    [:download
     [:dl-limited db-node]]        (append-to-all (path1 db-node) :limited)
    [:download db-node]            (append-to-all (path1 db-node) :full)
    [:dl-db db-id]                 (let [db-id (Long/parseUnsignedLong db-id)]
                                     #{[:db db-id :download :native]
                                       [:db db-id :download :schemas]})
    [:dl-db db-id db-node]         (let [db-id (Long/parseUnsignedLong db-id)]
                                     (into [:db db-id] (path1 db-node)))
    [:dl-schemas]                  [:download :schemas]
    [:dl-schemas schema]           (into [:download :schemas] (path1 schema))
    [:dl-schema schema-name]       [(path1 schema-name)]
    [:dl-schema schema-name table] (into [(path1 schema-name)] (path1 table))
    [:dl-table table-id]           [(Long/parseUnsignedLong table-id)]
    [:dl-native]                   [:download :native]
    ;; collection perms
    [:collection id]               [:collection (collection-id id) :write]
    [:collection id "read"]        [:collection (collection-id id) :read]
    ;; return nil if the tree could not be parsed, so that we can try calling `path2` instead
    :else                          nil))
(defn- path2
  [tree]
  (match tree
    (_ :guard insta/failure?)      (log/error (trs "Error parsing permissions tree {0}" (pr-str tree)))
    [:permission t]                (path2 t)
    [:execute]                     [:execute :all]
    [:execute db-id]               [:execute (Long/parseUnsignedLong db-id) :all]
    [:schema-name schema-name]     (unescape-path-component schema-name)
    ;; data model perms
    [:data-model db-node]          (path2 db-node)
    [:dm-db db-id]                 (let [db-id (Long/parseUnsignedLong db-id)]
                                     [:db db-id :data-model :schemas :all])
    [:dm-db db-id db-node]         (let [db-id (Long/parseUnsignedLong db-id)]
                                     (into [:db db-id :data-model :schemas] (path2 db-node)))
    [:dm-schema schema-name]       [(path2 schema-name) :all]
    [:dm-schema schema-name table] (into [(path2 schema-name)] (path2 table))
    [:dm-table table-id]           [(Long/parseUnsignedLong table-id) :all]
    ;; DB details perms
    [:details db-id]            (let [db-id (Long/parseUnsignedLong db-id)]
                                  [:db db-id :details :yes])))

Recursively build permission path from parse tree. Implementation must be split between two pattern matching functions, because having all the clauses in a single pattern match will cause a compilation error due to CLJ-1852

(defn- path
  [tree]
  (or (path1 tree) (path2 tree)))

Given a set of permission paths, return a graph that expresses the most permissions possible for the set

Works by first doing a conversion like [[3 :schemas :all] [3 :schemas "PUBLIC" :all] -> {3 {:schemas {:all () :public {:all ()}}}}

Then converting that to {3 {:schemas :all}}

(defn- graph
  [paths]
  (->> paths
       (reduce (fn [paths path]
                 (if (every? vector? path) ;; handle case where /db/x/ returns two vectors
                   (into paths path)
                   (conj paths path)))
               [])
       (walk/prewalk (fn [x]
                       (if (and (sequential? x) (sequential? (first x)) (seq (first x)))
                         (->> x
                              (group-by first)
                              (reduce-kv (fn [m k v]
                                           (assoc m k (->> (map rest v) (filter seq))))
                                         {}))
                         x)))
       (walk/prewalk (fn [x]
                       (or (when (map? x)
                             (some #(and (= (% x) '()) %)
                                   [:block :all :some :write :read :segmented :full :limited :yes]))
                           x)))))

Given a set of permission strings, return a graph that expresses the most permissions possible for the set

(defn ->graph
  [permissions]
  (->> permissions
       (map (comp path parser))
       graph))
 
(ns metabase.models.persisted-info
  (:require
   [buddy.core.codecs :as codecs]
   [clojure.string :as str]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.models.interface :as mi]
   [metabase.public-settings.premium-features :as premium-features :refer [defenterprise]]
   [metabase.query-processor.util :as qp.util]
   [metabase.util :as u]
   [metabase.util.malli :as mu]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

----------------------------------------------- Entity & Lifecycle -----------------------------------------------

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the Card symbol in our codebase.

(def PersistedInfo
  :model/PersistedInfo)
(methodical/defmethod t2/table-name :model/PersistedInfo [_model] :persisted_info)
(derive :model/PersistedInfo :metabase/model)

Parse the value of :definition when it comes out of the application Database.

(defn transform-definition-out
  [definition]
  (when-let [definition (not-empty (mi/json-out-with-keywordization definition))]
    (update definition :field-definitions (fn [field-definitions]
                                            (mapv #(update % :base-type keyword)
                                                  field-definitions)))))
(t2/deftransforms :model/PersistedInfo
  {:definition {:in  mi/json-in
                :out transform-definition-out}})

Map containing the type and name of fields for dll. The type is :base-type and uses the effectivetype else basetype of a field.

(defn- field-metadata->field-defintion
  [{field-name :name :keys [base_type effective_type]}]
  {:field-name field-name
   :base-type (or effective_type base_type)})

Spec for metadata. Just asserting we have base types and names, not the full metadata of the qp.

(def ^:private Metadata
  [:maybe
   [:sequential
    [:map
     [:name      :string]
     [:base_type ::lib.schema.common/base-type]
     [:effective_type {:optional true} ::lib.schema.common/base-type]]]])
(mu/defn metadata->definition :- ::lib.schema.metadata/persisted-info.definition
  "Returns a ddl definition datastructure. A :table-name and :field-deifinitions vector of field-name and base-type."
  [metadata :- Metadata table-name]
  {:table-name        table-name
   :field-definitions (mapv field-metadata->field-defintion metadata)})

Base64 string of the hash of a query.

(mu/defn query-hash
  [query :- :map]
  (String. ^bytes (codecs/bytes->b64 (qp.util/query-hash query))))

Allow persisted substitution. When refreshing, set this to nil to ensure that all underlying queries are used to rebuild the persisted table.

(def ^:dynamic *allow-persisted-substitution*
  true)

A slug from a card suitable for a table name. This slug is not intended to be unique but to be human guide if looking at schemas. Persisted table names will follow the pattern model_<card-id>_slug and the model-id will ensure uniqueness.

(defn- slug-name
  [nom]
  (->> (str/replace (u/lower-case-en nom) #"\s+" "_")
       (take 10)
       (apply str)))

States of persisted_info records which can be refreshed.

'off' needs to be handled here even though setting the state to off is only possible with :cache-granular-controls enabled. A model could still have state=off if the instance previously had the feature flag, then downgraded to not have it. In that case models with state=off were previously prunable when the feature flag enabled, but they should be refreshable with the feature flag disabled.

(defenterprise refreshable-states
  metabase-enterprise.advanced-config.caching
  []
  #{"creating" "persisted" "error" "off"})

States of persisted_info records which can be pruned.

(defenterprise prunable-states
  metabase-enterprise.advanced-config.caching
  []
  #{"deletable"})
(mi/define-batched-hydration-method persisted?
  :persisted
  "Hydrate a card :is_persisted for the frontend."
  [cards]
  (when (seq cards)
    (let [existing-ids (t2/select-fn-set :card_id PersistedInfo
                                         :card_id [:in (map :id cards)]
                                         :state [:in (refreshable-states)])]
      (map (fn [{id :id :as card}]
             (assoc card :persisted (contains? existing-ids id)))
           cards))))

Marks PersistedInfo as deletable or off, these will at some point be cleaned up by the PersistPrune task.

deletable will wipe out all trace of persisted-info and allow them to be turned back on by automatic processes use when you are disabling peristence at a high level. off will ensure automatic processes do not pick up these up and re-enable.

(defn mark-for-pruning!
  ([conditions-map]
   (mark-for-pruning! conditions-map "deletable"))
  ([conditions-map state]
   (t2/update! PersistedInfo conditions-map {:active false, :state state, :state_change_at :%now})))

Marks PersistedInfo as creating, these will at some point be persisted by the PersistRefresh task.

(defn- create-row
  [user-id card]
  (let [slug (-> card :name slug-name)
        {:keys [database_id]} card
        card-id (u/the-id card)]
    {:card_id         card-id
     :database_id     database_id
     :question_slug   slug
     :table_name      (format "model_%s_%s" card-id slug)
     :active          false
     :refresh_begin   :%now
     :refresh_end     nil
     :state           "creating"
     :state_change_at :%now
     :creator_id      user-id}))

Looks for all new models in database and creates a persisted-info ready to be synced.

(defn ready-unpersisted-models!
  [database-id]
  (let [cards (t2/select :model/Card
                         {:where [:and
                                  [:= :database_id database-id]
                                  [:= :dataset true]
                                  [:not [:exists {:select [1]
                                                  :from [:persisted_info]
                                                  :where [:= :persisted_info.card_id :report_card.id]}]]]})]
    (t2/insert! PersistedInfo (map #(create-row nil %) cards))))

Marks PersistedInfo as creating, these will at some point be persisted by the PersistRefresh task.

(defn turn-on-model!
  [user-id card]
  (let [card-id (u/the-id card)
        existing-persisted-info (t2/select-one PersistedInfo :card_id card-id)
        persisted-info (cond
                         (not existing-persisted-info)
                         (first (t2/insert-returning-instances! PersistedInfo (create-row user-id card)))
                         (contains? #{"deletable" "off"} (:state existing-persisted-info))
                         (do
                           (t2/update! PersistedInfo (u/the-id existing-persisted-info)
                                       {:active false, :state "creating", :state_change_at :%now})
                           (t2/select-one PersistedInfo :card_id card-id)))]
    persisted-info))

Sets PersistedInfo state to creating for models without a PeristedInfo or those in a deletable state. Will ignore explicitly set off models.

(defn ready-database!
  [database-id]
  (t2/query-one
    {:update [:persisted_info]
     :where [:and
             [:= :database_id database-id]
             [:= :state "deletable"]]
     :set {:active false,
           :state "creating",
           :state_change_at :%now}})
  (ready-unpersisted-models! database-id))
 

Notifications are ways to deliver the results of Questions to users without going through the normal Metabase UI. At the time of this writing, there are two delivery mechanisms for Notifications -- email and Slack notifications; these destinations are known as 'Channels'. Notifications themselves are further divided into two categories -- 'Pulses', which are sent at specified intervals, and 'Alerts', which are sent when certain conditions are met (such as a query returning results).

Because 'Pulses' were originally the only type of Notification, this name is still used for the model itself, and in some of the functions below. To keep things clear, try to make sure you use the term 'Notification' for things that work with either type.

One more thing to keep in mind: this code is pretty old and doesn't follow the code patterns used in the other Metabase models. There is a plethora of CRUD functions for working with Pulses that IMO aren't really needed (e.g. functions for fetching a specific Pulse). At some point in the future, we can clean this namespace up and bring the code in line with the rest of the codebase, but for the time being, it probably makes sense to follow the existing patterns in this namespace rather than further confuse things.

Legacy note: Currently Pulses are associated with a dashboard, but this is not always the case since there are legacy pulses that are a collection of cards, not dashboard.

(ns metabase.models.pulse
  (:require
   [clojure.string :as str]
   [malli.core :as mc]
   [medley.core :as m]
   [metabase.api.common :as api]
   [metabase.events :as events]
   [metabase.models.collection :as collection]
   [metabase.models.interface :as mi]
   [metabase.models.permissions :as perms]
   [metabase.models.pulse-card :refer [PulseCard]]
   [metabase.models.pulse-channel :as pulse-channel :refer [PulseChannel]]
   [metabase.models.serialization :as serdes]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru tru]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

----------------------------------------------- Entity & Lifecycle -----------------------------------------------

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase.

(def Pulse
  :model/Pulse)
(methodical/defmethod t2/table-name :model/Pulse [_model] :pulse)
(methodical/defmethod t2/model-for-automagic-hydration [:default :pulse]  [_original-model _k] :model/Pulse)
(doto :model/Pulse
  (derive :metabase/model)
  (derive :hook/timestamped?)
  (derive :hook/entity-id)
  (derive ::mi/read-policy.full-perms-for-perms-set))
(t2/deftransforms :model/Pulse
  {:parameters mi/transform-json})
(defn- assert-valid-parameters [{:keys [parameters]}]
  (when-not (mc/validate [:maybe
                          [:sequential
                           [:and
                            [:map [:id ms/NonBlankString]]
                            [:map-of :keyword :any]]]]
                         parameters)
    (throw (ex-info (tru ":parameters must be a sequence of maps with String :id keys")
                    {:parameters parameters}))))
(t2/define-before-insert :model/Pulse
  [notification]
  (let [defaults      {:parameters []}
        dashboard-id  (:dashboard_id notification)
        collection-id (if dashboard-id
                        (t2/select-one-fn :collection_id 'Dashboard, :id dashboard-id)
                        (:collection_id notification))
        notification  (->> (for [[k v] notification
                                 :when (some? v)]
                             {k v})
                           (apply merge defaults {:collection_id collection-id}))]
    (u/prog1 notification
      (assert-valid-parameters notification)
      (collection/check-collection-namespace Pulse (:collection_id notification)))))

If true, allows the collection_id on a dashboard subscription to be modified. This should only be done when the associated dashboard is being moved to a new collection.

(def ^:dynamic *allow-moving-dashboard-subscriptions*
  false)
(t2/define-before-update :model/Pulse
  [notification]
  (let [{:keys [collection_id dashboard_id]} (t2/original notification)]
    (when (and dashboard_id
               (contains? notification :collection_id)
               (not= (:collection_id notification) collection_id)
               (not *allow-moving-dashboard-subscriptions*))
      (throw (ex-info (tru "collection ID of a dashboard subscription cannot be directly modified") notification)))
    (when (and dashboard_id
               (contains? notification :dashboard_id)
               (not= (:dashboard_id notification) dashboard_id))
      (throw (ex-info (tru "dashboard ID of a dashboard subscription cannot be modified") notification))))
  (u/prog1 (t2/changes notification)
    (assert-valid-parameters notification)
    (collection/check-collection-namespace Pulse (:collection_id notification))))

Return the Card associated with an Alert, fetching it if needed, for permissions-checking purposes.

(defn- alert->card
  [alert]
  (or
   ;; if `card` is already present as a top-level key we can just use that directly
   (:card alert)
   ;; otherwise fetch the associated `:cards` (if not already fetched) and then pull the first one out, since Alerts
   ;; can only have one Card
   (-> (t2/hydrate alert :cards) :cards first)
   ;; if there's still not a Card, throw an Exception!
   (throw (Exception. (tru "Invalid Alert: Alert does not have a Card associated with it")))))

Whether notification is an Alert (as opposed to a regular Pulse).

(defn is-alert?
  [notification]
  (boolean (:alert_condition notification)))

Permissions to read or write an Alert are the same as those of its 'parent' Card. For all intents and purposes, an Alert cannot be put into a Collection.

Permissions to read a Dashboard Subscription are more complex. A non-admin can read a Dashboard Subscription if they have read access to its parent Collection, and they are a creator or recipient of the subscription. A non-admin can write a Dashboard Subscription only if they are its creator. (Admins have full read and write permissions for all objects.) These checks are handled by the can-read? and can-write? methods below.

(defmethod mi/perms-objects-set Pulse
  [notification read-or-write]
  (if (is-alert? notification)
    (mi/perms-objects-set (alert->card notification) read-or-write)
    (perms/perms-objects-set-for-parent-collection notification read-or-write)))
(defn- current-user-is-creator?
  [notification]
  (= api/*current-user-id* (:creator_id notification)))
(defn- current-user-is-recipient?
  [notification]
  (let [channels (:channels (t2/hydrate notification [:channels :recipients]))
        recipient-ids (for [{recipients :recipients} channels
                            recipient recipients]
                        (:id recipient))]
    (boolean
     (some #{api/*current-user-id*} recipient-ids))))
(defmethod mi/can-read? Pulse
  [notification]
  (if (is-alert? notification)
   (mi/current-user-has-full-permissions? :read notification)
   (or api/*is-superuser?*
       (or (current-user-is-creator? notification)
           (current-user-is-recipient? notification)))))

Non-admins should be able to create subscriptions, and update subscriptions that they created, but not edit anyone else's subscriptions (except for unsubscribing themselves, which uses a custom API).

(defmethod mi/can-write? Pulse
  [notification]
  (if (is-alert? notification)
    (mi/current-user-has-full-permissions? :write notification)
    (or api/*is-superuser?*
        (and (mi/current-user-has-full-permissions? :read notification)
             (current-user-is-creator? notification)))))
(defmethod serdes/hash-fields Pulse
  [_pulse]
  [:name (serdes/hydrated-hash :collection) :created_at])

---------------------------------------------------- Schemas -----------------------------------------------------

Schema for valid values of :alert_condition for Alerts.

(def AlertConditions
  [:enum "rows" "goal"])

Schema for the map we use to internally represent the fact that a Card is in a Notification and the details about its presence there.

(def CardRef
  (mu/with-api-error-message
    [:map
     [:id                                 ms/PositiveInt]
     [:include_csv                        ms/BooleanValue]
     [:include_xls                        ms/BooleanValue]
     [:dashboard_card_id {:optional true} [:maybe ms/PositiveInt]]]
    (deferred-tru "value must be a map with the keys `{0}`, `{1}`, `{2}`, and `{3}`." "id" "include_csv" "include_xls" "dashboard_card_id")))

This schema represents the cards that are included in a pulse. This is the data from the PulseCard and some additional information used by the UI to display it from Card. This is a superset of CardRef and is coercible to a CardRef

(def HybridPulseCard
  (mu/with-api-error-message
    [:merge CardRef
     [:map
      [:name               [:maybe string?]]
      [:description        [:maybe string?]]
      [:display            [:maybe ms/KeywordOrString]]
      [:collection_id      [:maybe ms/PositiveInt]]
      [:dashboard_id       [:maybe ms/PositiveInt]]
      [:parameter_mappings [:maybe [:sequential ms/Map]]]]]
    (deferred-tru "value must be a map with the following keys `({0})`"
        (str/join ", " ["collection_id" "description" "display" "id" "include_csv" "include_xls" "name"
                        "dashboard_id" "parameter_mappings"]))))

Schema for functions accepting either a HybridPulseCard or CardRef.

(def CoercibleToCardRef
  [:or HybridPulseCard CardRef])

--------------------------------------------------- Hydration ----------------------------------------------------

(mi/define-simple-hydration-method channels
  :channels
  "Return the PulseChannels associated with this `notification`."
  [notification-or-id]
  (t2/select PulseChannel, :pulse_id (u/the-id notification-or-id)))

By default the :cards hydration method only return active cards, but in cases we need to send email after a card is archived, we need to be able to hydrate archived card as well.

(def ^:dynamic *allow-hydrate-archived-cards*
  false)
(mu/defn ^:private cards* :- [:sequential HybridPulseCard]
  [notification-or-id]
  (t2/select
   :model/Card
   {:select    [:c.id :c.name :c.description :c.collection_id :c.display :pc.include_csv :pc.include_xls
                :pc.dashboard_card_id :dc.dashboard_id [nil :parameter_mappings]] ;; :dc.parameter_mappings - how do you select this?
    :from      [[:pulse :p]]
    :join      [[:pulse_card :pc] [:= :p.id :pc.pulse_id]
                [:report_card :c] [:= :c.id :pc.card_id]]
    :left-join [[:report_dashboardcard :dc] [:= :pc.dashboard_card_id :dc.id]]
    :where     [:and
                [:= :p.id (u/the-id notification-or-id)]
                (when-not *allow-hydrate-archived-cards*
                  [:= :c.archived false])]
    :order-by [[:pc.position :asc]]}))
(mi/define-simple-hydration-method cards
  :cards
  "Return the Cards associated with this `notification`."
  [notification-or-id]
  (cards* notification-or-id))

---------------------------------------- Notification Fetching Helper Fns ----------------------------------------

(mu/defn hydrate-notification :- (mi/InstanceOf Pulse)
  "Hydrate Pulse or Alert with the Fields needed for sending it."
  [notification :- (mi/InstanceOf Pulse)]
  (-> notification
      (t2/hydrate :creator :cards [:channels :recipients])
      (m/dissoc-in [:details :emails])))
(mu/defn ^:private hydrate-notifications :- [:sequential (mi/InstanceOf Pulse)]
  "Batched-hydrate multiple Pulses or Alerts."
  [notifications :- [:sequential (mi/InstanceOf Pulse)]]
  (as-> notifications <>
    (t2/hydrate <> :creator :cards [:channels :recipients])
    (map #(m/dissoc-in % [:details :emails]) <>)))
(mu/defn ^:private notification->pulse :- (mi/InstanceOf Pulse)
  "Take a generic `Notification`, and put it in the standard Pulse format the frontend expects. This really just
  consists of removing associated `Alert` columns."
  [notification :- (mi/InstanceOf Pulse)]
  (dissoc notification :alert_condition :alert_above_goal :alert_first_only))

TODO - do we really need this function? Why can't we just use t2/select and hydrate like we do for everything else?

(mu/defn retrieve-pulse :- [:maybe (mi/InstanceOf Pulse)]
  "Fetch a single *Pulse*, and hydrate it with a set of 'standard' hydrations; remove Alert columns, since this is a
  *Pulse* and they will all be unset."
  [pulse-or-id]
  (some-> (t2/select-one Pulse :id (u/the-id pulse-or-id), :alert_condition nil)
          hydrate-notification
          notification->pulse))
(mu/defn retrieve-notification :- [:maybe (mi/InstanceOf Pulse)]
  "Fetch an Alert or Pulse, and do the 'standard' hydrations, adding `:channels` with `:recipients`, `:creator`, and
  `:cards`."
  [notification-or-id & additional-conditions]
  {:pre [(even? (count additional-conditions))]}
  (some-> (apply t2/select-one Pulse :id (u/the-id notification-or-id), additional-conditions)
          hydrate-notification))
(mu/defn ^:private notification->alert :- (mi/InstanceOf Pulse)
  "Take a generic `Notification` and put it in the standard `Alert` format the frontend expects. This really just
  consists of collapsing `:cards` into a `:card` key with whatever the first Card is."
  [notification :- (mi/InstanceOf Pulse)]
  (-> notification
      (assoc :card (first (:cards notification)))
      (dissoc :cards)))
(mu/defn retrieve-alert :- [:maybe (mi/InstanceOf Pulse)]
  "Fetch a single Alert by its `id` value, do the standard hydrations, and put it in the standard `Alert` format."
  [alert-or-id]
  (some-> (t2/select-one Pulse, :id (u/the-id alert-or-id), :alert_condition [:not= nil])
          hydrate-notification
          notification->alert))
(defn- query-as [model query]
  (t2/select model query))
(mu/defn retrieve-alerts :- [:sequential (mi/InstanceOf Pulse)]
  "Fetch all Alerts."
  ([]
   (retrieve-alerts nil))
  ([{:keys [archived? user-id]
     :or   {archived? false}}]
   (assert boolean? archived?)
   (let [query (merge {:select-distinct [:p.* [[:lower :p.name] :lower-name]]
                       :from            [[:pulse :p]]
                       :where           [:and
                                         [:not= :p.alert_condition nil]
                                         [:= :p.archived archived?]
                                         (when user-id
                                           [:or
                                            [:= :p.creator_id user-id]
                                            [:= :pcr.user_id user-id]])]
                       :order-by        [[:lower-name :asc]]}
                      (when user-id
                        {:left-join [[:pulse_channel :pchan] [:= :p.id :pchan.pulse_id]
                                     [:pulse_channel_recipient :pcr] [:= :pchan.id :pcr.pulse_channel_id]]}))]
     (for [alert (hydrate-notifications (query-as Pulse query))
           :let  [alert (notification->alert alert)]
           ;; if for whatever reason the Alert doesn't have a Card associated with it (e.g. the Card was deleted) don't
           ;; return the Alert -- it's basically orphaned/invalid at this point. See #13575 -- we *should* be deleting
           ;; Alerts if their associated PulseCard is deleted, but that's not currently the case.
           :when (:card alert)]
       alert))))
(mu/defn retrieve-pulses :- [:sequential (mi/InstanceOf Pulse)]
  "Fetch all `Pulses`. When `user-id` is included, only fetches `Pulses` for which the provided user is the creator
  or a recipient."
  [{:keys [archived? dashboard-id user-id]
    :or   {archived? false}}]
  (let [query {:select-distinct [:p.* [[:lower :p.name] :lower-name]]
               :from            [[:pulse :p]]
               :left-join       (concat
                                 [[:report_dashboard :d] [:= :p.dashboard_id :d.id]]
                                 (when user-id
                                   [[:pulse_channel :pchan]         [:= :p.id :pchan.pulse_id]
                                    [:pulse_channel_recipient :pcr] [:= :pchan.id :pcr.pulse_channel_id]]))
               :where           [:and
                                 [:= :p.alert_condition nil]
                                 [:= :p.archived archived?]
                                 ;; Only return dashboard subscriptions for non-archived dashboards
                                 [:or
                                  [:= :p.dashboard_id nil]
                                  [:= :d.archived false]]
                                 (when dashboard-id
                                   [:= :p.dashboard_id dashboard-id])
                                 ;; Only return dashboard subscriptions when `user-id` is passed, so that legacy
                                 ;; pulses don't show up in the notification management page
                                 (when user-id
                                   [:and
                                    [:not= :p.dashboard_id nil]
                                    [:or
                                     [:= :p.creator_id user-id]
                                     [:= :pcr.user_id user-id]]])]
               :order-by        [[:lower-name :asc]]}]
    (for [pulse (query-as Pulse query)]
      (-> pulse
          (dissoc :lower-name)
          hydrate-notification
          notification->pulse))))

Find all alerts for card-id that user-id is set to receive

(defn retrieve-user-alerts-for-card
  [{:keys [archived? card-id user-id]
    :or   {archived? false}}]
  (assert boolean? archived?)
  (map (comp notification->alert hydrate-notification)
       (query-as Pulse
                 {:select [:p.*]
                  :from   [[:pulse :p]]
                  :join   [[:pulse_card :pc] [:= :p.id :pc.pulse_id]
                           [:pulse_channel :pchan] [:= :pchan.pulse_id :p.id]
                           [:pulse_channel_recipient :pcr] [:= :pchan.id :pcr.pulse_channel_id]]
                  :where  [:and
                           [:not= :p.alert_condition nil]
                           [:= :pc.card_id card-id]
                           [:= :pcr.user_id user-id]
                           [:= :p.archived archived?]]})))

Find all alerts for card-ids, used for admin users

(defn retrieve-alerts-for-cards
  [{:keys [archived? card-ids]
    :or   {archived? false}}]
  (when (seq card-ids)
    (map (comp notification->alert hydrate-notification)
         (query-as Pulse
                   {:select [:p.*]
                    :from   [[:pulse :p]]
                    :join   [[:pulse_card :pc] [:= :p.id :pc.pulse_id]]
                    :where  [:and
                             [:not= :p.alert_condition nil]
                             [:in :pc.card_id card-ids]
                             [:= :p.archived archived?]]}))))
(mu/defn card->ref :- CardRef
  "Create a card reference from a card or id"
  [card :- :map]
  {:id                (u/the-id card)
   :include_csv       (get card :include_csv false)
   :include_xls       (get card :include_xls false)
   :dashboard_card_id (get card :dashboard_card_id nil)})

------------------------------------------ Other Persistence Functions -------------------------------------------

Update the PulseCards for a given notification-or-id. card-refs should be a definitive collection of all Cards for the Notification in the desired order. They should have keys like id, include_csv, and include_xls.

  • If a Card ID in card-refs has no corresponding existing PulseCard object, one will be created.
  • If an existing PulseCard has no corresponding ID in CARD-IDs, it will be deleted.
  • All cards will be updated with a position according to their place in the collection of card-ids
(mu/defn update-notification-cards!
  [notification-or-id card-refs :- [:maybe [:sequential CardRef]]]
  ;; first off, just delete any cards associated with this pulse (we add them again below)
  (t2/delete! PulseCard :pulse_id (u/the-id notification-or-id))
  ;; now just insert all of the cards that were given to us
  (when (seq card-refs)
    (let [cards (map-indexed (fn [i {card-id :id :keys [include_csv include_xls dashboard_card_id]}]
                               {:pulse_id          (u/the-id notification-or-id)
                                :card_id           card-id
                                :position          i
                                :include_csv       include_csv
                                :include_xls       include_xls
                                :dashboard_card_id dashboard_card_id})
                             card-refs)]
      (t2/insert! PulseCard cards))))

Utility function used by [[update-notification-channels!]] which determines how to properly update a single pulse channel.

(defn- create-update-delete-channel!
  [notification-or-id new-channel existing-channel]
  ;; NOTE that we force the :id of the channel being updated to the :id we *know* from our
  ;;      existing list of PulseChannels pulled from the db to ensure we affect the right record
  (let [channel (when new-channel
                  (assoc new-channel
                         :pulse_id       (u/the-id notification-or-id)
                         :id             (:id existing-channel)
                         :enabled        (:enabled new-channel)
                         :channel_type   (keyword (:channel_type new-channel))
                         :schedule_type  (keyword (:schedule_type new-channel))
                         :schedule_frame (keyword (:schedule_frame new-channel))))]
    (cond
      ;; 1. in channels, NOT in db-channels = CREATE
      (and channel (not existing-channel))  (pulse-channel/create-pulse-channel! channel)
      ;; 2. NOT in channels, in db-channels = DELETE
      (and (nil? channel) existing-channel) (t2/delete! PulseChannel :id (:id existing-channel))
      ;; 3. in channels, in db-channels = UPDATE
      (and channel existing-channel)        (pulse-channel/update-pulse-channel! channel)
      ;; 4. NOT in channels, NOT in db-channels = NO-OP
      :else                                 nil)))

Update the PulseChannels for a given notification-or-id. channels should be a definitive collection of all of the channels for the Notification.

  • If a channel in the list has no existing PulseChannel object, one will be created.

  • If an existing PulseChannel has no corresponding entry in channels, it will be deleted.

  • All previously existing channels will be updated with their most recent information.

(mu/defn update-notification-channels!
  [notification-or-id channels :- [:sequential :map]]
  (let [new-channels   (group-by (comp keyword :channel_type) channels)
        old-channels   (group-by (comp keyword :channel_type) (t2/select PulseChannel
                                                                :pulse_id (u/the-id notification-or-id)))
        handle-channel #(create-update-delete-channel! (u/the-id notification-or-id)
                                                       (first (get new-channels %))
                                                       (first (get old-channels %)))]
    (assert (zero? (count (get new-channels nil)))
      "Cannot have channels without a :channel_type attribute")
    ;; don't automatically archive this Pulse if we end up deleting its last PulseChannel -- we're probably replacing
    ;; it with a new one immediately thereafter.
    (binding [pulse-channel/*archive-parent-pulse-when-last-channel-is-deleted* false]
      ;; for each of our possible channel types call our handler function
      (doseq [[channel-type] pulse-channel/channel-types]
        (handle-channel channel-type)))))

Create a new Pulse/Alert with the properties specified in notification; add the card-refs to the Notification and add the Notification to channels. Returns the id of the newly created Notification.

(mu/defn ^:private create-notification-and-add-cards-and-channels!
  [notification card-refs :- [:maybe [:sequential CardRef]] channels]
  (t2/with-transaction [_conn]
    (let [notification (first (t2/insert-returning-instances! Pulse notification))]
      (update-notification-cards! notification card-refs)
      (update-notification-channels! notification channels)
      (u/the-id notification))))

Create a new Pulse by inserting it into the database along with all associated pieces of data such as: PulseCards, PulseChannels, and PulseChannelRecipients.

Returns the newly created Pulse, or throws an Exception.

(mu/defn create-pulse!
  {:style/indent 2}
  [cards    :- [:sequential [:map-of :keyword :any]]
   channels :- [:sequential [:map-of :keyword :any]]
   kvs      :- [:map
                [:name                                 ms/NonBlankString]
                [:creator_id                           ms/PositiveInt]
                [:skip_if_empty       {:optional true} [:maybe :boolean]]
                [:collection_id       {:optional true} [:maybe ms/PositiveInt]]
                [:collection_position {:optional true} [:maybe ms/PositiveInt]]
                [:dashboard_id        {:optional true} [:maybe ms/PositiveInt]]
                [:parameters          {:optional true} [:maybe [:sequential :map]]]]]
  (let [pulse-id (create-notification-and-add-cards-and-channels! kvs cards channels)]
    ;; return the full Pulse (and record our create event).
    (u/prog1 (retrieve-pulse pulse-id)
      (events/publish-event! :event/subscription-create {:object <>
                                                         :user-id api/*current-user-id*}))))

Creates a pulse with the correct fields specified for an alert

(defn create-alert!
  [alert creator-id card-id channels]
  (let [id (-> alert
               (assoc :skip_if_empty true, :creator_id creator-id)
               (create-notification-and-add-cards-and-channels! [card-id] channels))]
    ;; return the full Pulse (and record our create event)
    (retrieve-alert id)))
(mu/defn ^:private notification-or-id->existing-card-refs :- [:sequential CardRef]
  [notification-or-id]
  (t2/select [PulseCard [:card_id :id] :include_csv :include_xls :dashboard_card_id]
    :pulse_id (u/the-id notification-or-id)
    {:order-by [[:position :asc]]}))
(mu/defn ^:private card-refs-have-changed? :- :boolean
  [notification-or-id new-card-refs :- [:sequential CardRef]]
  (not= (notification-or-id->existing-card-refs notification-or-id)
        new-card-refs))
(mu/defn ^:private update-notification-cards-if-changed! [notification-or-id new-card-refs]
  (when (card-refs-have-changed? notification-or-id new-card-refs)
    (update-notification-cards! notification-or-id new-card-refs)))

Update the supplied keys in a notification.

(mu/defn update-notification!
  [notification :- [:map
                    [:id                    ms/PositiveInt]
                    [:name                {:optional true} ms/NonBlankString]
                    [:alert_condition     {:optional true} AlertConditions]
                    [:alert_above_goal    {:optional true} boolean?]
                    [:alert_first_only    {:optional true} boolean?]
                    [:skip_if_empty       {:optional true} boolean?]
                    [:collection_id       {:optional true} [:maybe ms/PositiveInt]]
                    [:collection_position {:optional true} [:maybe ms/PositiveInt]]
                    [:cards               {:optional true} [:sequential CoercibleToCardRef]]
                    [:channels            {:optional true} [:sequential :map]]
                    [:archived            {:optional true} boolean?]
                    [:parameters          {:optional true} [:maybe [:sequential :map]]]]]
  (t2/update! Pulse (u/the-id notification)
    (u/select-keys-when notification
      :present [:collection_id :collection_position :archived]
      :non-nil [:name :alert_condition :alert_above_goal :alert_first_only :skip_if_empty :parameters]))
  ;; update Cards if the 'refs' have changed
  (when (contains? notification :cards)
    (update-notification-cards-if-changed! notification (map card->ref (:cards notification))))
  ;; update channels as needed
  (when (contains? notification :channels)
    (update-notification-channels! notification (:channels notification))))

Update an existing Pulse, including all associated data such as: PulseCards, PulseChannels, and PulseChannelRecipients.

Returns the updated Pulse or throws an Exception.

(defn update-pulse!
  [pulse]
  (update-notification! pulse)
  ;; fetch the fully updated pulse, log an update event, and return it
  (u/prog1 (retrieve-pulse (u/the-id pulse))
    (events/publish-event! :event/subscription-update {:object <> :user-id api/*current-user-id*})))

Convert an 'Alert` back into the generic 'Notification' format.

(defn- alert->notification
  [{:keys [card cards], :as alert}]
  (let [card  (or card (first cards))
        cards (when card [(card->ref card)])]
    (cond-> (-> (assoc alert :skip_if_empty true)
                (dissoc :card))
      (seq cards) (assoc :cards cards))))

Updates the given alert and returns it

TODO - why do we make sure to strictly validate everything when we create a PULSE but not when we create an ALERT?

(defn update-alert!
  [alert]
  (update-notification! (alert->notification alert))
  ;; fetch the fully updated pulse, log an update event, and return it
  (u/prog1 (retrieve-alert (u/the-id alert))
    (events/publish-event! :event/alert-update {:object <> :user-id api/*current-user-id*})))

------------------------------------------------- Serialization --------------------------------------------------

(defmethod serdes/extract-one "Pulse"
  [_model-name _opts pulse]
  (cond-> (serdes/extract-one-basics "Pulse" pulse)
    (:collection_id pulse) (update :collection_id serdes/*export-fk* 'Collection)
    (:dashboard_id  pulse) (update :dashboard_id  serdes/*export-fk* 'Dashboard)
    true                   (update :creator_id    serdes/*export-user*)))
(defmethod serdes/load-xform "Pulse" [pulse]
  (cond-> (serdes/load-xform-basics pulse)
      true                   (update :creator_id    serdes/*import-user*)
      (:collection_id pulse) (update :collection_id serdes/*import-fk* 'Collection)
      (:dashboard_id  pulse) (update :dashboard_id  serdes/*import-fk* 'Dashboard)))
(defmethod serdes/dependencies "Pulse" [{:keys [collection_id dashboard_id]}]
  (filterv some? [(when collection_id [{:model "Collection" :id collection_id}])
                  (when dashboard_id  [{:model "Dashboard"  :id dashboard_id}])]))
 
(ns metabase.models.pulse-card
  (:require
   [metabase.models.serialization :as serdes]
   [metabase.util :as u]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase.

(def PulseCard
  :model/PulseCard)
(methodical/defmethod t2/table-name :model/PulseCard [_model] :pulse_card)
(doto :model/PulseCard
  (derive :metabase/model)
  (derive :hook/entity-id))
(defmethod serdes/hash-fields PulseCard
  [_pulse-card]
  [(serdes/hydrated-hash :pulse)
   (serdes/hydrated-hash :card)
   :position])

Return the next available pulse_card.position for the given pulse

(defn next-position-for
  [pulse-id]
  {:pre [(integer? pulse-id)]}
  (-> (t2/select-one [PulseCard [:%max.position :max]] :pulse_id pulse-id)
      :max
      (some-> inc)
      (or 0)))
(def ^:private NewPulseCard
 [:map {:closed true}
  [:card_id                            ms/PositiveInt]
  [:pulse_id                           ms/PositiveInt]
  [:dashboard_card_id                  ms/PositiveInt]
  [:position          {:optional true} [:maybe ms/IntGreaterThanOrEqualToZero]]
  [:include_csv       {:optional true} [:maybe :boolean]]
  [:include_xls       {:optional true} [:maybe :boolean]]])

Creates new PulseCards, joining the given card, pulse, and dashboard card and setting appropriate defaults for other values if they're not provided.

(mu/defn bulk-create!
  [new-pulse-cards :- [:sequential NewPulseCard]]
  (t2/insert! PulseCard
    (for [{:keys [card_id pulse_id dashboard_card_id position include_csv include_xls]} new-pulse-cards]
      {:card_id           card_id
       :pulse_id          pulse_id
       :dashboard_card_id dashboard_card_id
       :position          (u/or-with some? position (next-position-for pulse_id))
       :include_csv       (boolean include_csv)
       :include_xls       (boolean include_xls)})))
(defmethod serdes/generate-path "PulseCard"
  [_ {:keys [pulse_id] :as card}]
  [(serdes/infer-self-path "Pulse" (t2/select-one 'Pulse :id pulse_id))
   (serdes/infer-self-path "PulseCard" card)])
(defmethod serdes/extract-one "PulseCard"
  [_model-name _opts card]
  (cond-> (serdes/extract-one-basics "PulseCard" card)
    true                      (update :card_id            serdes/*export-fk* 'Card)
    true                      (update :pulse_id           serdes/*export-fk* 'Pulse)
    (:dashboard_card_id card) (update :dashboard_card_id  serdes/*export-fk* 'DashboardCard)))
(defmethod serdes/load-xform "PulseCard" [card]
  (cond-> (serdes/load-xform-basics card)
    true                      (update :card_id            serdes/*import-fk* 'Card)
    true                      (update :pulse_id           serdes/*import-fk* 'Pulse)
    true                      (dissoc :dashboard_id)
    (:dashboard_card_id card) (update :dashboard_card_id  serdes/*import-fk* 'DashboardCard)))

Depends on the Pulse, Card and (optional) dashboard card.

(defmethod serdes/dependencies "PulseCard" [{:keys [card_id dashboard_card_id pulse_id]}]
  (let [base [[{:model "Card" :id card_id}]
              [{:model "Pulse" :id pulse_id}]]]
    (if-let [[dash-id _] dashboard_card_id]
      (conj base [{:model "Dashboard" :id dash-id}])
      base)))
 
(ns metabase.models.pulse-channel
  (:require
   [clojure.set :as set]
   [medley.core :as m]
   [metabase.config :as config]
   [metabase.db.query :as mdb.query]
   [metabase.models.interface :as mi]
   [metabase.models.pulse-channel-recipient :refer [PulseChannelRecipient]]
   [metabase.models.serialization :as serdes]
   [metabase.models.user :as user :refer [User]]
   [metabase.plugins.classloader :as classloader]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [methodical.core :as methodical]
   [schema.core :as s]
   [toucan2.core :as t2]))

Static Definitions

Simple vector of the days in the week used for reference and lookups.

NOTE: order is important here!! we use the same ordering as the clj-time day-of-week function (1 = Monday, 7 = Sunday) except that we are 0 based instead.

(def days-of-week
  [{:id "mon", :name "Mon"},
   {:id "tue", :name "Tue"},
   {:id "wed", :name "Wed"},
   {:id "thu", :name "Thu"},
   {:id "fri", :name "Fri"},
   {:id "sat", :name "Sat"},
   {:id "sun", :name "Sun"}])

Is day a valid day-of-week choice?

(def ^{:arglists '([day])} day-of-week?
  (partial contains? (set (map :id days-of-week))))

Is hour is a valid hour of the day (24 hour)?

(defn hour-of-day?
  [hour]
  (and (integer? hour) (<= 0 hour 23)))

Set of possible schedule-frames allow for a PulseChannel.

(def ^:private schedule-frames
  #{:first :mid :last})

Is frame a valid schedule frame?

(defn schedule-frame?
  [frame]
  (contains? schedule-frames frame))

Set of the possible schedule-types allowed for a PulseChannel.

(def ^:private schedule-types
  #{:hourly :daily :weekly :monthly})

Is schedule-type a valid PulseChannel schedule type?

(defn schedule-type?
  [schedule-type]
  (contains? schedule-types schedule-type))

Is this combination of scheduling choices valid?

(defn valid-schedule?
  [schedule-type schedule-hour schedule-day schedule-frame]
  (or
    ;; hourly schedule does not care about other inputs
    (= schedule-type :hourly)
    ;; daily schedule requires a valid `hour`
    (and (= schedule-type :daily)
         (hour-of-day? schedule-hour))
    ;; weekly schedule requires a valid `hour` and `day`
    (and (= schedule-type :weekly)
         (hour-of-day? schedule-hour)
         (day-of-week? schedule-day))
    ;; monthly schedule requires a valid `hour` and `frame`.  also a `day` if frame = first or last
    (and (= schedule-type :monthly)
         (schedule-frame? schedule-frame)
         (hour-of-day? schedule-hour)
         (or (contains? #{:first :last} schedule-frame)
             (and (= :mid schedule-frame)
                  (nil? schedule-day))))))

Map which contains the definitions for each type of pulse channel we allow. Each key is a channel type with a map which contains any other relevant information for defining the channel. E.g.

{:email {:name "Email", :recipients? true} :slack {:name "Slack", :recipients? false}}

(def channel-types
  {:email {:type              "email"
           :name              "Email"
           :allows_recipients true
           :recipients        ["user" "email"]
           :schedules         [:hourly :daily :weekly :monthly]}
   :slack {:type              "slack"
           :name              "Slack"
           :allows_recipients false
           :schedules         [:hourly :daily :weekly :monthly]
           :fields            [{:name        "channel"
                                :type        "select"
                                :displayName "Post to"
                                :options     []
                                :required    true}]}})

Is channel-type a valid value as a channel type? :tv:

(defn channel-type?
  [channel-type]
  (contains? (set (keys channel-types)) channel-type))

Does given channel type support a list of recipients? :tv:

(defn supports-recipients?
  [channel]
  (boolean (:allows_recipients (get channel-types channel))))

Entity

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase.

(def PulseChannel
  :model/PulseChannel)
(methodical/defmethod t2/table-name :model/PulseChannel [_model] :pulse_channel)
(methodical/defmethod t2/model-for-automagic-hydration [:default :pulse_channel] [_original-model _k] :model/PulseChannel)
(doto :model/PulseChannel
  (derive :metabase/model)
  (derive :hook/timestamped?)
  (derive :hook/entity-id)
  (derive ::mi/read-policy.always-allow)
  (derive ::mi/write-policy.superuser))
(t2/deftransforms :model/PulseChannel
 {:details mi/transform-json
  :channel_type mi/transform-keyword
  :schedule_type mi/transform-keyword
  :schedule_frame mi/transform-keyword})
(mi/define-simple-hydration-method recipients
  :recipients
  "Return the `PulseChannelRecipients` associated with this `pulse-channel`."
  [{pulse-channel-id :id, {:keys [emails]} :details}]
  (concat
   (for [email emails]
     {:email email})
   (t2/select
    [User :id :email :first_name :last_name]
    {:select    [:u.id :u.email :u.first_name :u.last_name]
     :from      [[:core_user :u]]
     :left-join [[:pulse_channel_recipient :pcr] [:= :u.id :pcr.user_id]]
     :where     [:and
                 [:= :pcr.pulse_channel_id pulse-channel-id]
                 [:= :u.is_active true]]
     :order-by [[:u.id :asc]]})))

Should we automatically archive a Pulse when its last PulseChannel is deleted? Normally we do, but this is disabled in [[update-notification-channels!]] which creates/deletes/updates several channels sequentially.

(def ^:dynamic *archive-parent-pulse-when-last-channel-is-deleted*
  true)
(t2/define-before-delete :model/PulseChannel
  [{pulse-id :pulse_id, pulse-channel-id :id}]
  ;; This function is called by [[metabase.models.pulse-channel/pre-delete]] when the `PulseChannel` is about to be
  ;; deleted. Archives `Pulse` if the channel being deleted is its last channel."
  (when *archive-parent-pulse-when-last-channel-is-deleted*
    (let [other-channels-count (t2/count PulseChannel :pulse_id pulse-id, :id [:not= pulse-channel-id])]
      (when (zero? other-channels-count)
        (t2/update! :model/Pulse pulse-id {:archived true})))))

we want to load this at the top level so the Setting the namespace defines gets loaded

(def ^:private ^{:arglists '([email-addresses])} validate-email-domains*
  (or (when config/ee-available?
        (classloader/require 'metabase-enterprise.advanced-config.models.pulse-channel)
        (resolve 'metabase-enterprise.advanced-config.models.pulse-channel/validate-email-domains))
      (constantly nil)))

For channels that are being sent to raw email addresses: check that the domains in the emails are allowed by the [[metabase-enterprise.advanced-config.models.pulse-channel/subscription-allowed-domains]] Setting, if set. This will no-op if subscription-allowed-domains is unset or if we do not have a premium token with the :advanced-config feature.

(defn validate-email-domains
  [{{:keys [emails]} :details, :keys [recipients], :as pulse-channel}]
  ;; Raw email addresses can be in either `[:details :emails]` or in `:recipients`, depending on who is invoking this
  ;; function. Make sure we handle both situations.
  ;;
  ;;    {:details {:emails [\"email@example.com\" ...]}}
  ;;
  ;;  The Dashboard Subscription FE currently sends raw email address recipients in this format:
  ;;
  ;;    {:recipients [{:email \"email@example.com\"} ...]}
  ;;
  (u/prog1 pulse-channel
    (let [raw-email-recipients (remove :id recipients)
          user-recipients      (filter :id recipients)
          emails               (concat emails (map :email raw-email-recipients))]
      (validate-email-domains* emails)
      ;; validate User `:id` & `:email` match up for User recipients. This is mostly to make sure people don't try to
      ;; be sneaky and pass in a valid User ID but different email so they can send test Pulses out to arbitrary email
      ;; addresses
      (when-let [user-ids (not-empty (into #{} (comp (filter some?) (map :id)) user-recipients))]
        (let [user-id->email (t2/select-pk->fn :email User, :id [:in user-ids])]
          (doseq [{:keys [id email]} user-recipients
                  :let               [correct-email (get user-id->email id)]]
            (when-not correct-email
              (throw (ex-info (tru "User {0} does not exist." id)
                              {:status-code 404})))
            ;; only validate the email address if it was explicitly specified, which is not explicitly required.
            (when (and email
                       (not= email correct-email))
              (throw (ex-info (tru "Wrong email address for User {0}." id)
                              {:status-code 403})))))))))
(t2/define-before-insert :model/PulseChannel
  [pulse-channel]
  (validate-email-domains pulse-channel))
(t2/define-before-update :model/PulseChannel
  [pulse-channel]
  (validate-email-domains (mi/pre-update-changes pulse-channel)))
(defmethod serdes/hash-fields PulseChannel
  [_pulse-channel]
  [(serdes/hydrated-hash :pulse) :channel_type :details :created_at])

Persistence Functions

Fetch all PulseChannels that are scheduled to run at a given time described by hour, weekday, monthday, and monthweek.

Examples:

(retrieve-scheduled-channels 14 "mon" :first :first) - 2pm on the first Monday of the month (retrieve-scheduled-channels 8 "wed" :other :last) - 8am on Wednesday of the last week of the month

Based on the given input the appropriate PulseChannels are returned:

  • hourly scheduled channels are always included.
  • daily scheduled channels are included if the hour matches.
  • weekly scheduled channels are included if the weekday & hour match.
  • monthly scheduled channels are included if the monthday, monthweek, weekday, & hour all match.
(s/defn retrieve-scheduled-channels
  [hour      :- (s/maybe s/Int)
   weekday   :- (s/maybe (s/pred day-of-week?))
   monthday  :-  (s/enum :first :last :mid :other)
   monthweek :- (s/enum :first :last :other)]
  (let [schedule-frame              (cond
                                      (= :mid monthday)    "mid"
                                      (= :first monthweek) "first"
                                      (= :last monthweek)  "last"
                                      :else                "invalid")
        monthly-schedule-day-or-nil (when (= :other monthday)
                                      weekday)]
    (t2/select [PulseChannel :id :pulse_id :schedule_type :channel_type]
      {:where [:and [:= :enabled true]
               [:or [:= :schedule_type "hourly"]
                [:and [:= :schedule_type "daily"]
                 [:= :schedule_hour hour]]
                [:and [:= :schedule_type "weekly"]
                 [:= :schedule_hour hour]
                 [:= :schedule_day weekday]]
                [:and [:= :schedule_type "monthly"]
                 [:= :schedule_hour hour]
                 [:= :schedule_frame schedule-frame]
                 [:or [:= :schedule_day weekday]
                  ;; this is here specifically to allow for cases where day doesn't have to match
                  [:= :schedule_day monthly-schedule-day-or-nil]]]]]})))

Update the PulseChannelRecipients for pulse-CHANNEL. user-ids should be a definitive collection of all IDs of users who should receive the pulse.

  • If an ID in user-ids has no corresponding existing PulseChannelRecipients object, one will be created.
  • If an existing PulseChannelRecipients has no corresponding ID in USER-IDs, it will be deleted.
(defn update-recipients!
  [id user-ids]
  {:pre [(integer? id)
         (coll? user-ids)
         (every? integer? user-ids)]}
  (let [recipients-old (set (t2/select-fn-set :user_id PulseChannelRecipient, :pulse_channel_id id))
        recipients-new (set user-ids)
        recipients+    (set/difference recipients-new recipients-old)
        recipients-    (set/difference recipients-old recipients-new)]
    (when (seq recipients+)
      (let [vs (map #(assoc {:pulse_channel_id id} :user_id %) recipients+)]
        (t2/insert! PulseChannelRecipient vs)))
    (when (seq recipients-)
      (t2/delete! (t2/table-name PulseChannelRecipient)
        :pulse_channel_id id
        :user_id          [:in recipients-]))))

Updates an existing PulseChannel along with all related data associated with the channel such as PulseChannelRecipients.

(defn update-pulse-channel!
  [{:keys [id channel_type enabled details recipients schedule_type schedule_day schedule_hour schedule_frame]
    :or   {details          {}
           recipients       []}}]
  {:pre [(integer? id)
         (channel-type? channel_type)
         (m/boolean? enabled)
         (schedule-type? schedule_type)
         (valid-schedule? schedule_type schedule_hour schedule_day schedule_frame)
         (coll? recipients)
         (every? map? recipients)]}
  (let [recipients-by-type (group-by integer? (filter identity (map #(or (:id %) (:email %)) recipients)))]
    (t2/update! PulseChannel id
                {:details        (cond-> details
                                   (supports-recipients? channel_type) (assoc :emails (get recipients-by-type false)))
                 :enabled        enabled
                 :schedule_type  schedule_type
                 :schedule_hour  (when (not= schedule_type :hourly)
                                   schedule_hour)
                 :schedule_day   (when (contains? #{:weekly :monthly} schedule_type)
                                   schedule_day)
                 :schedule_frame (when (= schedule_type :monthly)
                                   schedule_frame)})
    (when (supports-recipients? channel_type)
      (update-recipients! id (or (get recipients-by-type true) [])))))

Create a new PulseChannel along with all related data associated with the channel such as PulseChannelRecipients.

(defn create-pulse-channel!
  [{:keys [channel_type details enabled pulse_id recipients schedule_type schedule_day schedule_hour schedule_frame]
    :or   {details          {}
           recipients       []}}]
  {:pre [(channel-type? channel_type)
         (integer? pulse_id)
         (boolean? enabled)
         (schedule-type? schedule_type)
         (valid-schedule? schedule_type schedule_hour schedule_day schedule_frame)
         (coll? recipients)
         (every? map? recipients)]}
  (let [recipients-by-type (group-by integer? (filter identity (map #(or (:id %) (:email %)) recipients)))
        {:keys [id]}       (first (t2/insert-returning-instances!
                                    PulseChannel
                                    :pulse_id       pulse_id
                                    :channel_type   channel_type
                                    :details        (cond-> details
                                                      (supports-recipients? channel_type) (assoc :emails (get recipients-by-type false)))
                                    :enabled        enabled
                                    :schedule_type  schedule_type
                                    :schedule_hour  (when (not= schedule_type :hourly)
                                                      schedule_hour)
                                    :schedule_day   (when (contains? #{:weekly :monthly} schedule_type)
                                                      schedule_day)
                                    :schedule_frame (when (= schedule_type :monthly)
                                                      schedule_frame)))]
    (when (and (supports-recipients? channel_type) (seq (get recipients-by-type true)))
      (update-recipients! id (get recipients-by-type true)))
    ;; return the id of our newly created channel
    id))
(methodical/defmethod mi/to-json PulseChannel
  "Don't include `:emails`, we use that purely internally"
  [pulse-channel json-generator]
  (next-method (m/dissoc-in pulse-channel [:details :emails]) json-generator))
(defmethod serdes/generate-path "PulseChannel"
  [_ {:keys [pulse_id] :as channel}]
  [(serdes/infer-self-path "Pulse" (t2/select-one 'Pulse :id pulse_id))
   (serdes/infer-self-path "PulseChannel" channel)])
(defmethod serdes/extract-one "PulseChannel"
  [_model-name _opts channel]
  (let [recipients (mapv :email (mdb.query/query {:select [:user.email]
                                                  :from   [[:pulse_channel_recipient :pcr]]
                                                  :join   [[:core_user :user] [:= :user.id :pcr.user_id]]
                                                  :where  [:= :pcr.pulse_channel_id (:id channel)]}))]
    (-> (serdes/extract-one-basics "PulseChannel" channel)
        (update :pulse_id   serdes/*export-fk* 'Pulse)
        (assoc  :recipients recipients))))
(defmethod serdes/load-xform "PulseChannel" [channel]
  (-> channel
      serdes/load-xform-basics
      (update :pulse_id serdes/*import-fk* 'Pulse)))
(defn- import-recipients [channel-id emails]
  (let [incoming-users (set (for [email emails
                                  :let [id (t2/select-one-pk 'User :email email)]]
                              (or id
                                  (:id (user/serdes-synthesize-user! {:email email})))))
        current-users  (set (t2/select-fn-set :user_id PulseChannelRecipient :pulse_channel_id channel-id))
        combined       (set/union incoming-users current-users)]
    (when-not (empty? combined)
      (update-recipients! channel-id combined))))

Customized load-insert! and load-update! to handle the embedded recipients field - it's really a separate table.

(defmethod serdes/load-insert! "PulseChannel" [_ ingested]
  (let [;; Call through to the default load-insert!
        chan ((get-method serdes/load-insert! "") "PulseChannel" (dissoc ingested :recipients))]
    (import-recipients (:id chan) (:recipients ingested))
    chan))
(defmethod serdes/load-update! "PulseChannel" [_ ingested local]
  ;; Call through to the default load-update!
  (let [chan ((get-method serdes/load-update! "") "PulseChannel" (dissoc ingested :recipients) local)]
    (import-recipients (:id local) (:recipients ingested))
    chan))

Depends on the Pulse.

(defmethod serdes/dependencies "PulseChannel" [{:keys [pulse_id]}]
  [[{:model "Pulse" :id pulse_id}]])
 
(ns metabase.models.pulse-channel-recipient
  (:require
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase.

(def PulseChannelRecipient
  :model/PulseChannelRecipient)
(methodical/defmethod t2/table-name :model/PulseChannelRecipient [_model] :pulse_channel_recipient)
(derive :model/PulseChannelRecipient :metabase/model)

Deletes PulseChannel if the recipient being deleted is its last recipient. (This only applies to PulseChannels with User subscriptions; Slack PulseChannels and ones with email address subscriptions are not automatically deleted.

(t2/define-before-delete :model/PulseChannelRecipient
  [{channel-id :pulse_channel_id, pulse-channel-recipient-id :id}]
  (let [other-recipients-count (t2/count PulseChannelRecipient
                                         :pulse_channel_id channel-id
                                         :id               [:not= pulse-channel-recipient-id])
        last-recipient?        (zero? other-recipients-count)]
    (when last-recipient?
      ;; make sure this channel doesn't have any email-address (non-User) recipients.
      (let [details              (t2/select-one-fn :details :model/PulseChannel :id channel-id)
            has-email-addresses? (seq (:emails details))]
        (when-not has-email-addresses?
          (t2/delete! :model/PulseChannel :id channel-id))))))
 

Functions related to the 'Query' model, which records stuff such as average query execution time.

(ns metabase.models.query
  (:require
   [cheshire.core :as json]
   [clojure.walk :as walk]
   [metabase.db :as mdb]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.models.interface :as mi]
   [metabase.util.honey-sql-2 :as h2x]
   [methodical.core :as methodical]
   [toucan2.core :as t2]
   [toucan2.model :as t2.model]))
(set! *warn-on-reflection* true)

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase.

(def Query
  :model/Query)
(methodical/defmethod t2/table-name :model/Query [_model] :query)
(methodical/defmethod t2.model/primary-keys :model/Query [_model] [:query_hash])
(t2/deftransforms :model/Query
 {:query mi/transform-json})
(derive :model/Query :metabase/model)

Helper Fns

Fetch the average execution time (in milliseconds) for query with QUERY-HASH if available. Returns nil if no information is available.

(defn average-execution-time-ms
  ^Integer [^bytes query-hash]
  {:pre [(instance? (Class/forName "[B") query-hash)]}
  (t2/select-one-fn :average_execution_time Query :query_hash query-hash))

Return appropriate type for use in SQL CAST(x AS type) statement. MySQL doesn't accept integer, so we have to use unsigned; Postgres doesn't accept unsigned. so we have to use integer. Yay SQL dialect differences :D

(defn- int-casting-type
  []
  (if (= (mdb/db-type) :mysql)
    :unsigned
    :integer))

Update the rolling average execution time for query with query-hash. Returns true if a record was updated, or false if no matching records were found.

(defn- update-rolling-average-execution-time!
  ^Boolean [query ^bytes query-hash ^Integer execution-time-ms]
  (let [avg-execution-time (h2x/cast (int-casting-type) (h2x/round (h2x/+ (h2x/* [:inline 0.9] :average_execution_time)
                                                                          [:inline (* 0.1 execution-time-ms)])
                                                                   [:inline 0]))]
    (or
     ;; if it DOES NOT have a query (yet) set that. In 0.31.0 we added the query.query column, and it gets set for all
     ;; new entries, so at some point in the future we can take this out, and save a DB call.
     (pos? (t2/update! Query
                       {:query_hash query-hash, :query nil}
                       {:query                 (json/generate-string query)
                        :average_execution_time avg-execution-time}))
     ;; if query is already set then just update average_execution_time. (We're doing this separate call to avoid
     ;; updating query on every single UPDATE)
     (pos? (t2/update! Query
                       {:query_hash query-hash}
                       {:average_execution_time avg-execution-time})))))

Record a query and its execution time for a query with query-hash that's not already present in the DB. execution-time-ms is used as a starting point.

(defn- record-new-query-entry!
  [query ^bytes query-hash ^Integer execution-time-ms]
  (first (t2/insert-returning-instances! Query
                                         :query                  query
                                         :query_hash             query-hash
                                         :average_execution_time execution-time-ms)))

Update the recorded average execution time (or insert a new record if needed) for query with query-hash.

(defn save-query-and-update-average-execution-time!
  [query, ^bytes query-hash, ^Integer execution-time-ms]
  {:pre [(instance? (Class/forName "[B") query-hash)]}
  (or
   ;; if there's already a matching Query update the rolling average
   (update-rolling-average-execution-time! query query-hash execution-time-ms)
   ;; otherwise try adding a new entry. If for some reason there was a race condition and a Query entry was added in
   ;; the meantime we'll try updating that existing record
   (try (record-new-query-entry! query query-hash execution-time-ms)
        (catch Throwable e
          (or (update-rolling-average-execution-time! query query-hash execution-time-ms)
              ;; rethrow e if updating an existing average execution time failed
              (throw e))))))

Return a map with :database-id and source :table-id that should be saved for a Card. Handles queries that use other queries as their source (ones that come in with a :source-table like card__100, or :source-query) recursively, as well as normal queries.

(defn query->database-and-table-ids
  [{database-id :database, query-type :type, {:keys [source-table source-query]} :query}]
  (cond
    (= :native query-type)  {:database-id database-id, :table-id nil}
    (integer? source-table) {:database-id database-id, :table-id source-table}
    (string? source-table)  (let [[_ card-id] (re-find #"^card__(\d+)$" source-table)]
                              (t2/select-one ['Card [:table_id :table-id] [:database_id :database-id]]
                                :id (Integer/parseInt card-id)))
    (map? source-query)     (query->database-and-table-ids {:database database-id
                                                            :type     query-type
                                                            :query    source-query})))

Return the ID of the card used as source table, if applicable; otherwise return nil.

(defn- parse-source-query-id
  [source-table]
  (when (string? source-table)
    (when-let [[_ card-id-str] (re-matches #"card__(\d+)" source-table)]
      (parse-long card-id-str))))

Return a sequence of model ids referenced in the MBQL query mbql-form.

(defn collect-card-ids
  [mbql-form]
  (let [ids (java.util.HashSet.)
        walker (fn [form]
                 (when (map? form)
                   ;; model references in native queries
                   (when-let [card-id (:card-id form)]
                     (when (int? card-id)
                       (.add ids card-id)))
                   ;; source tables (possibly in joins)
                   (when-let [card-id (parse-source-query-id (:source-table form))]
                     (.add ids card-id)))
                 form)]
    (walk/prewalk walker mbql-form)
    (seq ids)))

Wrap query map into a Query object (mostly to facilitate type dispatch).

(defn adhoc-query
  [query]
  (->> query
       mbql.normalize/normalize
       (hash-map :dataset_query)
       (merge (query->database-and-table-ids query))
       (mi/instance Query)))
 

A model used to cache query results in the database.

(ns metabase.models.query-cache
  (:require
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase.

(def QueryCache
  :model/QueryCache)
(methodical/defmethod t2/table-name :model/QueryCache [_model] :query_cache)
(methodical/defmethod t2/primary-keys QueryCache [_model] [:query_hash])
(doto :model/QueryCache
  (derive :metabase/model)
  (derive :hook/updated-at-timestamped?))
 

QueryExecution is a log of very time a query is executed, and other information such as the User who executed it, run time, context it was executed in, etc.

(ns metabase.models.query-execution
  (:require
   [malli.core :as mc]
   [malli.error :as me]
   [metabase.mbql.schema :as mbql.s]
   [metabase.models.interface :as mi]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase.

(def QueryExecution
  :model/QueryExecution)
(methodical/defmethod t2/table-name :model/QueryExecution [_model] :query_execution)
(derive :model/QueryExecution :metabase/model)
(t2/deftransforms :model/QueryExecution
  {:json_query mi/transform-json
   :status     mi/transform-keyword
   :context    mi/transform-keyword})
(defn- validate-context [context]
  (when-let [error (me/humanize (mc/explain mbql.s/Context context))]
    (throw (ex-info (tru "Invalid query execution context: {0}" (pr-str error))
                    {:error error}))))
(t2/define-before-insert :model/QueryExecution
  [{context :context, :as query-execution}]
  (u/prog1 query-execution
    (validate-context context)))
(t2/define-after-select :model/QueryExecution
  [{:keys [result_rows] :as query-execution}]
  ;; sadly we have 2 ways to reference the row count :(
  (assoc query-execution :row_count (or result_rows 0)))
(t2/define-before-update :model/QueryExecution
 [_query-execution]
 (throw (Exception. (tru "You cannot update a QueryExecution!"))))
 

Functions used to calculate the permissions needed to run a query based on old-style DATA ACCESS PERMISSIONS. The only thing that is subject to these sorts of checks are ad-hoc queries, i.e. queries that have not yet been saved as a Card. Saved Cards are subject to the permissions of the Collection to which they belong.

(ns metabase.models.query.permissions
  (:require
   [metabase.api.common :as api]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.interface :as mi]
   [metabase.models.permissions :as perms]
   [metabase.permissions.util :as perms.u]
   [metabase.query-processor.store :as qp.store]
   [metabase.query-processor.util :as qp.util]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

---------------------------------------------- Permissions Checking ----------------------------------------------

Is calculating permissions for queries complicated? Some would say so. Refer to this handy flow chart to see how things get calculated.

                 perms-set
                      |
                      |
                      |
 native query? <------+-----> mbql query?
       ↓                           ↓

adhoc-native-query-path mbql-perms-path-set | no source card <------+----> has source card ↓ ↓ tables->permissions-path-set source-card-read-perms ↓ table-query-path

segmented-perms-set follows the same graph as above, but instead of table-query-path, it returns table-sandboxed-query-path. perms-set will require full access to the tables, segmented-perms-set will only require segmented access

(mu/defn query->source-table-ids :- [:set [:or [:= ::native] ms/PositiveInt]]
  "Return a sequence of all Table IDs referenced by `query`."
  [query]
  (set
   (flatten
    (mbql.u/match query
      ;; if we come across a native query just put a placeholder (`::native`) there so we know we need to
      ;; add native permissions to the complete set below.
      (m :guard (every-pred map? :native))
      [::native]
      (m :guard (every-pred map? :source-table))
      (cons
       (:source-table m)
       (query->source-table-ids (dissoc m :source-table)))))))

Map of options to be passed to the permissions checking functions.

(def ^:private PermsOptions
  [:map
   [:segmented-perms?      {:optional true} :boolean]
   [:throw-exceptions?     {:optional true} [:maybe :boolean]]
   [:already-preprocessed? {:optional true} :boolean]
   [:table-perms-fn        {:optional true} fn?]
   [:native-perms-fn       {:optional true} fn?]])
(def ^:private TableOrIDOrNativePlaceholder
  [:or
   [:= ::native]
   ms/PositiveInt])
(mu/defn ^:private table-ids->id->schema :- [:maybe [:map-of ::lib.schema.id/table [:maybe :string]]]
  [table-ids :- [:maybe [:sequential ::lib.schema.id/table]]]
  (when (seq table-ids)
    (if (qp.store/initialized?)
      (into {}
            (map (fn [table-id]
                   ((juxt :id :schema) (lib.metadata/table (qp.store/metadata-provider) table-id))))
            table-ids)
      (t2/select-pk->fn :schema :model/Table :id [:in table-ids]))))
(mu/defn tables->permissions-path-set :- [:set perms.u/PathSchema]
  "Given a sequence of `tables-or-ids` referenced by a query, return a set of required permissions. A truthy value for
  `segmented-perms?` will return segmented permissions for the table rather that full table permissions.
  Custom `table-perms-fn` and `native-perms-fn` can be passed as options to generate permissions paths for feature-level
  permissions, such as download permissions."
  [database-or-id :- [:or ms/PositiveInt :map]
   tables-or-ids  :- [:set TableOrIDOrNativePlaceholder]
   {:keys [segmented-perms?
           table-perms-fn
           native-perms-fn]} :- PermsOptions]
  (let [table-ids           (filter integer? tables-or-ids)
        table-id->schema    (table-ids->id->schema table-ids)
        table-or-id->schema #(if (integer? %)
                               (table-id->schema %)
                               (:schema %))
        native-perms-fn     (or native-perms-fn perms/adhoc-native-query-path)
        table-perms-fn      (or table-perms-fn
                                (if segmented-perms?
                                  perms/table-sandboxed-query-path
                                  perms/table-query-path))]
    (set (for [table-or-id tables-or-ids]
           (if (= ::native table-or-id)
             ;; Any `::native` placeholders from above mean we need native ad-hoc query permissions for this DATABASE
             (native-perms-fn database-or-id)
             ;; anything else (i.e., a normal table) just gets normal table permissions
             (table-perms-fn (u/the-id database-or-id)
                             (table-or-id->schema table-or-id)
                             (u/the-id table-or-id)))))))
(mu/defn ^:private card-instance :- [:and
                                     (ms/InstanceOf :model/Card)
                                     [:map [:collection_id [:maybe ms/PositiveInt]]]]
  [card-id :- ::lib.schema.id/card]
  (or (if (qp.store/initialized?)
        (when-let [{:keys [collection-id]} (lib.metadata/card (qp.store/metadata-provider) card-id)]
          (t2/instance :model/Card {:collection_id collection-id}))
        (t2/select-one [:model/Card :collection_id] :id card-id))
      (throw (Exception. (tru "Card {0} does not exist." card-id)))))
(mu/defn ^:private source-card-read-perms :- [:set perms.u/PathSchema]
  "Calculate the permissions needed to run an ad-hoc query that uses a Card with `source-card-id` as its source
  query."
  [source-card-id :- ::lib.schema.id/card]
  (mi/perms-objects-set (card-instance source-card-id) :read))
(defn- preprocess-query [query]
  ;; ignore the current user for the purposes of calculating the permissions required to run the query. Don't want the
  ;; preprocessing to fail because current user doesn't have permissions to run it when we're not trying to run it at
  ;; all
  (binding [api/*current-user-id* nil]
    ((resolve 'metabase.query-processor/preprocess) query)))
(mu/defn ^:private mbql-permissions-path-set :- [:set perms.u/PathSchema]
  "Return the set of required permissions needed to run an adhoc `query`.
  Also optionally specify `throw-exceptions?` -- normally this function avoids throwing Exceptions to avoid breaking
  things when a single Card is busted (e.g. API endpoints that filter out unreadable Cards) and instead returns 'only
  admins can see this' permissions -- `#{\"db/0\"}` (DB 0 will never exist, thus normal users will never be able to
  get permissions for it, but admins have root perms and will still get to see (and hopefully fix) it)."
  [query :- [:map [:query ms/Map]]
   {:keys [throw-exceptions? already-preprocessed?], :as perms-opts} :- PermsOptions]
  (try
    (let [query (mbql.normalize/normalize query)]
      ;; if we are using a Card as our source, our perms are that Card's (i.e. that Card's Collection's) read perms
      (if-let [source-card-id (qp.util/query->source-card-id query)]
        (source-card-read-perms source-card-id)
        ;; otherwise if there's no source card then calculate perms based on the Tables referenced in the query
        (let [{:keys [query database]} (cond-> query
                                         (not already-preprocessed?) preprocess-query)]
          (tables->permissions-path-set database (query->source-table-ids query) perms-opts))))
    ;; if for some reason we can't expand the Card (i.e. it's an invalid legacy card) just return a set of permissions
    ;; that means no one will ever get to see it (except for superusers who get to see everything)
    (catch Throwable e
      (let [e (ex-info "Error calculating permissions for query"
                       {:query (or (u/ignore-exceptions (mbql.normalize/normalize query))
                                   query)}
                       e)]
        (when throw-exceptions?
          (throw e))
        (log/error e))
      #{"/db/0/"}))) ; DB 0 will never exist
(mu/defn ^:private perms-set* :- [:set perms.u/PathSchema]
  "Does the heavy lifting of creating the perms set. `opts` will indicate whether exceptions should be thrown and
  whether full or segmented table permissions should be returned."
  [{query-type :type, database :database, :as query} perms-opts :- PermsOptions]
  (cond
    (empty? query)                   #{}
    (= (keyword query-type) :native) #{(perms/adhoc-native-query-path database)}
    (= (keyword query-type) :query)  (mbql-permissions-path-set query perms-opts)
    :else                            (throw (ex-info (tru "Invalid query type: {0}" query-type)
                                                     {:query query}))))

Calculate the set of permissions including segmented (not full) table permissions.

(defn segmented-perms-set
  {:arglists '([query & {:keys [throw-exceptions? already-preprocessed?]}])}
  [query & {:as perms-opts}]
  (perms-set* query (assoc perms-opts :segmented-perms? true)))

Calculate the set of permissions required to run an ad-hoc query. Returns permissions for full table access (not segmented)

(defn perms-set
  {:arglists '([query & {:keys [throw-exceptions? already-preprocessed?]}])}
  [query & {:as perms-opts}]
  (perms-set* query (assoc perms-opts :segmented-perms? false)))

Return true if the current-user has sufficient permissions to run query. Handles checking for full table permissions and segmented table permissions

(mu/defn can-run-query?
  [query]
  (let [user-perms @api/*current-user-permissions-set*]
    (or (perms/set-has-full-permissions-for-set? user-perms (perms-set query))
        (perms/set-has-full-permissions-for-set? user-perms (segmented-perms-set query)))))

Does the current user have permissions to run an ad-hoc query against the Table with table-id?

(defn can-query-table?
  [database-id table-id]
  (can-run-query? {:database database-id
                   :type     :query
                   :query    {:source-table table-id}}))
 

The Recent Views table is used to track the most recent views of objects such as Cards, Tables and Dashboards for each user.

(ns metabase.models.recent-views
  (:require
    #_{:clj-kondo/ignore [:deprecated-namespace]}
   [java-time :as t]
   [metabase.util :as u]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [methodical.core :as m]
   [steffan-westcott.clj-otel.api.trace.span :as span]
   [toucan2.core :as t2]))
(doto :model/RecentViews
  (derive :metabase/model))
(m/defmethod t2/table-name :model/RecentViews
  [_model]
  :recent_views)
(t2/define-before-insert :model/RecentViews
  [log-entry]
  (let [defaults {:timestamp :%now}]
    (merge defaults log-entry)))

The number of recently viewed items to keep per user. This should be larger than the number of items returned by the /api/activity/recent_views endpoint, but it should still be lightweight to read all of a user's recent views at once.

(def ^:private ^:dynamic *recent-views-stored-per-user*
  30)

Returns a set of view IDs to prune from the RecentViews table so we only keep the most recent n views per user. Ensures that we keep the most recent dashboard view for the user.

(defn- view-ids-to-prune
  [prior-views n]
  (if (< (count prior-views) n)
    []
    (let [ids-to-keep                    (map :id (take n prior-views))
          ;; We want to make sure we keep the most recent dashboard view for the user
          ids-to-prune                   (map :id (drop n prior-views))
          most-recent-dashboard-id       (->> prior-views (filter #(= "dashboard" (:model %))) first :id)
          pruning-most-recent-dashboard? ((set ids-to-prune) most-recent-dashboard-id)]
      (if pruning-most-recent-dashboard?
        (conj (remove #{most-recent-dashboard-id} (set ids-to-prune))
              (last ids-to-keep))
        ids-to-prune))))

Updates the RecentViews table for a given user with a new view, and prunes old views.

(mu/defn update-users-recent-views!
  [user-id  :- [:maybe ms/PositiveInt]
   model    :- [:or
                [:enum :model/Card :model/Table :model/Dashboard]
                :string]
   model-id :- ms/PositiveInt]
  (when user-id
    (span/with-span!
      {:name       "update-users-recent-views!"
       :attributes {:model/id   model-id
                    :user/id    user-id
                    :model/name (u/lower-case-en model)}}
      (t2/with-transaction [_conn]
        (t2/insert! :model/RecentViews {:user_id  user-id
                                        :model    (u/lower-case-en (name model))
                                        :model_id model-id})
        (let [current-views (t2/select :model/RecentViews :user_id user-id {:order-by [[:id :desc]]})
              ids-to-prune  (view-ids-to-prune current-views *recent-views-stored-per-user*)]
          (when (seq ids-to-prune)
            (t2/delete! :model/RecentViews :id [:in ids-to-prune])))))))

Returns ID of the most recently viewed dashboard for a given user within the last 24 hours, or nil.

(defn most-recently-viewed-dashboard-id
  [user-id]
  (t2/select-one-fn
   :model_id
   :model/RecentViews
   {:where    [:and
               [:= :user_id user-id]
               [:= :model (h2x/literal "dashboard")]
               [:> :timestamp (t/minus (t/zoned-date-time) (t/days 1))]]
    :order-by [[:id :desc]]}))

Returns the most recent n unique views for a given user.

(defn user-recent-views
  ([user-id]
   (user-recent-views user-id *recent-views-stored-per-user*))
  ([user-id n]
   (let [all-user-views (t2/select-fn-vec #(select-keys % [:model :model_id])
                                          :model/RecentViews
                                          :user_id user-id
                                          {:order-by [[:id :desc]]
                                           :limit    *recent-views-stored-per-user*})]
     (->> (distinct all-user-views)
          (take n)
          ;; Lower-case the model name, since that's what the FE expects
          (map #(update % :model u/lower-case-en))))))
 
(ns metabase.models.revision
  (:require
   [cheshire.core :as json]
   [clojure.data :as data]
   [metabase.config :as config]
   [metabase.db.util :as mdb.u]
   [metabase.models.interface :as mi]
   [metabase.models.revision.diff :refer [diff-strings*]]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru tru]]
   [metabase.util.malli :as mu]
   [methodical.core :as methodical]
   [toucan2.core :as t2]
   [toucan2.model :as t2.model]))

Maximum number of revisions to keep for each individual object. After this limit is surpassed, the oldest revisions will be deleted.

(def ^:const max-revisions
  15)

Prepare an instance for serialization in a Revision.

(defmulti serialize-instance
  {:arglists '([model id instance])}
  mi/dispatch-on-model)

no default implementation for [[serialize-instance]]; models need to implement this themselves.

Return an object to the state recorded by serialized-instance.

(defmulti revert-to-revision!
  {:arglists '([model id user-id serialized-instance])}
  mi/dispatch-on-model)
(defmethod revert-to-revision! :default
  [model id _user-id serialized-instance]
  (t2/update! model id, serialized-instance))

Return a map describing the difference between object-1 and object-2.

(defmulti diff-map
  {:arglists '([model object-1 object-2])}
  mi/dispatch-on-model)
(defmethod diff-map :default
  [_model o1 o2]
  (when o1
    (let [[before after] (data/diff o1 o2)]
      {:before before
       :after  after})))

Return a seq of string describing the difference between object-1 and object-2.

Each string in the seq should be i18n-ed.

(defmulti diff-strings
  {:arglists '([model object-1 object-2])}
  mi/dispatch-on-model)
(defmethod diff-strings :default
  [model o1 o2]
  (diff-strings* (name model) o1 o2))

----------------------------------------------- Entity & Lifecycle -----------------------------------------------

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase.

(def Revision
  :model/Revision)
(methodical/defmethod t2/table-name :model/Revision [_model] :revision)
(doto :model/Revision
  (derive :metabase/model))
(t2/deftransforms :model/Revision
  {:object mi/transform-json})
(t2/define-before-insert :model/Revision
  [revision]
  (assoc revision
         :timestamp :%now
         :metabase_version config/mb-version-string
         :most_recent true))
(t2/define-before-update :model/Revision
  [_revision]
  (fn [& _] (throw (Exception. (tru "You cannot update a Revision!")))))
(t2/define-after-select :model/Revision
  ;; Call the appropriate `post-select` methods (including the type functions) on the `:object` this Revision recorded.
  ;; This is important for things like Card revisions, where the `:dataset_query` property needs to be normalized when
  ;; coming out of the DB.
  [{:keys [model] :as revision}]
  ;; in some cases (such as tests) we have 'fake' models that cannot be resolved normally; don't fail entirely in
  ;; those cases
  (let [model (u/ignore-exceptions (t2.model/resolve-model (symbol model)))]
    (cond-> revision
      model (update :object (partial mi/do-after-select model)))))

Delete old revisions of model with id when there are more than max-revisions in the DB.

(defn- delete-old-revisions!
  [model id]
  (when-let [old-revisions (seq (drop max-revisions (t2/select-fn-vec :id :model/Revision
                                                                      :model    (name model)
                                                                      :model_id id
                                                                      {:order-by [[:timestamp :desc]
                                                                                  [:id :desc]]})))]
    (t2/delete! :model/Revision :id [:in old-revisions])))
(t2/define-after-insert :model/Revision
  [revision]
  (u/prog1 revision
    (let [{:keys [id model model_id]} revision]
      ;; Note 1: Update the last `most_recent revision` to false (not including the current revision)
      ;; Note 2: We don't allow updating revision but this is a special case, so we by pass the check by
      ;; updating directly with the table name
      (t2/update! (t2/table-name :model/Revision)
                  {:model model :model_id model_id :most_recent true :id [:not= id]}
                  {:most_recent false})
      (delete-old-revisions! model model_id))))

Functions

(defn- revision-changes
  [model prev-revision revision]
  (cond
    (:is_creation revision)  [(deferred-tru "created this")]
    (:is_reversion revision) [(deferred-tru "reverted to an earlier version")]
    ;; We only keep [[revision/max-revisions]] number of revision per entity.
    ;; prev-revision can be nil when we generate description for oldest revision
    (nil? prev-revision)     [(deferred-tru "modified this")]
    :else                    (diff-strings model (:object prev-revision) (:object revision))))
(defn- revision-description-info
  [model prev-revision revision]
  (let [changes (revision-changes model prev-revision revision)]
    {:description          (if (seq changes)
                             (u/build-sentence changes)
                             ;; HACK: before #30285 we record revision even when there is nothing changed,
                             ;; so there are cases when revision can comeback as `nil`.
                             ;; This is a safe guard for us to not display "Crowberto null" as
                             ;; description on UI
                             (deferred-tru "created a revision with no change."))
     ;; this is used on FE
     :has_multiple_changes (> (count changes) 1)}))

Add enriched revision data such as :diff and :description as well as filter out some unnecessary props.

(defn add-revision-details
  [model revision prev-revision]
  (-> revision
      (assoc :diff (diff-map model (:object prev-revision) (:object revision)))
      (merge (revision-description-info model prev-revision revision))
      ;; add revision user details
      (t2/hydrate :user)
      (update :user select-keys [:id :first_name :last_name :common_name])
      ;; Filter out irrelevant info
      (dissoc :model :model_id :user_id :object)))

Get the revisions for model with id in reverse chronological order.

(mu/defn revisions
  [model :- [:fn mdb.u/toucan-model?]
   id    :- pos-int?]
  (t2/select Revision :model (name model) :model_id id {:order-by [[:id :desc]]}))

Fetch revisions for model with id and add details.

(mu/defn revisions+details
  [model :- [:fn mdb.u/toucan-model?]
   id    :- pos-int?]
  (when-let [revisions (revisions model id)]
    (loop [acc [], [r1 r2 & more] revisions]
      (if-not r2
        (conj acc (add-revision-details model r1 nil))
        (recur (conj acc (add-revision-details model r1 r2))
               (conj more r2))))))

Record a new Revision for entity with id if it's changed compared to the last revision. Returns object or nil if the object does not changed.

(mu/defn push-revision!
  [{:keys [id entity user-id object
           is-creation? message]
    :or   {is-creation? false}}     :- [:map {:closed true}
                                        [:id                            pos-int?]
                                        [:object                        :map]
                                        [:entity                        [:fn mdb.u/toucan-model?]]
                                        [:user-id                       pos-int?]
                                        [:is-creation? {:optional true} [:maybe :boolean]]
                                        [:message      {:optional true} [:maybe :string]]]]
  (let [serialized-object (serialize-instance entity id (dissoc object :message))
        last-object       (t2/select-one-fn :object Revision :model (name entity) :model_id id {:order-by [[:id :desc]]})]
    ;; make sure we still have a map after calling out serialization function
    (assert (map? serialized-object))
    ;; the last-object could have nested object, e.g: Dashboard can have multiple Card in it,
    ;; even though we call `post-select` on the `object`, the nested object might not be transformed correctly
    ;; E.g: Cards inside Dashboard will not be transformed
    ;; so to be safe, we'll just compare them as string
    (when-not (= (json/generate-string serialized-object)
                 (json/generate-string last-object))
      (t2/insert! Revision
                  :model        (name entity)
                  :model_id     id
                  :user_id      user-id
                  :object       serialized-object
                  :is_creation  is-creation?
                  :is_reversion false
                  :message      message)
      object)))

Revert entity with id to a given Revision.

(mu/defn revert!
  [info :- [:map {:closed true}
            [:id          pos-int?]
            [:user-id     pos-int?]
            [:revision-id pos-int?]
            [:entity      [:fn mdb.u/toucan-model?]]]]
  (let [{:keys [id user-id revision-id entity]} info
        serialized-instance (t2/select-one-fn :object Revision :model (name entity) :model_id id :id revision-id)]
    (t2/with-transaction [_conn]
      ;; Do the reversion of the object
      (revert-to-revision! entity id user-id serialized-instance)
      ;; Push a new revision to record this change
      (let [last-revision (t2/select-one Revision :model (name entity), :model_id id, {:order-by [[:id :desc]]})
            new-revision  (first (t2/insert-returning-instances! Revision
                                                                 :model        (name entity)
                                                                 :model_id     id
                                                                 :user_id      user-id
                                                                 :object       serialized-instance
                                                                 :is_creation  false
                                                                 :is_reversion true))]
        (add-revision-details entity new-revision last-revision)))))
 
(ns metabase.models.revision.diff
  (:require
   [clojure.core.match :refer [match]]
   [clojure.data :as data]
   [metabase.util.i18n :refer [deferred-tru]]
   [toucan2.core :as t2]))
(defn- diff-string [k v1 v2 identifier]
  (match [k v1 v2]
    [:name _ _]
    (deferred-tru "renamed {0} from \"{1}\" to \"{2}\ identifier v1 v2)
    [:description nil _]
    (deferred-tru "added a description")
    [:description (_ :guard some?) _]
    (deferred-tru "changed the description")
    [:private true false]
    (deferred-tru "made {0} public" identifier)
    [:private false true]
    (deferred-tru "made {0} private" identifier)
    [:public_uuid _ nil]
    (deferred-tru "made {0} private" identifier)
    [:public_uuid nil _]
    (deferred-tru "made {0} public" identifier)
    [:enable_embedding false true]
    (deferred-tru "enabled embedding")
    [:enable_embedding true false]
    (deferred-tru "disabled embedding")
    [:parameters _ _]
    (deferred-tru "changed the filters")
    [:embedding_params _ _]
    (deferred-tru "changed the embedding parameters")
    [:archived _ after]
    (if after
      (deferred-tru "archived {0}" identifier)
      (deferred-tru "unarchived {0}" identifier))
    [:collection_position _ _]
    (deferred-tru "changed pin position")
    [:collection_id nil coll-id]
    (deferred-tru "moved {0} to {1}" identifier (if coll-id
                                                  (t2/select-one-fn :name 'Collection coll-id)
                                                  (deferred-tru "Our analytics")))
    [:collection_id (prev-coll-id :guard int?) coll-id]
    (deferred-tru "moved {0} from {1} to {2}"
      identifier
      (t2/select-one-fn :name 'Collection prev-coll-id)
      (if coll-id
        (t2/select-one-fn :name 'Collection coll-id)
        (deferred-tru "Our analytics")))
    [:visualization_settings _ _]
    (deferred-tru "changed the visualization settings")
    ;;  Card specific
    [:parameter_mappings _ _]
    (deferred-tru "changed the filter mapping")
    [:collection_preview _ after]
    (if after
      (deferred-tru "enabled collection review")
      (deferred-tru "disabled collection preview"))
    [:dataset_query _ _]
    (deferred-tru "modified the query")
    [:dataset false true]
    (deferred-tru "turned this into a model")
    [:dataset true false]
    (deferred-tru "changed this from a model to a saved question")
    [:display _ _]
    (deferred-tru "changed the display from {0} to {1}" (name v1) (name v2))
    [:result_metadata _ _]
    (deferred-tru "edited the metadata")
    ;;  whenever database_id, query_type, table_id changed,
    ;; the dataset_query will changed so we don't need a description for this
    [#{:table_id :database_id :query_type} _ _]
    nil
    :else nil))

Join parts of a sentence together to build a compound one.

(defn build-sentence
  [parts]
  (when (seq parts)
    (cond
      (= (count parts) 1) (str (first parts) \.)
      (= (count parts) 2) (str (first parts) " " (deferred-tru "and")  " " (second parts) \.)
      :else               (str (first parts) ", " (build-sentence (rest parts))))))
(defn ^:private model-str->i18n-str
  [model-str]
  (case model-str
    "Dashboard" (deferred-tru "Dashboard")
    "Card"      (deferred-tru "Card")
    "Segment"   (deferred-tru "Segment")
    "Metric"    (deferred-tru "Metric")))

Create a seq of string describing how o1 is different from o2. The directionality of the statement should indicate that o1 changed into o2.

(defn diff-strings*
  [model o1 o2]
  (when-let [[before after] (data/diff o1 o2)]
    (let [ks         (keys (or after before))
          model-name (model-str->i18n-str model)]
      (loop [ks               ks
             identifier-count 0
             strings          []]
        (if-not (seq ks)
          strings
          (let [k          (first ks)
                identifier (if (zero? identifier-count) (deferred-tru "this {0}" model-name) (deferred-tru "it"))]
            (if-let [diff-str (diff-string k (k before) (k after) identifier)]
              (recur (rest ks) (inc identifier-count) (conj strings diff-str))
              (recur (rest ks) identifier-count strings))))))))
 

A namespace to handle getting the last edited information about items that satisfy the revision system. The revision system is a 'reversion' system, built to easily revert to previous states and can compute on demand a changelog. The revision system works through events and so when editing something, you should construct the last-edit-info yourself (using edit-information-for-user) rather looking at the revision table which might not be updated yet.

This constructs :last-edit-info, a map with keys :timestamp, :id, :first_name, :last_name, and :email. It is not a full User object (missing some superuser metadata, last login time, and a common name). This was done to prevent another db call and hooking up timestamps to users but this can be added if preferred.

(ns metabase.models.revision.last-edit
  (:require
   [clj-time.core :as time]
   [clojure.set :as set]
   [medley.core :as m]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [steffan-westcott.clj-otel.api.trace.span :as span]
   [toucan2.core :as t2]))
(def ^:private model->db-model {:card "Card" :dashboard "Dashboard"})

Schema of the :last-edit-info map. A subset of a user with a timestamp indicating when the last edit was.

these are all maybes as sometimes revisions don't exist, or users might be missing the names, etc

(def ^:private LastEditInfo
  [:map
   [:timestamp  [:maybe :any]]
   [:id         [:maybe ms/PositiveInt]]
   [:first_name [:maybe :string]]
   [:last_name  [:maybe :string]]
   [:email      [:maybe :string]]])

Spec for an item annotated with last-edit-info. Items are cards or dashboards. Optional because we may not always have revision history for all cards/dashboards.

(def MaybeAnnotated
  [:map
   [:last-edit-info {:optional true} LastEditInfo]])
(mu/defn with-last-edit-info :- MaybeAnnotated
  "Add the last edited information to a card. Will add a key `:last-edit-info`. Model should be one of `:dashboard` or
  `:card`. Gets the last edited information from the revisions table. If you need this information from a put route,
  use `@api/*current-user*` and a current timestamp since revisions are events and asynchronous."
  [{:keys [id] :as item} model :- [:enum :dashboard :card]]
  (span/with-span!
    {:name       "with-last-edit-info"
     :attributes {:item/id id}}
    (if-let [updated-info (t2/query-one {:select    [:u.id :u.email :u.first_name :u.last_name :r.timestamp]
                                         :from      [[:revision :r]]
                                         :left-join [[:core_user :u] [:= :u.id :r.user_id]]
                                         :where     [:and
                                                     [:= :r.most_recent true]
                                                     [:= :r.model (model->db-model model)]
                                                     [:= :r.model_id id]]})]
      (assoc item :last-edit-info updated-info)
      item)))
(mu/defn edit-information-for-user :- LastEditInfo
  "Construct the `:last-edit-info` map given a user. Useful for editing routes. Most edit info information comes from
  the revisions table. But this table is populated from events asynchronously so when editing and wanting
  last-edit-info, you must construct it from `@api/*current-user*` and the current timestamp rather than checking the
  revisions table as those revisions may not be present yet."
  [user]
  (merge {:timestamp (time/now)}
         (select-keys user [:id :first_name :last_name :email])))

Schema for the map of bulk last-item-info. A map of two keys, :card and :dashboard, each of which is a map from id to a LastEditInfo.:Schema

(def ^:private CollectionLastEditInfo
  [:map
   [:card      {:optional true} [:map-of :int LastEditInfo]]
   [:dashboard {:optional true} [:map-of :int LastEditInfo]]])
(mu/defn fetch-last-edited-info :- [:maybe CollectionLastEditInfo]
  "Fetch edited info from the revisions table. Revision information is timestamp, user id, email, first and last
  name. Takes card-ids and dashboard-ids and returns a map structured like
  {:card      {card_id      {:id :email :first_name :last_name :timestamp}}
   :dashboard {dashboard_id {:id :email :first_name :last_name :timestamp}}}"
  [{:keys [card-ids dashboard-ids]}]
  (when (seq (concat card-ids dashboard-ids))
    (let [latest-changes (t2/query {:select    [:u.id :u.email :u.first_name :u.last_name
                                                :r.model :r.model_id :r.timestamp]
                                    :from      [[:revision :r]]
                                    :left-join [[:core_user :u] [:= :u.id :r.user_id]]
                                    :where     [:and [:= :r.most_recent true]
                                                (into [:or]
                                                      (keep (fn [[model-name ids]]
                                                              (when (seq ids)
                                                                [:and [:= :model model-name] [:in :model_id ids]])))
                                                      [["Card" card-ids]
                                                       ["Dashboard" dashboard-ids]])]})]
      (->> latest-changes
           (group-by :model)
           (m/map-vals (fn [model-changes]
                         (into {} (map (juxt :model_id #(dissoc % :model :model_id)))  model-changes)))
           ;; keys are "Card" and "Dashboard" (model in revision table) back to keywords
           (m/map-keys (set/map-invert model->db-model))))))
 
(ns metabase.models.secret
  (:require
   [clojure.core.memoize :as memoize]
   [clojure.java.io :as io]
   [clojure.string :as str]
   [java-time.api :as t]
   [metabase.api.common :as api]
   [metabase.driver :as driver]
   [metabase.driver.util :as driver.u]
   [metabase.models.interface :as mi]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   [methodical.core :as methodical]
   [toucan2.core :as t2])
  (:import
   (java.io File)
   (java.nio.charset StandardCharsets)))
(set! *warn-on-reflection* true)

----------------------------------------------- Entity & Lifecycle -----------------------------------------------

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase.

(def Secret
  :model/Secret)
(methodical/defmethod t2/table-name :model/Secret [_model] :secret)
(doto Secret
  (derive :metabase/model)
  (derive :hook/timestamped?)
  (derive ::mi/read-policy.superuser)
  (derive ::mi/write-policy.superuser))
(t2/deftransforms :model/Secret
  {:value  mi/transform-secret-value
   :kind   mi/transform-keyword
   :source mi/transform-keyword})

---------------------------------------------- Hydration / Util Fns ----------------------------------------------

Returns the value of the given secret as a String. secret can be a Secret model object, or a secret-map (i.e. return value from db-details-prop->secret-map).

(defn value->string
  {:added "0.42.0"}
  ^String [{:keys [value] :as _secret}]
  (cond (string? value)
        value
        (bytes? value)
        (String. ^bytes value StandardCharsets/UTF_8)))

For the given conn-props (output of driver/connection-properties), return a map of all :type :secret properties, keyed by property name.

(defn conn-props->secret-props-by-name
  {:added "0.42.0"}
  [conn-props]
  (->> (filter #(= :secret (keyword (:type %))) conn-props)
    (reduce (fn [acc prop] (assoc acc (:name prop) prop)) {})))

Returns the value of the given secret instance in the form of a file. If the given instance has a :file-path as its source, a File referring to that is returned. Otherwise, the :value is written to a temporary file, which is then returned.

driver? is an optional argument that is only used if an ostensibly existing file value (i.e. :file-path) can't be resolved, in order to render a more user-friendly error message (by looking up the display names of the connection properties involved).

ext? is an optional argument that sets the file extension used for the temporary file, if one needs to be created.

(defn value->file!*
  {:added "0.42.0"}
  (^File [secret]
   (value->file!* secret nil))
  (^File [secret driver?]
   (value->file!* secret driver? nil))
  (^File [{:keys [connection-property-name id value] :as secret} driver? ext?]
   (if (= :file-path (:source secret))
     (let [secret-val          (value->string secret)
           ^File existing-file (File. secret-val)]
       (if (.exists existing-file)
         existing-file
         (let [error-source (cond
                              id
                              (tru "Secret ID {0}" id)
                              (and connection-property-name driver?)
                              (let [secret-props (-> (driver/connection-properties driver?)
                                                     conn-props->secret-props-by-name)]
                                (tru "File path for {0}" (-> (get secret-props connection-property-name)
                                                             :display-name)))
                              :else
                              (tru "Path"))]
           (throw (ex-info (tru "{0} points to non-existent file: {1}" error-source secret-val)
                           {:file-path secret-val
                            :secret    secret})))))
     (let [^File tmp-file (doto (File/createTempFile "metabase-secret_" ext?)
                            ;; make the file only readable by owner
                            (.setReadable false false)
                            (.setReadable true true)
                            (.deleteOnExit))]
       (log/tracef "Creating temp file for secret %s value at %s" (or id "") (.getAbsolutePath tmp-file))
       (with-open [out (io/output-stream tmp-file)]
         (let [^bytes v (cond
                          (string? value)
                          (.getBytes ^String value "UTF-8")
                          (bytes? value)
                          ^bytes value)]
           (.write out v)))
       tmp-file))))

Returns the value of the given secret instance in the form of a file. If the given instance has a :file-path as its source, a File referring to that is returned. Otherwise, the :value is written to a temporary file, which is then returned.

driver? is an optional argument that is only used if an ostensibly existing file value (i.e. :file-path) can't be resolved, in order to render a more user-friendly error message (by looking up the display names of the connection properties involved).

ext? is an optional argument that sets the file extension used for the temporary file, if one needs to be created.

(def
  ^java.io.File
  ^{:arglists '([{:keys [connection-property-name id value] :as secret} & [driver? ext?]])}
  value->file!
  (memoize/memo
   (with-meta value->file!*
     {::memoize/args-fn (fn [[secret _driver? ext?]]
                          ;; not clear if value->string could return nil due to the cond so we'll just cache on a key
                          ;; that is unique
                          [(vec (:value secret)) ext?])})))

Return a map of secret subproperties for the property connection-property-name.

(defn get-sub-props
  [connection-property-name]
  (let [sub-prop-types [:path :value :options :id]
        sub-prop #(keyword (str connection-property-name "-" (name %)))]
    (zipmap sub-prop-types (map sub-prop sub-prop-types))))

Regex for parsing base64 encoded file uploads.

(def uploaded-base-64-prefix-pattern
  #"^data:application/([^;]*);base64,")

Returns the latest Secret instance for the given id (meaning the one with the highest version).

(defn latest-for-id
  {:added "0.42.0"}
  [id]
  (t2/select-one Secret :id id {:order-by [[:version :desc]]}))

Returns a map containing :value and :source for the given conn-prop-nm. conn-prop-nm is expected to be the name of a connection property having :type :secret, and the relevant sub-properties (ex: -value, -path, etc.) will be resolved in order to calculate the returned map.

This returned map represents a partial Secret model instance (having some of the required properties set), but also represents a discrete property that can be used in connection testing (even without the Secret needing to be persisted). In addition to possibly having :value and :source populated (if the secret value can be resolved), its keys will always include:

:connection-property-name - the conn-prop-nm that was initially passed in, for use later in error handling. :subprops - a sequence of subproperties (keywords) that represent all secret related subproperties that might exist and be manipulated by the secret handling code (which are used to ensure all these internal and intermediate subproperties are removed from the connection-properties before building the JDBC spec).

(defn db-details-prop->secret-map
  {:added "0.42.0"}
  [details conn-prop-nm]
  (let [{path-kw :path, value-kw :value, options-kw :options, id-kw :id}
        (get-sub-props conn-prop-nm)
        value  (cond
                 ;; ssl-root-certs will need their prefix removed, and to be base 64 decoded (#20319)
                 (and (value-kw details) (#{"ssl-client-cert" "ssl-root-cert"} conn-prop-nm)
                      (re-find uploaded-base-64-prefix-pattern (value-kw details)))
                 (-> (value-kw details) (str/replace-first uploaded-base-64-prefix-pattern "") u/decode-base64)
                 (and (value-kw details) (#{"ssl-key"} conn-prop-nm)
                      (re-find uploaded-base-64-prefix-pattern (value-kw details)))
                 (.decode (java.util.Base64/getDecoder)
                          (str/replace-first (value-kw details) uploaded-base-64-prefix-pattern ""))
                 ;; the -value suffix was specified; use that
                 (value-kw details)
                 (value-kw details)
                 ;; the -path suffix was specified; this is actually a :file-path
                 (path-kw details)
                 (u/prog1 (path-kw details)
                   (when (premium-features/is-hosted?)
                     (throw (ex-info
                             (tru "{0} (a local file path) cannot be used in Metabase hosted environment" path-kw)
                             {:invalid-db-details-entry (select-keys details [path-kw])}))))
                 (id-kw details)
                 (:value (latest-for-id (id-kw details))))
        source (cond
                 ;; set the :source due to the -path suffix (see above))
                 (and (not= "uploaded" (options-kw details)) (path-kw details))
                 :file-path
                 (id-kw details)
                 (:source (latest-for-id (id-kw details))))]
    (cond-> {:connection-property-name conn-prop-nm, :subprops [path-kw value-kw id-kw]}
      value
      (assoc :value value
             :source source))))

Get the value of a secret property from the database details as a string.

(defn get-secret-string
  [details secret-property]
  (let [{path-kw :path, value-kw :value, options-kw :options, id-kw :id} (get-sub-props secret-property)
        id (id-kw details)
        ;; When a secret is updated, we get both a new value as well as the ID of old secret.
        value (or (when-let [value (value-kw details)]
                    (if (string? value)
                      value
                      (String. ^bytes value "UTF-8")))
                  (when id
                    (String. ^bytes (:value (latest-for-id id)) "UTF-8")))]
    (case (options-kw details)
      "uploaded" (try
                   ;; When a secret is updated, the value has already been decoded
                   ;; instead of checking if the string is base64 encoded, we just
                   ;; try to decoded it and leave it as is if the attempt fails.
                   (String. ^bytes (driver.u/decode-uploaded value) "UTF-8")
                   (catch IllegalArgumentException _
                     value))
      "local" (slurp (if id value (path-kw details)))
      value)))

The attributes of a secret which, if changed, will result in a version bump

(def
  ^{:doc  :private true}
  bump-version-keys
  [:kind :source :value])

Inserts a new secret value, or updates an existing one, for the given parameters. * if there is no existing Secret instance, inserts with the given field values * if there is an existing latest Secret instance, and the value (or any of the supporting fields, like kind or source) has changed, then inserts a new version with the given parameters. * if there is an existing latest Secret instance, but none of the aforementioned fields changed, then update it

(defn upsert-secret-value!
  {:added "0.42.0"}
  [existing-id nm kind src value]
  (let [insert-new     (fn [id v]
                         (let [inserted (first (t2/insert-returning-instances! Secret (cond-> {:version    v
                                                                                               :name       nm
                                                                                               :kind       kind
                                                                                               :source     src
                                                                                               :value      value
                                                                                               :creator_id api/*current-user-id*}
                                                                                        id
                                                                                        (assoc :id id))))]
                           ;; Toucan doesn't support composite primary keys, so adding a new record with incremented
                           ;; version for an existing ID won't return a result from t2/insert!, hence we may need to
                           ;; manually select it here
                           (t2/select-one Secret :id (or id (u/the-id inserted)) :version v)))
        latest-version (when existing-id (latest-for-id existing-id))]
    (if latest-version
      (if (= (select-keys latest-version bump-version-keys) [kind src value])
        (pos? (t2/update! Secret {:id existing-id :version (:version latest-version)}
                        {:name nm}))
        (insert-new (u/the-id latest-version) (inc (:version latest-version))))
      (insert-new nil 1))))

Reduces over the given db-details (a Database details map), for any secret type connection properties under the given driver, using the given reduce-fn, and returns the accumulated result.

reduce-fn is the reduction fn (i.e. the first arg to [[clojure.core/reduce-kv]]), and is therefore expected to have a 3-arity. Its first param is the accumulated db-details, its 2nd param (a String) is the connection property name, and the 3rd param (a map) is the connection property map itself (containing the :name, :type, etc.). This function will only be invoked with connection properties that are of the secret type.

In essence, this is a utility function to provide a generic mechanism for transforming db-details containing secret values.

(defn reduce-over-details-secret-values
  {:added "0.42.0"}
  [driver db-details reduce-fn]
  (let [conn-props-fn (get-method driver/connection-properties driver)]
    (if (and (map? db-details) (fn? conn-props-fn))
        (let [conn-props            (conn-props-fn driver)
              conn-secrets-by-name  (conn-props->secret-props-by-name conn-props)]
          (reduce-kv reduce-fn db-details conn-secrets-by-name))
        db-details)))

Expand certain secret sub-properties in the db-details, depending on the secret type, for admin purposes. This is invoked as part of a KV reduction over secret type connection-properties, so conn-prop-nm (a String), and conn-prop (a map containing the connection property definition) are also passed as parameters.

secret-or-id? is an optional param that, if passed, will be used to look up the derived secret values (to avoid a redundant app DB query if the caller already has this; if a nil param value is passed, then the secret ID will be looked up from the :db-details map at conn-prop-nm).

The keys/value pairs that may be added into db-details:

  • -value - the secret value itself, in the case that the secret is a file-path type (as opposed to a value we store directly); the purpose of expanding this is to repopulate the file paths in the UI at the cost of "exposing" the file path (which itself shouldn't be too risky, especially since it will only be shown to admins); only populated for file type secret values
  • -creator-id - the ID of the user who "created" the secret value for (i.e. the last person who updated it), for audit purposes; only populated for non-file type secret values
  • -created-at - the timestamp of the last time the secret value for was changed or updated; only populated for non-file type secret values
(defn expand-inferred-secret-values
  {:added "0.42.0"}
  [db-details conn-prop-nm _conn-prop & [secret-or-id]]
  (let [subprop (fn [prop-nm]
                  (keyword (str conn-prop-nm prop-nm)))
        secret* (cond (int? secret-or-id)
                      (latest-for-id secret-or-id)
                      (mi/instance-of? Secret secret-or-id)
                      secret-or-id
                      :else ; default; app DB look up from the ID in db-details
                      (latest-for-id (get db-details (subprop "-id"))))
        src     (:source secret*)]
    ;; always populate the -source, -creator-id, and -created-at sub properties
    (cond-> (assoc db-details (subprop "-source") src
                              (subprop "-creator-id") (:creator_id secret*))
      (some? (:created_at secret*))
      (assoc (subprop "-created-at") (t/format :iso-offset-date-time (:created_at secret*)))
      (= :file-path src) ; for file path sources only, populate the value
      (assoc (subprop "-value") (value->string secret*)))))

Expand certain inferred secret sub-properties in the database :details, for the purpose of serving requests by users with write permissions for the DB (ex: to edit an existing database or view its current details). This is to populate certain values that shouldn't be stored in the details blob itself, but which can be derived from the details->secret association itself. Refer to the docstring for [[expand-inferred-secret-values]] for full details.

(defn expand-db-details-inferred-secret-values
  {:added "0.42.0"}
  [database]
  (update database :details (fn [details]
                              (reduce-over-details-secret-values (driver.u/database->driver database)
                                                                 details
                                                                 expand-inferred-secret-values))))
(methodical/defmethod mi/to-json Secret
  "Never include the secret value in JSON."
  [secret json-generator]
  (next-method
   (dissoc secret :value)
   json-generator))
 

A Segment is a saved MBQL 'macro', expanding to a :filter subclause. It is passed in as a :filter subclause but is replaced by the expand-macros middleware with the appropriate clauses.

(ns metabase.models.segment
  (:require
   [clojure.set :as set]
   [medley.core :as m]
   [metabase.lib.core :as lib]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.jvm :as lib.metadata.jvm]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.lib.query :as lib.query]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.audit-log :as audit-log]
   [metabase.models.interface :as mi]
   [metabase.models.revision :as revision]
   [metabase.models.serialization :as serdes]
   [metabase.models.table :as table]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [methodical.core :as methodical]
   [toucan2.core :as t2]
   [toucan2.tools.hydrate :as t2.hydrate]))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase.

(def Segment
  :model/Segment)
(methodical/defmethod t2/table-name :model/Segment [_model] :segment)
(methodical/defmethod t2/model-for-automagic-hydration [:default :segment] [_original-model _k] :model/Segment)
(t2/deftransforms :model/Segment
  {:definition mi/transform-metric-segment-definition})
(doto :model/Segment
  (derive :metabase/model)
  (derive :hook/timestamped?)
  (derive :hook/entity-id)
  (derive ::mi/read-policy.full-perms-for-perms-set)
  (derive ::mi/write-policy.superuser)
  (derive ::mi/create-policy.superuser))
(t2/define-before-update :model/Segment  [{:keys [creator_id id], :as segment}]
  (u/prog1 (t2/changes segment)
    ;; throw an Exception if someone tries to update creator_id
    (when (contains? <> :creator_id)
      (when (not= (:creator_id <>) (t2/select-one-fn :creator_id Segment :id id))
        (throw (UnsupportedOperationException. (tru "You cannot update the creator_id of a Segment.")))))))
(defmethod mi/perms-objects-set Segment
  [segment read-or-write]
  (let [table (or (:table segment)
                  (t2/select-one ['Table :db_id :schema :id] :id (u/the-id (:table_id segment))))]
    (mi/perms-objects-set table read-or-write)))
(mu/defn ^:private definition-description :- [:maybe ::lib.schema.common/non-blank-string]
  "Calculate a nice description of a Segment's definition."
  [metadata-provider                                      :- lib.metadata/MetadataProvider
   {table-id :table_id, :keys [definition], :as _segment} :- (ms/InstanceOf :model/Segment)]
  (when (seq definition)
    (try
      (let [definition  (merge {:source-table table-id}
                               definition)
            database-id (u/the-id (lib.metadata.protocols/database metadata-provider))
            query       (lib.query/query-from-legacy-inner-query metadata-provider database-id definition)]
        (lib/describe-top-level-key query :filters))
      (catch Throwable e
        (log/error e (tru "Error calculating Segment description: {0}" (ex-message e)))
        nil))))
(mu/defn ^:private warmed-metadata-provider :- lib.metadata/MetadataProvider
  [database-id :- ::lib.schema.id/database
   segments    :- [:maybe [:sequential (ms/InstanceOf :model/Segment)]]]
  (let [metadata-provider (doto (lib.metadata.jvm/application-database-metadata-provider database-id)
                            (lib.metadata.protocols/store-metadatas!
                             :metadata/segment
                             (map #(lib.metadata.jvm/instance->metadata % :metadata/segment)
                                  segments)))
        field-ids         (mbql.u/referenced-field-ids (map :definition segments))
        fields            (lib.metadata.protocols/bulk-metadata metadata-provider :metadata/column field-ids)
        table-ids         (into #{}
                                cat
                                [(map :table-id fields)
                                 (map :table_id segments)])]
    ;; this is done for side effects
    (lib.metadata.protocols/bulk-metadata metadata-provider :metadata/table table-ids)
    metadata-provider))
(mu/defn ^:private segments->table-id->warmed-metadata-provider :- fn?
  [segments :- [:maybe [:sequential (ms/InstanceOf :model/Segment)]]]
  (let [table-id->db-id             (when-let [table-ids (not-empty (into #{} (map :table_id segments)))]
                                      (t2/select-pk->fn :db_id :model/Table :id [:in table-ids]))
        db-id->metadata-provider    (memoize
                                     (mu/fn db-id->warmed-metadata-provider :- lib.metadata/MetadataProvider
                                       [database-id :- ::lib.schema.id/database]
                                       (let [segments-for-db (filter (fn [segment]
                                                                       (= (table-id->db-id (:table_id segment))
                                                                          database-id))
                                                                     segments)]
                                         (warmed-metadata-provider database-id segments-for-db))))]
    (mu/fn table-id->warmed-metadata-provider :- lib.metadata/MetadataProvider
      [table-id :- ::lib.schema.id/table]
      (-> table-id table-id->db-id db-id->metadata-provider))))
(methodical/defmethod t2.hydrate/batched-hydrate [Segment :definition_description]
  [_model _key segments]
  (let [table-id->warmed-metadata-provider (segments->table-id->warmed-metadata-provider segments)]
    (for [segment segments
          :let    [metadata-provider (table-id->warmed-metadata-provider (:table_id segment))]]
      (assoc segment :definition_description (definition-description metadata-provider segment)))))

--------------------------------------------------- Revisions ----------------------------------------------------

(defmethod revision/serialize-instance Segment
  [_model _id instance]
  (dissoc instance :created_at :updated_at))
(defmethod revision/diff-map Segment
  [model segment1 segment2]
  (if-not segment1
    ;; this is the first version of the segment
    (m/map-vals (fn [v] {:after v}) (select-keys segment2 [:name :description :definition]))
    ;; do our diff logic
    (let [base-diff ((get-method revision/diff-map :default)
                     model
                     (select-keys segment1 [:name :description :definition])
                     (select-keys segment2 [:name :description :definition]))]
      (cond-> (merge-with merge
                          (m/map-vals (fn [v] {:after v}) (:after base-diff))
                          (m/map-vals (fn [v] {:before v}) (:before base-diff)))
        (or (get-in base-diff [:after :definition])
            (get-in base-diff [:before :definition])) (assoc :definition {:before (get segment1 :definition)
                                                                          :after  (get segment2 :definition)})))))

------------------------------------------------ Serialization ---------------------------------------------------

(defmethod serdes/hash-fields Segment
  [_segment]
  [:name (serdes/hydrated-hash :table) :created_at])
(defmethod serdes/extract-one "Segment"
  [_model-name _opts segment]
  (-> (serdes/extract-one-basics "Segment" segment)
      (update :table_id   serdes/*export-table-fk*)
      (update :creator_id serdes/*export-user*)
      (update :definition serdes/export-mbql)))
(defmethod serdes/load-xform "Segment" [segment]
  (-> segment
      serdes/load-xform-basics
      (update :table_id   serdes/*import-table-fk*)
      (update :creator_id serdes/*import-user*)
      (update :definition serdes/import-mbql)))
(defmethod serdes/dependencies "Segment" [{:keys [definition table_id]}]
  (into [] (set/union #{(serdes/table->path table_id)}
                      (serdes/mbql-deps definition))))
(defmethod serdes/storage-path "Segment" [segment _ctx]
  (let [{:keys [id label]} (-> segment serdes/path last)]
    (-> segment
        :table_id
        serdes/table->path
        serdes/storage-table-path-prefix
        (concat ["segments" (serdes/storage-leaf-file-name id label)]))))

---------------------------------------------- Audit Log Table ----------------------------------------------------

(defmethod audit-log/model-details :model/Segment
  [metric _event-type]
  (let [table-id (:table_id metric)
        db-id    (table/table-id->database-id table-id)]
    (assoc
     (select-keys metric [:name :description :revision_message])
     :table_id    table-id
     :database_id db-id)))
 

Defines several helper functions and multimethods for the serialization system. Serialization is an enterprise feature, but in the interest of keeping all the code for an entity in one place, these methods are defined here and implemented for all the exported models.

Whether to export a new model: - Generally, the high-profile user facing things (databases, questions, dashboards, snippets, etc.) are exported. - Internal or automatic things (users, activity logs, permissions) are not.

If the model is not exported, add it to the exclusion lists in the tests. Every model should be explicitly listed as exported or not, and a test enforces this so serialization isn't forgotten for new models.

(ns metabase.models.serialization
  (:refer-clojure :exclude [descendants])
  (:require
   [cheshire.core :as json]
   [clojure.core.match :refer [match]]
   [clojure.set :as set]
   [clojure.string :as str]
   [medley.core :as m]
   [metabase.db.connection :as mdb.connection]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.interface :as mi]
   [metabase.shared.models.visualization-settings :as mb.viz]
   [metabase.util :as u]
   [metabase.util.connection :as u.conn]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [toucan2.core :as t2]
   [toucan2.model :as t2.model]))
(set! *warn-on-reflection* true)

Serialization Overview

Serialization (or "serdes") is a system for exporting entities (Dashboards, Cards, Collections, etc.) from one Metabase instance to disk files, and later importing them into 1 or more separate Metabase instances.

There are two versions of serdes, known as v1 and v2. v2 was built in late 2022 to solve some problems with v1, especially: accidentally duplicating entities because of a human change like renaming a collection; and that several newly added models (eg. Timelines) were not added to serdes. v1's code is in metabase-enterprise.serialization.*; v2 is split between infrastructure in metabase-enterprise.serialization.v2.* and integration with each model in metabase.models.*.

There are tests which query the set of Toucan models and ensure that they either support serialization or are explicitly listed as exempt. Therefore serdes for new models is not forgotten.

More details

This file is probably best not read top to bottom - it's organized in def order, not necessarily a good order for understanding. Probably you want to read below on the "Export process" and "Import process" next.

Entity IDs

Every serializable entity needs the be identified in a way that is:

  1. unique, at least among the serialized entities
  2. permanent, even if eg. a collection's :name changes
  3. portable between Metabase instances and over time

Database primary keys fail (3); matching based on the value fails (2) and maybe (1). So there's no easy way to solve this requirement. We've taken three approaches for different kinds of entities:

  1. Some have unique names already and we can use those: Databases are uniquely named and don't change.
    • Some are unique within a namespace: Fields are unique in Tables, Tables in Schemas, Schemas in Databases.
  2. Some are "embedded" as part of a parent entity, and don't need to exist independently, eg. the recipients of a pulse/dashboard subscription are reduced to a list of email addresses.
  3. For everything else (Dashboards, Cards, etc.)
    • Add an entity_id column to the tables
    • Populate it on-insert with a randomly-generated NanoID like "V1StGXR8_Z5jdHi6B-myT".
    • For entities that existed before the column was added, have a portable way to rebuild them (see below on hashing).

Given the model name and an entity, returns its entity ID (which might be nil).

This abstracts over the exact definition of the "entity ID" for a given entity. By default this is a column, :entity_id.

Models that have a different portable ID (Database, Field, etc.) should override this.

(defmulti entity-id
  {:arglists '([model-name instance])}
  (fn [model-name _instance] model-name))
(defmethod entity-id :default [_ {:keys [entity_id]}]
  (str/trim entity_id))

Hashing entities

In the worst case, an entity is already present in two instances linked by serdes, and it doesn't have entity_id set because it existed before we added the column. If we write a migration to just generate random entity_ids on both sides, those entities will get duplicated on the next import.

So every entity implements [[hash-fields]], which determines the set of fields whose values are used to generate the hash. The 32-bit [[identity-hash]] is then used to seed the PRNG and generate a "random" NanoID. Since this is based on properties of the entity, it is reproducible on both export and import sides, so entities are not duplicated.

Before any export or import, [[metabase-enterprise.serialization.v2.backfill-ids/backfill-ids]] is called. It does SELECT * FROM SomeModel WHERE entity_id IS NULL and populates all the blanks with this hash-based NanoID.

Whoops, two kinds of backfill

Braden discovered in Nov 2023 that for more than a year, we've had two inconsistent ways to backfill all the entity_id fields in an instance.

  1. The one described above, [[metabase-enterprise.serialization.v2.backfill-ids/backfill-ids]] which runs before any export or import.
  2. A separate JAR command seed_entity_ids which is powered by [[metabase-enterprise.serialization.v2.entity-ids/seed-entity-ids!]] and uses the [[identity-hash]] hex strings directly rather than seeding a NanoID with them.

Therefore the import machinery has to look out for both kinds of IDs and use them. This is foolish and should be simplified. We should write a Clojure-powered migration that finds any short 8-character entity_ids and generates NanoIDs from them.

Hashes a Clojure value into an 8-character hex string, which is used as the identity hash. Don't call this outside a test, use [[identity-hash]] instead.

(defn raw-hash
  [target]
  (when (sequential? target)
    (assert (seq target) "target cannot be an empty sequence"))
  (format "%08x" (hash target)))

Returns a seq of functions which will be transformed into a seq of values for hash calculation by calling each function on an entity map.

(defmulti hash-fields
  {:arglists '([model-or-instance])}
  mi/dispatch-on-model)

Returns an identity hash string (8 hex digits) from an entity map.

This string is generated by: - calling [[hash-fields]] for the model - passing the entity to each function it returns - calling [[hash]] on that list - converting to an 8-character hex string

(defn identity-hash
  [entity]
  {:pre [(some? entity)]}
  (-> (for [f (hash-fields entity)]
        (f entity))
      raw-hash))

Returns true if s is a valid identity hash string.

(defn identity-hash?
  [s]
  (boolean (re-matches #"^[0-9a-fA-F]{8}$" s)))

Returns a function which accepts an entity and returns the identity hash of the value of the hydrated property under key k.

This is a helper for writing [[hash-fields]] implementations.

(defn hydrated-hash
  [k]
  (fn [entity]
    (or
     (some-> entity (t2/hydrate k) (get k) identity-hash)
     "<none>")))

Serdes paths and :serdes/meta

The Clojure maps from extraction and ingestion always include a special key :serdes/meta giving some information about the serialized entity. The value is always a vector of maps that give a "path" to the entity. This is not a filesystem path; rather it defines the nesting of some entities inside others.

Most paths are a single layer: [{:model "ModelName" :id "entity ID" :label "Human-readonly name"}] where :model and :id are required, and :label is optional.

But for some entities, it can be deeper. For example, Fields belong to Tables, which are in Schemas, which are in Databases. (Schemas don't exist separately in the appdb, but they're used here to keep Table names unique.) For example:

[{:model "Database" :id "my_db"}
 {:model "Schema"   :id "PUBLIC"}
 {:model "Table"    :id "Users"}
 {:model "Field"    :id "email"}]

Many of the serdes multimethods are keyed on the :model field of the leaf entry (the last).

Two kinds of nesting

To reiterate, :serdes/meta paths are not filesystem paths. When extracted entities are stored to disk.

Given the model name and raw entity from the database, returns a vector giving its path. (generate-path "ModelName" entity)

The path is a vector of maps, root first and this entity itself last. Each map looks like: {:model "ModelName" :id "entity ID, identity hash, or custom ID" :label "optional human label"}

(defmulti generate-path
  {:arglists '([model-name instance])}
  (fn [model-name _instance] model-name))

Returns {:model "ModelName" :id "id-string"}

(defn infer-self-path
  [model-name entity]
  (let [model (t2.model/resolve-model (symbol model-name))
        pk    (first (t2/primary-keys model))]
    {:model model-name
     :id    (or (entity-id model-name entity)
                (some-> (get entity pk) model identity-hash))}))

Common helper for defining [[generate-path]] for an entity that is (1) top-level, ie. a one layer path; (2) labeled by a single field, slugified.

For example, a Card's or Dashboard's :name field.

(defn maybe-labeled
  [model-name entity slug-key]
  (let [self  (infer-self-path model-name entity)
        label (get entity slug-key)]
    [(if label
       (assoc self :label (u/slugify label {:unicode? true}))
       self)]))
(defmethod generate-path :default [model-name entity]
  ;; This default works for most models, but needs overriding for nested ones.
  (maybe-labeled model-name entity :name))

Export Process

An export (writing a Metabase instance's entities to disk) happens in two stages: extraction and storage. These are independent, and deliberately decoupled. The result of extraction is a reducible stream of Clojure maps, each with :serdes/meta keys on them (see below about these paths). In particular, note that extraction happens inside Clojure, and has nothing to do with file formats or anything of the kind.

Storage takes the stream of extracted entities and actually stores it to disk or sends it over the network. Traditionally we serialize to a directory of YAML files, and that's the only storage approach currently implemented. But since the export process is split into (complicated) extraction and (straightforward) storage, we or a user could write a new storage layer fairly easily if we wanted to use JSON, protocol buffers, or any other format.

Both extraction and storage are written as a set of multimethods, with defaults for the common case.

Extraction

Extraction is controlled by a map of options and settings, with details below.

  • [[metabase-enterprise.serialization.v2.models/exported-models]] gives the set of models to be exported.
    • A test enforces that all models are either exported or explicitly excluded, so we can't forget serdes for new models.
  • [[metabase-enterprise.serialization.v2.extract/extract]] is the entry point for extraction.
    • It can work in a "selective" mode or extract everything; see below on selective serialization.
  • It calls (extract-all "ModelName" opts) for each model.
    • By default this calls (extract-query "ModelName" opts), getting back a reducible stream of entities.
    • For each entity in that stream, it calls (extract-one "ModelName" entity), which converts the map from the database (with instance-specific FKs in it) to a portable map with :serdes/meta on it and all FKs replaced with portable references.

The default [[extract-all]] works for nearly all models. Override [[extract-query]] if you need to control which entities get serialized (eg. to exclude archived ones). Every model implements [[extract-one]] to make its entities portable.

Storage

Storage transforms the reducible stream in some arbitrary way. It returns nothing; storage is expected to have side effects like writing files to disk or transmitting them over the network.

Not all storage implementations use directory structure, but for those that do [[storage-path]] should give the path for an entity as a list of strings: ["foo" "bar" "some_file"]. Note the lack of a file extension! That is deliberately left off the shared [[storage-path]] code so it can be set by different implementations to .yaml, .json, etc.

By convention, models are named as plural and in lower case: ["collections" "1234ABC_my_collection" "dashboards" "8765def_health_metrics"].

As a final remark, note that some entities have their own directories and some do not. For example, a Field is simply a file, while a Table has a directory. So a subset of the tree might look something like this:

my-export/
├── collections
└── databases
    └── Sample Database
        ├── Sample Database.yaml
        └── schemas
            └── PUBLIC
                └── tables
                    └── ORDERS
                        ├── ORDERS.yaml
                        └── fields
                            ├── CREATED_AT.yaml
                            ├── DISCOUNT.yaml
                            ├── ID.yaml
                            ├── PRODUCT_ID.yaml
                            ├── QUANTITY.yaml
                            ├── SUBTOTAL.yaml
                            ├── TAX.yaml
                            ├── TOTAL.yaml
                            └── USER_ID.yaml

Selective serialization

It's common to only export certain entities from an instance, rather than everything. We might export a single Question, or a Dashboard with all its DashboardCards and their Cards.

There's a relation to be captured here: the descendants of an entity are the ones it semantically "contains", or those it needs in order to be executed. (As when a question depends on another, or a SQL question references a NativeQuerySnippet.

[[descendants]] returns a set of such descendants for a given entity; see there for more details.

Note: "descendants" and "dependencies" are quite different things!

Entry point for extracting all entities of a particular model: (extract-all "ModelName" {opts...}) Keyed on the model name.

Returns a reducible stream of extracted maps (ie. vanilla Clojure maps with :serdes/meta keys).

You probably don't want to implement this directly. The default implementation delegates to [[extract-query]] and [[extract-one]], which are usually more convenient to override.

(defmulti extract-all
  {:arglists '([model-name opts])}
  (fn [model-name _opts] model-name))

Performs the select query, possibly filtered, for all the entities of this model that should be serialized. Called from [[extract-all]]'s default implementation.

(extract-query "ModelName" opts)

Keyed on the model name, the first argument.

Returns a reducible stream of modeled Toucan maps.

Defaults to using (t2/select model) for the entire table.

You may want to override this to eg. skip archived entities, or otherwise filter what gets serialized.

(defmulti extract-query
  {:arglists '([model-name opts])}
  (fn [model-name _opts] model-name))

Extracts a single entity retrieved from the database into a portable map with :serdes/meta attached. (extract-one "ModelName" opts entity)

The default implementation uses [[generate-path]] to build the :serdes/meta. It also strips off the database's numeric primary key.

That suffices for a few simple entities, but most entities will need to override this. They should follow the pattern of: - Convert to a vanilla Clojure map, not a modeled Toucan 2 entity. - Drop the numeric database primary key (usually :id) - Replace any foreign keys with portable values (eg. entity IDs, or a user ID with their email, etc.)

When overriding this, [[extract-one-basics]] is probably a useful starting point.

Keyed by the model name of the entity, the first argument.

(defmulti extract-one
  {:arglists '([model-name opts instance])}
  (fn [model-name _opts _instance] model-name))
(defn- log-and-extract-one
  [model opts instance]
  (log/info (trs "Extracting {0} {1}" model (:id instance)))
  (extract-one model opts instance))
(defmethod extract-all :default [model opts]
  (eduction (map (partial log-and-extract-one model opts))
            (extract-query model opts)))

Helper for the common (but not default) [[extract-query]] case of fetching everything that isn't in a personal collection.

(defn extract-query-collections
  [model {:keys [collection-set]}]
  (if collection-set
    ;; If collection-set is defined, select everything in those collections, or with nil :collection_id.
    (let [in-colls  (t2/reducible-select model :collection_id [:in collection-set])]
      (if (contains? collection-set nil)
        (eduction cat [in-colls (t2/reducible-select model :collection_id nil)])
        in-colls))
    ;; If collection-set is nil, just select everything.
    (t2/reducible-select model)))
(defmethod extract-query :default [model-name _]
  (t2/reducible-select (symbol model-name)))

A helper for writing [[extract-one]] implementations. It takes care of the basics: - Convert to a vanilla Clojure map. - Add :serdes/meta by calling [[generate-path]]. - Drop the primary key. - Drop :updated_at; it's noisy in git and not really used anywhere.

Returns the Clojure map.

(defn extract-one-basics
  [model-name entity]
  (let [model (t2.model/resolve-model (symbol model-name))
        pk    (first (t2/primary-keys model))]
    (-> (into {} entity)
        (m/update-existing :entity_id str/trim)
        (assoc :serdes/meta (generate-path model-name entity))
        (dissoc pk :updated_at))))
(defmethod extract-one :default [model-name _opts entity]
  (extract-one-basics model-name entity))

Returns set of [model-name database-id] pairs for all entities contained or used by this entity. e.g. the Dashboard implementation should return pairs for all DashboardCard entities it contains, etc.

Dispatched on model-name.

(defmulti descendants
  {:arglists '([model-name db-id])}
  (fn [model-name _] model-name))
(defmethod descendants :default [_ _]
  nil)

Return set of [model-name database-id] pairs for all entities containing this entity, required to successfully load this entity in destination db. Notice that ascendants are searched recursively, but their descendants are not analyzed.

Dispatched on model-name.

(defmulti ascendants
  {:arglists '([model-name db-id])}
  (fn [model-name _] model-name))
(defmethod ascendants :default [_ _]
  nil)

Import Process

Deserialization is split into two stages, mirroring serialization. They are called ingestion and loading. Ingestion turns whatever serialized form was produced by storage (eg. a tree of YAML files) into Clojure maps with :serdes/meta maps. Loading imports these entities into the appdb, updating and inserting rows as needed.

Ingestion

Ingestion is intended to be a black box, like storage above. [[metabase-enterprise.serialization.v2.ingest/Ingestable]] is defined as a protocol to allow easy [[reify]] usage for testing deserialization in memory.

Factory functions consume some details (like a path to the export) and return an Ingestable instance, with its two methods:

  • (ingest-list ingestable) returns a reducible stream of :serdes/meta paths in any order.
  • (ingest-one ingestable meta-path) ingests a single entity into memory, returning it as a map.

This two-stage design avoids needing all the data in memory at once. (Assuming the underlying storage media is something like files, and not a network stream that won't wait!)

Loading

Loading tries to find, for each ingested entity, a corresponding entity in the destination appdb, using the entity IDs. If it finds a match, that row will be UPDATEd, rather than INSERTing a duplicate.

The entry point is [[metabase-enterprise.serialization.v2.load/load-metabase]].

First, (ingest-list ingestable) gets the :serdes/meta "path" for every exported entity in arbitrary order. Then for each ingested entity:

  • (ingest-one serdes-path opts) is called to read the value into memory, then
  • (dependencies ingested) gets a list of other :serdes/meta paths need to be loaded first.
    • See below on depenencies.
  • Dependencies are loaded recursively in postorder; that is an entity is loaded after all its deps.
    • Circular dependencies will make the load process throw.
  • Once an entity's deps are all loaded, we check for an existing one:
    • (load-find-local serdes-path) returns the corresponding entity, or nil.
  • (load-one! ingested maybe-local-entity) is called with the ingested map and nil or the local match.
    • load-one! is a side-effecting black box to the rest of the deserialization process.
    • `load-one! returns the primary key of the new or existing entity, which is necessary to resolve foreign keys.

load-one! has a default implementation that works for most models:

  • Call (load-xform ingested) to transform the ingested map as needed.
    • Override [[load-xform]] to convert any foreign keys from portable entity IDs to the local database FKs.
  • Then call either:
    • (load-update! ingested local-entity) if the local entity exists, or
    • (load-insert! ingested) if it's new.

Both load-update! and load-insert! have the obvious defaults of updating or inserting with Toucan, but they can be overridden if special handling is needed.

The dispatch function for several of the load multimethods: dispatching on the model of the incoming entity.

(defn- ingested-model
  [ingested]
  (-> ingested :serdes/meta last :model))

Given an exported or imported entity with a :serdes/meta key on it, return the abstract path (not a filesystem path).

(defn path
  [entity]
  (:serdes/meta entity))

Given a path, tries to look up any corresponding local entity.

Returns nil, or the local Toucan entity that corresponds to the given path. Keyed on the model name at the leaf of the path.

By default, this tries to look up the entity by its :entity_id column.

(defmulti load-find-local
  {:arglists '([path])}
  (fn [path]
    (-> path last :model)))
(declare lookup-by-id)
(defmethod load-find-local :default [path]
  (let [{id :id model-name :model} (last path)
        model                      (t2.model/resolve-model (symbol model-name))]
    (when model
      (lookup-by-id model id))))

Dependencies

The files of an export are returned in arbitrary order by [[ingest-list]]. But in order to load any entity, everything it has a foreign key to must be loaded first. This is the purpose of one of the most complicated parts of serdes: [[dependencies]].

This multimethod returns a list (possibly empty) of :serdes/meta paths that this entity depends on. A Card depends on the Tables it queries, the Collection it belongs to, and possibly much else. Collections depend (recursively) on their parent collections.

Think carefully about the dependencies of any model. Do they have optional fields that sometimes have FKs? Eg. a DashboardCard can contain custom click_behavior which might include linking to a different Card! Missing dependencies will cause flaky deserialization failures, since sometimes the FK target will exist already, and sometimes not, depending on the arbitrary order of ingest-list.

Given an entity map as ingested (not a Toucan entity) returns a (possibly empty) list of its dependencies, where each dependency is represented by its abstract path (its :serdes/meta value).

Keyed on the model name for this entity. Default implementation returns an empty vector, so only models that have dependencies need to implement this.

(defmulti dependencies
  {:arglists '([ingested])}
  ingested-model)
(defmethod dependencies :default [_]
  [])

Given the incoming vanilla map as ingested, transform it so it's suitable for sending to the database (in eg. [[t2/insert!]]). For example, this should convert any foreign keys back from a portable entity ID or identity hash into a numeric database ID. This is the mirror of [[extract-one]], in spirit. (They're not strictly inverses - [[extract-one]] drops the primary key but this need not put one back, for example.)

By default, this just calls [[load-xform-basics]]. If you override this, call [[load-xform-basics]] as well.

(defmulti load-xform
  {:arglists '([ingested])}
  ingested-model)

Given a table name, returns a map of columnname -> columntype

(def ^:private fields-for-table
  (mdb.connection/memoize-for-application-db
   (fn fields-for-table [table-name]
     (u.conn/app-db-column-types mdb.connection/*application-db* table-name))))

Returns the table name that a particular ingested entity should finally be inserted into.

(defn- ->table-name
  [ingested]
  (->> ingested ingested-model (keyword "model") t2/table-name name))

Called by drop-excess-keys (which is in turn called by load-xform-basics) to determine the full set of keys that should be on the map returned by load-xform-basics. The default implementation looks in the application DB for the table associated with the ingested model and returns the set of keywordized columns, but for some models (e.g. Actions) there is not a 1:1 relationship between a model and a table, so we need this multimethod to allow the model to override when necessary.

(defmulti ingested-model-columns
  ingested-model)
(defmethod ingested-model-columns :default
  ;; this works for most models - it just returns a set of keywordized column names from the database.
  [ingested]
  (->> ingested
       ->table-name
       fields-for-table
       keys
       (map (comp keyword u/lower-case-en))
       set))

Given an ingested entity, removes keys that will not 'fit' into the current schema, because the column no longer exists. This can happen when serialization dumps generated on an earlier version of Metabase are loaded into a later version of Metabase, when a column gets removed. (At the time of writing I am seeing this happen with color on collections).

(defn- drop-excess-keys
  [ingested]
  (select-keys ingested (ingested-model-columns ingested)))

Performs the usual steps for an incoming entity: - removes extraneous keys (e.g. :serdes/meta)

You should call this as part of any implementation of [[load-xform]].

This is a mirror (but not precise inverse) of [[extract-one-basics]].

(defn load-xform-basics
  [ingested]
  (drop-excess-keys ingested))
(defmethod load-xform :default [ingested]
  (load-xform-basics ingested))

Called by the default [[load-one!]] if there is a corresponding entity already in the appdb. (load-update! "ModelName" ingested-and-xformed local-Toucan-entity)

Defaults to a straightforward [[t2/update!]], and you may not need to update it.

Keyed on the model name (the first argument), because the second argument doesn't have its :serdes/meta anymore.

Returns the updated entity.

(defmulti load-update!
  {:arglists '([model-name ingested local])}
  (fn [model _ _] model))
(defmethod load-update! :default [model-name ingested local]
  (let [model    (t2.model/resolve-model (symbol model-name))
        pk       (first (t2/primary-keys model))
        id       (get local pk)]
    (log/tracef "Upserting %s %d: old %s new %s" model-name id (pr-str local) (pr-str ingested))
    (t2/update! model id ingested)
    (t2/select-one model pk id)))

Called by the default [[load-one!]] if there is no corresponding entity already in the appdb. (load-insert! "ModelName" ingested-and-xformed)

Defaults to a straightforward [[(comp first t2/insert-returning-instances!)]] (returning the created object), and you probably don't need to implement this.

Note that any [[t2/insert!]] behavior we don't want to run (like generating an :entity_id!) should be skipped based on the [[mi/deserializing?]] dynamic var.

Keyed on the model name (the first argument), because the second argument doesn't have its :serdes/meta anymore.

Returns the newly inserted entity.

(defmulti load-insert!
  {:arglists '([model ingested])}
  (fn [model _] model))
(defmethod load-insert! :default [model-name ingested]
  (log/tracef "Inserting %s: %s" model-name (pr-str ingested))
  (first (t2/insert-returning-instances! (t2.model/resolve-model (symbol model-name)) ingested)))

Black box for integrating a deserialized entity into this appdb. (load-one! ingested maybe-local)

ingested is the vanilla map from ingestion, with the :serdes/meta key on it. maybe-local is either nil, or the corresponding Toucan entity from the appdb.

Defaults to calling [[load-xform]] to massage the incoming map, then either [[load-update!]] if maybe-local exists, or [[load-insert!]] if it's nil.

Prefer overriding [[load-xform]], and if necessary [[load-update!]] and [[load-insert!]], rather than this.

Keyed on the model name.

Returns the primary key of the updated or inserted entity.

(defmulti load-one!
  (fn [ingested _]
    (ingested-model ingested)))

Default implementation of load-one!

(defn default-load-one!
  [ingested maybe-local]
  (let [model    (ingested-model ingested)
        adjusted (load-xform ingested)]
    (binding [mi/*deserializing?* true]
      (if (nil? maybe-local)
        (load-insert! model adjusted)
        (load-update! model adjusted maybe-local)))))
(defmethod load-one! :default [ingested maybe-local]
  (default-load-one! ingested maybe-local))

Checks if the given string is a 21-character NanoID. Useful for telling entity IDs apart from identity hashes.

(defn entity-id?
  [id-str]
  (boolean (and id-str
                (string? id-str)
                (re-matches #"^[A-Za-z0-9_-]{21}$" id-str))))

Given a model and a target identity hash, this scans the appdb for any instance of the model corresponding to the hash. Does a complete scan, so this should be called sparingly!

TODO: Clean up this [[identity-hash]] infrastructure once the seed_entity_ids issue is fixed. See above on the details of the two hashing schemes.

(defn- find-by-identity-hash
  ;; TODO This should be able to use a cache of identity-hash values from the start of the deserialization process.
  ;; Note that it needs to include either updates (or worst-case, invalidation) at [[load-one!]] time.
  [model id-hash]
  (->> (t2/reducible-select model)
       (into [] (comp (filter #(= id-hash (identity-hash %)))
                      (take 1)))
       first))

Given an ID string, this endeavours to find the matching entity, whether it's an entity ID or identity hash. This is useful when writing [[load-xform]] to turn a foreign key from a portable form to an appdb ID. Returns a Toucan entity or nil.

(defn lookup-by-id
  [model id-str]
  (if (entity-id? id-str)
    (t2/select-one model :entity_id id-str)
    (find-by-identity-hash model id-str)))
(def ^:private max-label-length 100)
(defn- truncate-label [s]
  (if (> (count s) max-label-length)
    (subs s 0 max-label-length)
    s))
(defn- lower-plural [s]
  (-> s u/lower-case-en (str "s")))

Captures the common pattern for leaf file names as entityID_label.

(defn storage-leaf-file-name
  ([id]       (str id))
  ([id label] (if (nil? label)
                (storage-leaf-file-name id)
                (str id "_" (truncate-label label)))))

Implements the most common structure for [[storage-path]] - collections/c1/c2/c3/models/entityid_label.ext

(defn storage-default-collection-path
  [entity {:keys [collections]}]
  (let [{:keys [model id label]} (-> entity path last)]
    (concat ["collections"]
            (get collections (:collection_id entity)) ;; This can be nil, but that's fine - that's the root collection.
            [(lower-plural model) (storage-leaf-file-name id label)])))

Returns a seq of storage path components for a given entity. Dispatches on model name.

(defmulti storage-path
  {:arglists '([entity ctx])}
  (fn [entity _] (ingested-model entity)))
(defmethod storage-path :default [entity ctx]
  (storage-default-collection-path entity ctx))

Creates the basic context for storage. This is a map with a single entry: :collections is a map from collection ID to the path of collections.

(defn storage-base-context
  []
  (let [colls      (t2/select ['Collection :id :entity_id :location :slug])
        coll-names (into {} (for [{:keys [id entity_id slug]} colls]
                              [(str id) (storage-leaf-file-name entity_id slug)]))
        coll->path (into {} (for [{:keys [entity_id id location]} colls
                                  :let [parents (rest (str/split location #"/"))]]
                              [entity_id (map coll-names (concat parents [(str id)]))]))]
    {:collections coll->path}))

Returns a string for logging from a serdes path sequence (i.e. in :serdes/meta)

(defn log-path-str
  [elements]
  (->> elements
       (map #(str (:model %) " " (:id %)))
       (str/join " > ")))

Utilities for implementing serdes

Note that many of these use ^::cache to cache their lookups during deserialization. This greatly reduces the number of database lookups, since many entities might belong to eg. a single collection.

General foreign keys

Given a numeric foreign key and its model (symbol, name or IModel), looks up the entity by ID and gets its entity ID or identity hash. Unusual parameter order means this can be used as (update x :some_id export-fk 'SomeModel).

NOTE: This works for both top-level and nested entities. Top-level entities like Card are returned as just a portable ID string.. Nested entities are returned as a vector of such ID strings.

(defn ^:dynamic ^::cache *export-fk*
  [id model]
  (when id
    (let [model-name (name model)
          model      (t2.model/resolve-model (symbol model-name))
          entity     (t2/select-one model (first (t2/primary-keys model)) id)
          path       (mapv :id (generate-path model-name entity))]
      (if (= (count path) 1)
        (first path)
        path))))

Given an identifier, and the model it represents (symbol, name or IModel), looks up the corresponding entity and gets its primary key.

The identifier can be a single entity ID string, a single identity-hash string, or a vector of entity ID and hash strings. If the ID is compound, then the last ID is the one that corresponds to the model. This allows for the compound IDs needed for nested entities like DashboardCards to get their [[dependencies]].

Throws if the corresponding entity cannot be found.

Unusual parameter order means this can be used as (update x :some_id import-fk 'SomeModel).

(defn ^:dynamic ^::cache *import-fk*
  [eid model]
  (when eid
    (let [model-name (name model)
          model      (t2.model/resolve-model (symbol model-name))
          eid        (if (vector? eid)
                       (last eid)
                       eid)
          entity     (lookup-by-id model eid)]
      (if entity
        (get entity (first (t2/primary-keys model)))
        (throw (ex-info "Could not find foreign key target - bad serdes dependencies or other serialization error"
                        {:entity_id eid :model (name model)}))))))

Given a numeric ID, look up a different identifying field for that entity, and return it as a portable ID. Eg. Database.name. [[import-fk-keyed]] is the inverse. Unusual parameter order lets this be called as, for example, (update x :db_id export-fk-keyed 'Database :name).

Note: This assumes the primary key is called :id.

(defn ^:dynamic ^::cache *export-fk-keyed*
  [id model field]
  (t2/select-one-fn field model :id id))

Given a single, portable, identifying field and the model it refers to, this resolves the entity and returns its numeric :id. Eg. Database.name.

Unusual parameter order lets this be called as, for example, (update x :creator_id import-fk-keyed 'Database :name).

(defn ^:dynamic ^::cache *import-fk-keyed*
  [portable model field]
  (t2/select-one-pk model field portable))

Exports a user as the email address. This just calls [[export-fk-keyed]], but the counterpart [[import-user]] is more involved. This is a unique function so they form a pair.

Users

(defn ^:dynamic ^::cache *export-user*
  [id]
  (when id (*export-fk-keyed* id 'User :email)))

Imports a user by their email address. If a user with that email address exists, returns its primary key. If no such user exists, creates a dummy one with the default settings, blank name, and randomized password. Does not send any invite emails.

(defn ^:dynamic ^::cache *import-user*
  [email]
  (when email
    (or (*import-fk-keyed* email 'User :email)
        ;; Need to break a circular dependency here.
        (:id ((resolve 'metabase.models.user/serdes-synthesize-user!) {:email email})))))

Tables

Given a numeric table_id, return a portable table reference. If the table_id is nil, return nil. This is legal for a native question. That has the form [db-name schema table-name], where the schema might be nil. [[import-table-fk]] is the inverse.

(defn ^:dynamic ^::cache *export-table-fk*
  [table-id]
  (when table-id
    (let [{:keys [db_id name schema]} (t2/select-one 'Table :id table-id)
          db-name                     (t2/select-one-fn :name 'Database :id db_id)]
      [db-name schema name])))

Given a table_id as exported by [[export-table-fk]], resolve it back into a numeric table_id. The input might be nil, in which case so is the output. This is legal for a native question.

(defn ^:dynamic ^::cache *import-table-fk*
  [[db-name schema table-name :as table-id]]
  (when table-id
    (t2/select-one-fn :id 'Table :name table-name :schema schema :db_id (t2/select-one-fn :id 'Database :name db-name))))

Given a table_id as exported by [[export-table-fk]], turn it into a [{:model ...}] path for the Table. This is useful for writing [[dependencies]] implementations.

(defn table->path
  [[db-name schema table-name]]
  (filterv some? [{:model "Database" :id db-name}
                  (when schema {:model "Schema" :id schema})
                  {:model "Table" :id table-name}]))

The [[serdes/storage-path]] for Table is a bit tricky, and shared with Fields and FieldValues, so it's factored out here. Takes the :serdes/meta value for a Table! The return value includes the directory for the Table, but not the file for the Table itself.

With a schema: ["databases" "db_name" "schemas" "public" "tables" "customers"] No schema: ["databases" "db_name" "tables" "customers"]

(defn storage-table-path-prefix
  [path]
  (let [db-name    (-> path first :id)
        schema     (when (= (count path) 3)
                     (-> path second :id))
        table-name (-> path last :id)]
    (concat ["databases" db-name]
            (when schema ["schemas" schema])
            ["tables" table-name])))

Fields

Given a numeric field_id, return a portable field reference. That has the form [db-name schema table-name field-name], where the schema might be nil. [[import-field-fk]] is the inverse.

(defn ^:dynamic ^::cache *export-field-fk*
  [field-id]
  (when field-id
    (let [{:keys [name table_id]}     (t2/select-one 'Field :id field-id)
          [db-name schema field-name] (*export-table-fk* table_id)]
      [db-name schema field-name name])))

Given a field_id as exported by [[export-field-fk]], resolve it back into a numeric field_id.

(defn ^:dynamic ^::cache *import-field-fk*
  [[db-name schema table-name field-name :as field-id]]
  (when field-id
    (let [table_id (*import-table-fk* [db-name schema table-name])]
      (t2/select-one-pk 'Field :table_id table_id :name field-name))))

Given a field_id as exported by [[export-field-fk]], turn it into a [{:model ...}] path for the Field. This is useful for writing [[dependencies]] implementations.

(defn field->path
  [[db-name schema table-name field-name]]
  (filterv some? [{:model "Database" :id db-name}
                  (when schema {:model "Schema" :id schema})
                  {:model "Table" :id table-name}
                  {:model "Field" :id field-name}]))

MBQL Fields

Is given form an MBQL entity reference?

(defn- mbql-entity-reference?
  [form]
  (mbql.normalize/is-clause? #{:field :field-id :fk-> :dimension :metric :segment} form))
(defn- mbql-id->fully-qualified-name
  [mbql]
  (-> mbql
      mbql.normalize/normalize-tokens
      (mbql.u/replace
        ;; `integer?` guard is here to make the operation idempotent
       [:field (id :guard integer?) opts]
       [:field (*export-field-fk* id) (mbql-id->fully-qualified-name opts)]
        ;; `integer?` guard is here to make the operation idempotent
       [:field (id :guard integer?)]
       [:field (*export-field-fk* id)]
        ;; field-id is still used within parameter mapping dimensions
        ;; example relevant clause - [:dimension [:fk-> [:field-id 1] [:field-id 2]]]
       [:field-id (id :guard integer?)]
       [:field-id (*export-field-fk* id)]
       {:source-table (id :guard integer?)}
       (assoc &match :source-table (*export-table-fk* id))
        ;; source-field is also used within parameter mapping dimensions
        ;; example relevant clause - [:field 2 {:source-field 1}]
       {:source-field (id :guard integer?)}
       (assoc &match :source-field (*export-field-fk* id))
       [:dimension (dim :guard vector?)]
       [:dimension (mbql-id->fully-qualified-name dim)]
       [:metric (id :guard integer?)]
       [:metric (*export-fk* id 'Metric)]
       [:segment (id :guard integer?)]
       [:segment (*export-fk* id 'Segment)])))
(defn- export-source-table
  [source-table]
  (if (and (string? source-table)
           (str/starts-with? source-table "card__"))
    (*export-fk* (-> source-table
                   (str/split #"__")
                   second
                   Integer/parseInt)
               'Card)
    (*export-table-fk* source-table)))
(defn- ids->fully-qualified-names
  [entity]
  (mbql.u/replace entity
                  mbql-entity-reference?
                  (mbql-id->fully-qualified-name &match)
                  sequential?
                  (mapv ids->fully-qualified-names &match)
                  map?
                  (as-> &match entity
                    (m/update-existing entity :database (fn [db-id]
                                                          (if (= db-id lib.schema.id/saved-questions-virtual-database-id)
                                                            "database/__virtual"
                                                            (t2/select-one-fn :name 'Database :id db-id))))
                    (m/update-existing entity :card_id #(*export-fk* % 'Card)) ; attibutes that refer to db fields use _
                    (m/update-existing entity :card-id #(*export-fk* % 'Card)) ; template-tags use dash
                    (m/update-existing entity :source-table export-source-table)
                    (m/update-existing entity :source_table export-source-table)
                    (m/update-existing entity :breakout    (fn [breakout]
                                                             (mapv mbql-id->fully-qualified-name breakout)))
                    (m/update-existing entity :aggregation (fn [aggregation]
                                                             (mapv mbql-id->fully-qualified-name aggregation)))
                    (m/update-existing entity :filter      ids->fully-qualified-names)
                    (m/update-existing entity ::mb.viz/param-mapping-source *export-field-fk*)
                    (m/update-existing entity :segment    *export-fk* 'Segment)
                    (m/update-existing entity :snippet-id *export-fk* 'NativeQuerySnippet)
                    (merge entity
                           (m/map-vals ids->fully-qualified-names
                                       (dissoc entity
                                               :database :card_id :card-id :source-table :breakout :aggregation :filter :segment
                                               ::mb.viz/param-mapping-source :snippet-id))))))

Given an MBQL expression, convert it to an EDN structure and turn the non-portable Database, Table and Field IDs inside it into portable references.

(defn export-mbql
  [encoded]
  (ids->fully-qualified-names encoded))

True if the provided string is either an Entity ID or identity-hash string.

(defn- portable-id?
  [s]
  (and (string? s)
       (or (entity-id? s)
           (identity-hash? s))))
(defn- mbql-fully-qualified-names->ids*
  [entity]
  (mbql.u/replace entity
    ;; handle legacy `:field-id` forms encoded prior to 0.39.0
    ;; and also *current* expresion forms used in parameter mapping dimensions
    ;; example relevant clause - [:dimension [:fk-> [:field-id 1] [:field-id 2]]]
                  [(:or :field-id "field-id") fully-qualified-name]
                  (mbql-fully-qualified-names->ids* [:field fully-qualified-name])
                  [(:or :field "field") (fully-qualified-name :guard vector?) opts]
                  [:field (*import-field-fk* fully-qualified-name) (mbql-fully-qualified-names->ids* opts)]
                  [(:or :field "field") (fully-qualified-name :guard vector?)]
                  [:field (*import-field-fk* fully-qualified-name)]
    ;; source-field is also used within parameter mapping dimensions
    ;; example relevant clause - [:field 2 {:source-field 1}]
                  {:source-field (fully-qualified-name :guard vector?)}
                  (assoc &match :source-field (*import-field-fk* fully-qualified-name))
                  {:database (fully-qualified-name :guard string?)}
                  (-> &match
                      (assoc :database (if (= fully-qualified-name "database/__virtual")
                                         lib.schema.id/saved-questions-virtual-database-id
                                         (t2/select-one-pk 'Database :name fully-qualified-name)))
                      mbql-fully-qualified-names->ids*) ; Process other keys
                  {:card-id (entity-id :guard portable-id?)}
                  (-> &match
                      (assoc :card-id (*import-fk* entity-id 'Card))
                      mbql-fully-qualified-names->ids*) ; Process other keys
                  [(:or :metric "metric") (fully-qualified-name :guard portable-id?)]
                  [:metric (*import-fk* fully-qualified-name 'Metric)]
                  [(:or :segment "segment") (fully-qualified-name :guard portable-id?)]
                  [:segment (*import-fk* fully-qualified-name 'Segment)]
                  (_ :guard (every-pred map? #(vector? (:source-table %))))
                  (-> &match
                      (assoc :source-table (*import-table-fk* (:source-table &match)))
                      mbql-fully-qualified-names->ids*)
                  (_ :guard (every-pred map? #(vector? (:source_table %))))
                  (-> &match
                      (assoc :source_table (*import-table-fk* (:source_table &match)))
                      mbql-fully-qualified-names->ids*)
                  (_ :guard (every-pred map? (comp portable-id? :source-table)))
                  (-> &match
                      (assoc :source-table (str "card__" (*import-fk* (:source-table &match) 'Card)))
                      mbql-fully-qualified-names->ids*)
                  (_ :guard (every-pred map? (comp portable-id? :source_table)))
                  (-> &match
                      (assoc :source_table (str "card__" (*import-fk* (:source_table &match) 'Card)))
                      mbql-fully-qualified-names->ids*) ;; process other keys
                  (_ :guard (every-pred map? (comp portable-id? :snippet-id)))
                  (-> &match
                      (assoc :snippet-id (*import-fk* (:snippet-id &match) 'NativeQuerySnippet))
                      mbql-fully-qualified-names->ids*)))
(defn- mbql-fully-qualified-names->ids
  [entity]
  (mbql-fully-qualified-names->ids* entity))

Given an MBQL expression as an EDN structure with portable IDs embedded, convert the IDs back to raw numeric IDs.

(defn import-mbql
  [exported]
  (mbql-fully-qualified-names->ids exported))
(declare ^:private mbql-deps-map)
(defn- mbql-deps-vector [entity]
  (match entity
    [:field     (field :guard vector?)]      #{(field->path field)}
    ["field"    (field :guard vector?)]      #{(field->path field)}
    [:field-id  (field :guard vector?)]      #{(field->path field)}
    ["field-id" (field :guard vector?)]      #{(field->path field)}
    [:field     (field :guard vector?) tail] (into #{(field->path field)} (mbql-deps-map tail))
    ["field"    (field :guard vector?) tail] (into #{(field->path field)} (mbql-deps-map tail))
    [:field-id  (field :guard vector?) tail] (into #{(field->path field)} (mbql-deps-map tail))
    ["field-id" (field :guard vector?) tail] (into #{(field->path field)} (mbql-deps-map tail))
    [:metric    (field :guard portable-id?)] #{[{:model "Metric" :id field}]}
    ["metric"   (field :guard portable-id?)] #{[{:model "Metric" :id field}]}
    [:segment   (field :guard portable-id?)] #{[{:model "Segment" :id field}]}
    ["segment"  (field :guard portable-id?)] #{[{:model "Segment" :id field}]}
    :else (reduce #(cond
                     (map? %2)    (into %1 (mbql-deps-map %2))
                     (vector? %2) (into %1 (mbql-deps-vector %2))
                     :else %1)
                  #{}
                  entity)))
(defn- mbql-deps-map [entity]
  (->> (for [[k v] entity]
         (cond
           (and (= k :database)
                (string? v)
                (not= v "database/__virtual"))        #{[{:model "Database" :id v}]}
           (and (= k :source-table) (vector? v))      #{(table->path v)}
           (and (= k :source-table) (portable-id? v)) #{[{:model "Card" :id v}]}
           (and (= k :source-field) (vector? v))      #{(field->path v)}
           (and (= k :snippet-id)   (portable-id? v)) #{[{:model "NativeQuerySnippet" :id v}]}
           (and (= k :card_id)      (string? v))      #{[{:model "Card" :id v}]}
           (and (= k :card-id)      (string? v))      #{[{:model "Card" :id v}]}
           (map? v)                                   (mbql-deps-map v)
           (vector? v)                                (mbql-deps-vector v)))
       (reduce set/union #{})))

Given an MBQL expression as exported, with qualified names like ["some-db" "schema" "table_name"] instead of raw IDs, return the corresponding set of serdes dependencies. The query can't be imported until all the referenced databases, tables and fields are loaded.

(defn mbql-deps
  [entity]
  (cond
    (map? entity)     (mbql-deps-map entity)
    (seqable? entity) (mbql-deps-vector entity)
    :else             (mbql-deps-vector [entity])))

Dashboard/Question Parameters

(defn- export-parameter-mapping [mapping]
  (ids->fully-qualified-names mapping))

Given the :parameter_mappings field of a Card or DashboardCard, as a vector of maps, converts it to a portable form with the field IDs replaced with [db schema table field] references.

(defn export-parameter-mappings
  [mappings]
  (map export-parameter-mapping mappings))

Given the :parameter_mappings field as exported by serialization convert its field references ([db schema table field]) back into raw IDs.

(defn import-parameter-mappings
  [mappings]
  (->> mappings
       (map mbql-fully-qualified-names->ids)
       (map #(m/update-existing % :card_id *import-fk* 'Card))))

Given the :parameter field of a Card or Dashboard, as a vector of maps, converts it to a portable form with the CardIds/FieldIds replaced with [db schema table field] references.

(defn export-parameters
  [parameters]
  (map ids->fully-qualified-names parameters))

Given the :parameter field as exported by serialization convert its field references ([db schema table field]) back into raw IDs.

(defn import-parameters
  [parameters]
  (for [param parameters]
    (-> param
        mbql-fully-qualified-names->ids
        (m/update-existing-in [:values_source_config :card_id] *import-fk* 'Card))))

Given the :parameters (possibly nil) for an entity, return any embedded serdes-deps as a set. Always returns an empty set even if the input is nil.

(defn parameters-deps
  [parameters]
  (reduce set/union #{}
          (for [parameter parameters
                :when (= "card" (:values_source_type parameter))
                :let  [config (:values_source_config parameter)]]
            (set/union #{[{:model "Card" :id (:card_id config)}]}
                       (mbql-deps-vector (:value_field config))))))

Viz settings

A map from model on linkcards to its corresponding toucan model.

Link cards are dashcards that link to internal entities like Database/Dashboard/... or an url.

It's here instead of [[metabase.models.dashboard-card]] to avoid cyclic deps.

(def link-card-model->toucan-model
  {"card"       :model/Card
   "dataset"    :model/Card
   "collection" :model/Collection
   "database"   :model/Database
   "dashboard"  :model/Dashboard
   "question"   :model/Card
   "table"      :model/Table})
(defn- export-viz-link-card
  [settings]
  (m/update-existing-in
   settings
   [:link :entity]
   (fn [{:keys [id model] :as entity}]
     (merge entity
            {:id (case model
                   "table"    (*export-table-fk* id)
                   "database" (*export-fk-keyed* id 'Database :name)
                   (*export-fk* id (link-card-model->toucan-model model)))}))))

Converts IDs to fully qualified names inside a JSON string. Returns a new JSON string with the IDs converted inside.

(defn- json-ids->fully-qualified-names
  [json-str]
  (-> json-str
      (json/parse-string true)
      ids->fully-qualified-names
      json/generate-string))

Converts fully qualified names to IDs in MBQL embedded inside a JSON string. Returns a new JSON string with teh IDs converted inside.

(defn- json-mbql-fully-qualified-names->ids
  [json-str]
  (-> json-str
      (json/parse-string true)
      mbql-fully-qualified-names->ids
      json/generate-string))
(defn- export-viz-click-behavior-link
  [{:keys [linkType type] :as click-behavior}]
  (cond-> click-behavior
    (= type "link") (update :targetId *export-fk* (link-card-model->toucan-model linkType))))
(defn- import-viz-click-behavior-link
  [{:keys [linkType type] :as click-behavior}]
  (cond-> click-behavior
    (= type "link") (update :targetId *import-fk* (link-card-model->toucan-model linkType))))
(defn- export-viz-click-behavior-mapping [mapping]
  (-> mapping
      (m/update-existing    :id                  json-ids->fully-qualified-names)
      (m/update-existing-in [:target :id]        json-ids->fully-qualified-names)
      (m/update-existing-in [:target :dimension] ids->fully-qualified-names)))
(defn- import-viz-click-behavior-mapping [mapping]
  (-> mapping
      (m/update-existing    :id                  json-mbql-fully-qualified-names->ids)
      (m/update-existing-in [:target :id]        json-mbql-fully-qualified-names->ids)
      (m/update-existing-in [:target :dimension] mbql-fully-qualified-names->ids)))

The :parameterMappings on a :click_behavior viz settings is a map of... IDs turned into JSON strings which have been keywordized. Therefore the keys must be converted to strings, parsed, exported, and JSONified. The values are ported by [[export-viz-click-behavior-mapping]].

(defn- export-viz-click-behavior-mappings
  [mappings]
  (into {} (for [[kw-key mapping] mappings
                 :let [k (name kw-key)]]
             (if (mb.viz/dimension-param-mapping? mapping)
               [(json-ids->fully-qualified-names k)
                (export-viz-click-behavior-mapping mapping)]
               [k mapping]))))

The exported form of :parameterMappings on a :click_behavior viz settings is a map of JSON strings which contain fully qualified names. These must be parsed, imported, JSONified and then turned back into keywords, since that's the form used internally.

(defn- import-viz-click-behavior-mappings
  [mappings]
  (into {} (for [[json-key mapping] mappings]
             (if (mb.viz/dimension-param-mapping? mapping)
               [(keyword (json-mbql-fully-qualified-names->ids json-key))
                (import-viz-click-behavior-mapping mapping)]
               [json-key mapping]))))
(defn- export-viz-click-behavior [settings]
  (some-> settings
          (m/update-existing    :click_behavior export-viz-click-behavior-link)
          (m/update-existing-in [:click_behavior :parameterMapping] export-viz-click-behavior-mappings)))
(defn- import-viz-click-behavior [settings]
  (some-> settings
          (m/update-existing    :click_behavior import-viz-click-behavior-link)
          (m/update-existing-in [:click_behavior :parameterMapping] import-viz-click-behavior-mappings)))
(defn- export-pivot-table [settings]
  (some-> settings
          (m/update-existing-in [:pivot_table.column_split :rows] ids->fully-qualified-names)
          (m/update-existing-in [:pivot_table.column_split :columns] ids->fully-qualified-names)))
(defn- import-pivot-table [settings]
  (some-> settings
          (m/update-existing-in [:pivot_table.column_split :rows] mbql-fully-qualified-names->ids)
          (m/update-existing-in [:pivot_table.column_split :columns] mbql-fully-qualified-names->ids)))
(defn- export-visualizations [entity]
  (mbql.u/replace
   entity
   ["field-id" (id :guard number?)]
   ["field-id" (*export-field-fk* id)]
   [:field-id (id :guard number?)]
   [:field-id (*export-field-fk* id)]
   ["field-id" (id :guard number?) tail]
   ["field-id" (*export-field-fk* id) (export-visualizations tail)]
   [:field-id (id :guard number?) tail]
   [:field-id (*export-field-fk* id) (export-visualizations tail)]
   ["field" (id :guard number?)]
   ["field" (*export-field-fk* id)]
   [:field (id :guard number?)]
   [:field (*export-field-fk* id)]
   ["field" (id :guard number?) tail]
   ["field" (*export-field-fk* id) (export-visualizations tail)]
   [:field (id :guard number?) tail]
   [:field (*export-field-fk* id) (export-visualizations tail)]
   (_ :guard map?)
   (m/map-vals export-visualizations &match)
   (_ :guard vector?)
   (mapv export-visualizations &match)))

Column settings use a JSON-encoded string as a map key, and it contains field numbers. This function parses those keys, converts the IDs to portable values, and serializes them back to JSON.

(defn- export-column-settings
  [settings]
  (when settings
    (-> settings
        (update-keys #(-> % json/parse-string export-visualizations json/generate-string))
        (update-vals export-viz-click-behavior))))

Given the :visualization_settings map, convert all its field-ids to portable [db schema table field] form.

(defn export-visualization-settings
  [settings]
  (when settings
    (-> settings
        export-visualizations
        export-viz-link-card
        export-viz-click-behavior
        export-pivot-table
        (update :column_settings export-column-settings))))
(defn- import-viz-link-card
  [settings]
  (m/update-existing-in
   settings
   [:link :entity]
   (fn [{:keys [id model] :as entity}]
     (merge entity
            {:id (case model
                   "table"    (*import-table-fk* id)
                   "database" (*import-fk-keyed* id 'Database :name)
                   (*import-fk* id (link-card-model->toucan-model model)))}))))
(defn- import-visualizations [entity]
  (mbql.u/replace
   entity
   [(:or :field-id "field-id") (fully-qualified-name :guard vector?) tail]
   [:field-id (*import-field-fk* fully-qualified-name) (import-visualizations tail)]
   [(:or :field-id "field-id") (fully-qualified-name :guard vector?)]
   [:field-id (*import-field-fk* fully-qualified-name)]
   [(:or :field "field") (fully-qualified-name :guard vector?) tail]
   [:field (*import-field-fk* fully-qualified-name) (import-visualizations tail)]
   [(:or :field "field") (fully-qualified-name :guard vector?)]
   [:field (*import-field-fk* fully-qualified-name)]
   (_ :guard map?)
   (m/map-vals import-visualizations &match)
   (_ :guard vector?)
   (mapv import-visualizations &match)))
(defn- import-column-settings [settings]
  (when settings
    (-> settings
        (update-keys #(-> % name json/parse-string import-visualizations json/generate-string))
        (update-vals import-viz-click-behavior))))

Given an EDN value as exported by [[export-visualization-settings]], convert its portable [db schema table field] references into Field IDs.

(defn import-visualization-settings
  [settings]
  (when settings
    (-> settings
        import-visualizations
        import-viz-link-card
        import-viz-click-behavior
        import-pivot-table
        (update :column_settings import-column-settings))))
(defn- viz-link-card-deps
  [settings]
  (when-let [{:keys [model id]} (get-in settings [:link :entity])]
    #{(case model
        "table" (table->path id)
        [{:model (name (link-card-model->toucan-model model))
          :id    id}])}))
(defn- viz-click-behavior-deps
  [settings]
  (when-let [{:keys [linkType targetId type]} (:click_behavior settings)]
    (case type
      "link" (when-let [model (some-> linkType link-card-model->toucan-model name)]
               #{[{:model model
                   :id    targetId}]})
      ;; TODO: We might need to handle the click behavior that updates dashboard filters? I can't figure out how get
      ;; that to actually attach to a filter to check what it looks like.
      nil)))

Given the :visualization_settings (possibly nil) for an entity, return any embedded serdes-deps as a set. Always returns an empty set even if the input is nil.

(defn visualization-settings-deps
  [viz]
  (let [column-settings-keys-deps (some->> viz
                                           :column_settings
                                           keys
                                           (map (comp mbql-deps json/parse-string name)))
        column-settings-vals-deps (some->> viz
                                           :column_settings
                                           vals
                                           (map viz-click-behavior-deps))
        link-card-deps            (viz-link-card-deps viz)
        click-behavior-deps       (viz-click-behavior-deps viz)]
    (->> (concat column-settings-keys-deps
                 column-settings-vals-deps
                 [(mbql-deps viz) link-card-deps click-behavior-deps])
         (filter some?)
         (reduce set/union #{}))))
(defn- viz-click-behavior-descendants [{:keys [click_behavior]}]
  (when-let [{:keys [linkType targetId type]} click_behavior]
    (case type
      "link" (when-let [model (link-card-model->toucan-model linkType)]
               #{[(name model) targetId]})
      ;; TODO: We might need to handle the click behavior that updates dashboard filters? I can't figure out how get
      ;; that to actually attach to a filter to check what it looks like.
      nil)))
(defn- viz-column-settings-descendants [{:keys [column_settings]}]
  (when column_settings
    (->> (vals column_settings)
         (mapcat viz-click-behavior-descendants)
         set)))

Given the :visualization_settings (possibly nil) for an entity, return anything that should be considered a descendant. Always returns an empty set even if the input is nil.

(defn visualization-settings-descendants
  [viz]
  (set/union (viz-click-behavior-descendants  viz)
             (viz-column-settings-descendants viz)))

Memoizing appdb lookups

Runs body with all functions marked with ::cache re-bound to memoized versions for performance.

(defmacro with-cache
  [& body]
  (let [ns* 'metabase.models.serialization]
    `(binding ~(reduce into []
                       (for [[var-sym var] (ns-interns ns*)
                             :when (::cache (meta var))
                             :let  [fq-sym (symbol (name ns*) (name var-sym))]]
                         [fq-sym `(memoize ~fq-sym)]))
       ~@body)))
 
(ns metabase.models.session
  (:require
   [buddy.core.codecs :as codecs]
   [buddy.core.nonce :as nonce]
   [metabase.server.middleware.misc :as mw.misc]
   [metabase.server.request.util :as request.u]
   [methodical.core :as methodical]
   [schema.core :as s]
   [toucan2.core :as t2]))
(s/defn ^:private random-anti-csrf-token :- #"^[0-9a-f]{32}$"
  []
  (codecs/bytes->hex (nonce/random-bytes 16)))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase.

(def Session
  :model/Session)
(methodical/defmethod t2/table-name :model/Session [_model] :core_session)
(doto :model/Session
  (derive :metabase/model)
  (derive :hook/created-at-timestamped?))
(t2/define-before-update :model/Session [_]
  (throw (RuntimeException. "You cannot update a Session.")))
(t2/define-before-insert :model/Session
  [session]
  (cond-> session
    (some-> mw.misc/*request* request.u/embedded?) (assoc :anti_csrf_token (random-anti-csrf-token))))
(t2/define-after-insert :model/Session
  [{anti-csrf-token :anti_csrf_token, :as session}]
  (let [session-type (if anti-csrf-token :full-app-embed :normal)]
    (assoc session :type session-type)))
 

Settings are a fast and simple way to create a setting that can be set from the admin page. They are saved to the application Database, but intelligently cached internally for super-fast lookups.

Define a new Setting with [[defsetting]] (optionally supplying things like default value, type, or custom getters & setters):

(defsetting mandrill-api-key "API key for Mandrill")

The newly-defined Setting will automatically be made available to the frontend client depending on its [[Visibility]].

You can also set the value via the corresponding env var, which looks like MB_MANDRILL_API_KEY, where the name of the Setting is converted to uppercase and dashes to underscores.

The var created with [[defsetting]] can be used as a getter/setter, or you can use [[get]] and [[set!]]:

(require '[metabase.models.setting :as setting])

(setting/get :mandrill-api-key) ; only returns values set explicitly from the Admin Panel (mandrill-api-key) ; returns value set in the Admin Panel, OR value of corresponding env var, ; OR the default value, if any (in that order)

(setting/set! :mandrill-api-key "NEW_KEY") (mandrill-api-key! "NEW_KEY")

(setting/set! :mandrill-api-key nil) (mandrill-api-key! nil)

You can define additional Settings types adding implementations of [[default-tag-for-type]], [[get-value-of-type]], and [[set-value-of-type!]].

[[writable-settings]] and [[user-readable-values-map]] can be used to fetch all Admin-writable and User-readable Settings, respectively. See their docstrings for more information.

User-local and Database-local Settings

Starting in 0.42.0, some Settings are allowed to have Database-specific values that override the normal site-wide value. Similarly, starting in 0.43.0, some Settings are allowed to have User-specific values. These are similar in concept to buffer-local variables in Emacs Lisp.

When a Setting is allowed to be User or Database local, any values in [[user-local-values]] or [[database-local-values]] for that Setting will be returned preferentially to site-wide values of that Setting. [[user-local-values]] comes from the User.settings column in the application DB, and [[database-local-values]] comes from the Database.settings column. nil values in [[user-local-values]] and [[database-local-values]] are ignored, i.e. you cannot 'unset' a site-wide value with a User- or Database-local one.

Whether or not a Setting can be User- or Database-local is controlled by the :user-local and :database-local options passed to [[defsetting]]. A Setting can only be User-local or Database-local, not both; this is enforced when the Setting is defined. There are three valid values of these options:

  • :only means this Setting can only have a User- or Database-local value and cannot have a 'normal' site-wide value. It cannot be set via env var. Default values are still allowed for User- and Database-local-only Settings. Database-local-only Settings are never returned by [[writable-settings]] or [[user-readable-values-map]] regardless of their [[Visibility]].

  • :allowed means this Setting can be User- or Database-local and can also have a normal site-wide value; if both are specified, the User- or Database-specific value will be returned preferentially when we are in the context of a specific User or Database (i.e., [[user-local-values]] or [[database-local-values]] is bound).

  • :never means User- or Database-specific values cannot be set for this Setting. Values in [[user-local-values]] and [[database-local-values]] will be ignored.

:never is the default value of both :user-local and :database-local; to allow User- or Database-local values, the Setting definition must explicitly specify :only or :allowed for the appropriate option.

If a User-local setting is written in the context of an API request (i.e., when [[metabase.api.common/current-user]] is bound), the value will be local to the current user. If it is written outside of an API request, a site-wide value will be written. (At the time of this writing, there is not yet a FE-client-friendly way to set Database-local values. Just set them manually in the application DB until we figure that out.)

Custom setter functions do not affect User- or Database-local values; they always set the site-wide value.

See #14055 and #19399 for more information about and motivation behind User- and Database-local Settings.

(ns metabase.models.setting
  (:refer-clojure :exclude [get])
  (:require
   [cheshire.core :as json]
   [clojure.core :as core]
   [clojure.data :as data]
   [clojure.data.csv :as csv]
   [clojure.string :as str]
   [environ.core :as env]
   [medley.core :as m]
   [metabase.api.common :as api]
   [metabase.config :as config]
   [metabase.events :as events]
   [metabase.models.interface :as mi]
   [metabase.models.serialization :as serdes]
   [metabase.models.setting.cache :as setting.cache]
   [metabase.plugins.classloader :as classloader]
   [metabase.server.middleware.json]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date]
   [metabase.util.i18n :refer [deferred-trs deferred-tru trs tru]]
   [metabase.util.log :as log]
   [methodical.core :as methodical]
   [schema.core :as s]
   [toucan2.core :as t2])
  (:import
   (clojure.lang Keyword Symbol)
   (java.io StringWriter)
   (java.time.temporal Temporal)))

this namespace is required for side effects since it has the JSON encoder definitions for java.time classes and other things we need for :json settings

(comment metabase.server.middleware.json/keep-me)

Database-local Settings values (as a map of Setting name -> already-deserialized value). This comes from the value of Database.settings in the application DB. When bound, any Setting that can be Database-local will have a value from this map returned preferentially to the site-wide value.

This is normally bound automatically in Query Processor context by [[metabase.query-processor.middleware.resolve-database-and-driver]]. You may need to manually bind it in other places where you want to use Database-local values.

TODO -- we should probably also bind this in sync contexts e.g. functions in [[metabase.sync]].

TODO -- a way to SET Database-local values.

(def ^:dynamic *database-local-values*
  nil)

User-local Settings values (as a map of Setting name -> already-deserialized value). This comes from the value of User.settings in the application DB. When bound, any Setting that can be User-local will have a value from this map returned preferentially to the site-wide value.

This is a delay so that the settings for a user are loaded only if and when they are actually needed during a given API request.

This is normally bound automatically by session middleware, in [[metabase.server.middleware.session/do-with-current-user]].

(def ^:dynamic *user-local-values*
  (delay (atom nil)))

A set of setting names which existed in previous versions of Metabase, but are no longer used. New settings may not use these names to avoid unintended side-effects if an application database still stores values for these settings.

(def ^:private retired-setting-names
  #{"-site-url"
    "enable-advanced-humanization"
    "metabot-enabled"
    "ldap-sync-admin-group"
    "user-recent-views"
    "most-recently-viewed-dashboard"})

A dynamic val that controls whether it's allowed to use retired settings. Primarily used in test to disable retired setting check.

(def ^:dynamic *allow-retired-setting-names*
  false)
(declare admin-writable-site-wide-settings get-value-of-type set-value-of-type!)

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase.

(def Setting
  :model/Setting)
(methodical/defmethod t2/table-name :model/Setting [_model] :setting)
(doto :model/Setting
  (derive :metabase/model))
(methodical/defmethod t2/primary-keys :model/Setting [_model] [:key])
(t2/deftransforms :model/Setting
  {:value mi/transform-encrypted-text})
(defmethod serdes/hash-fields :model/Setting
  [_setting]
  [:key])
(def ^:private exported-settings
  '#{application-colors
     application-favicon-url
     application-font
     application-font-files
     application-logo-url
     application-name
     available-fonts
     available-locales
     available-timezones
     breakout-bins-num
     custom-formatting
     custom-geojson
     custom-geojson-enabled
     enable-embedding
     enable-nested-queries
     enable-sandboxes?
     enable-whitelabeling?
     enable-xrays
     hide-embed-branding?
     humanization-strategy
     landing-page
     loading-message
     aggregated-query-row-limit
     unaggregated-query-row-limit
     native-query-autocomplete-match-style
     persisted-models-enabled
     report-timezone
     report-timezone-long
     report-timezone-short
     search-typeahead-enabled
     show-homepage-data
     show-homepage-pin-message
     show-homepage-xrays
     show-lighthouse-illustration
     show-metabot
     site-locale
     site-name
     source-address-header
     start-of-week
     subscription-allowed-domains
     uploads-enabled
     uploads-database-id
     uploads-schema-name})
(defmethod serdes/extract-all "Setting" [_model _opts]
  (for [{:keys [key value]} (admin-writable-site-wide-settings
                             :getter (partial get-value-of-type :string))
        :when (contains? exported-settings (symbol key))]
    {:serdes/meta [{:model "Setting" :id (name key)}]
     :key key
     :value value}))
(defmethod serdes/load-find-local "Setting" [[{:keys [id]}]]
  (get-value-of-type :string (keyword id)))
(defmethod serdes/load-one! "Setting" [{:keys [key value]} _]
  (set-value-of-type! :string key value))
(def ^:private Type
  (s/pred (fn [a-type]
            (contains? (set (keys (methods get-value-of-type))) a-type))
          "Valid Setting :type"))
(def ^:private Visibility
  (s/enum :public :authenticated :settings-manager :admin :internal))

Type tag that will be included in the Setting's metadata, so that the getter function will not cause reflection warnings.

(defmulti default-tag-for-type
  {:arglists '([setting-type])}
  keyword)
(defmethod default-tag-for-type :default   [_] `Object)
(defmethod default-tag-for-type :string    [_] `String)
(defmethod default-tag-for-type :boolean   [_] `Boolean)
(defmethod default-tag-for-type :integer   [_] `Long)
(defmethod default-tag-for-type :double    [_] `Double)
(defmethod default-tag-for-type :timestamp [_] `Temporal)
(defmethod default-tag-for-type :keyword   [_] `Keyword)

Check whether the :default value of a Setting (if provided) agrees with the Setting's :type and its :tag (which usually comes from [[default-tag-for-type]]).

(defn- validate-default-value-for-type
  [{:keys [tag default] :as _setting-definition}]
  ;; the errors below don't need to be i18n'ed since they're definition-time errors rather than user-facing
  (when (some? tag)
    (assert ((some-fn symbol? string?) tag) (format "Setting :tag should be a symbol or string, got: ^%s %s"
                                                    (.getCanonicalName (class tag))
                                                    (pr-str tag))))
  (when (and (some? default)
             (some? tag))
    (let [klass (if (string? tag)
                  (try
                    (Class/forName tag)
                    (catch Throwable e
                      e))
                  (resolve tag))]
      (when-not (class? klass)
        (throw (ex-info (format "Cannot resolve :tag %s to a class. Is it fully qualified?" (pr-str tag))
                        {:tag klass}
                        (when (instance? Throwable klass) klass))))
      (when-not (instance? klass default)
        (throw (ex-info (format "Wrong :default type: got ^%s %s, but expected a %s"
                                (.getCanonicalName (class default))
                                (pr-str default)
                                (.getCanonicalName ^Class klass))
                        {:tag klass}))))))

Schema for valid values of :database-local. See [[metabase.models.setting]] docstring for description of what these options mean.

This is called LocalOption rather than DatabaseLocalOption or something like that because we intend to also add User-Local Settings at some point in the future. The will use the same options

(def ^:private LocalOption
  (s/enum :only :allowed :never))
(def ^:private SettingDefinition
  {:name        s/Keyword
   :munged-name s/Str
   :namespace   s/Symbol
   :description s/Any            ; description is validated via the macro, not schema
   ;; Use `:doc` to include a map with additional documentation, for use when generating the environment variable docs
   ;; from source. To exclude a setting from documenation, set to `false`. See metabase.cmd.env-var-dox.
   :doc         s/Any
   :default     s/Any
   :type        Type             ; all values are stored in DB as Strings,
   :getter      clojure.lang.IFn ; different getters/setters take care of parsing/unparsing
   :setter      clojure.lang.IFn
   :tag         (s/maybe Symbol) ; type annotation, e.g. ^String, to be applied. Defaults to tag based on :type
   :sensitive?  s/Bool           ; is this sensitive (never show in plaintext), like a password? (default: false)
   :visibility  Visibility       ; where this setting should be visible (default: :admin)
   :cache?      s/Bool           ; should the getter always fetch this value "fresh" from the DB? (default: false)
   :deprecated  (s/maybe s/Str)  ; if non-nil, contains the Metabase version in which this setting was deprecated
   ;; whether this Setting can be Database-local or User-local. See [[metabase.models.setting]] docstring for more info.
   :database-local LocalOption
   :user-local     LocalOption
   ;; called whenever setting value changes, whether from update-setting! or a cache refresh. used to handle cases
   ;; where a change to the cache necessitates a change to some value outside the cache, like when a change the
   ;; `:site-locale` setting requires a call to `java.util.Locale/setDefault`
   :on-change   (s/maybe clojure.lang.IFn)
   ;; If non-nil, determines the Enterprise feature flag required to use this setting. If the feature is not enabled,
   ;; the setting will behave the same as if `enabled?` returns `false` (see below).
   :feature     (s/maybe s/Keyword)
   ;; Function which returns true if the setting should be enabled. If it returns false, the setting will throw an
   ;; exception when it is attempted to be set, and will return its default value when read. Defaults to always enabled.
   :enabled?    (s/maybe clojure.lang.IFn)
   ;; Keyword that determines what kind of audit log entry should be created when this setting is written. Options are
   ;; `:never`, `:no-value`, `:raw-value`, and `:getter`. User- and database-local settings are never audited. `:getter`
   ;; should be used for most non-sensitive settings, and will log the value returned by its getter, which may be a
   ;; the default getter or a custom one.
   ;; (default: `:no-value`)
   :audit       (s/maybe (s/enum :never :no-value :raw-value :getter))})

Map of loaded defsettings

(defonce 
  registered-settings
  (atom {}))
(defprotocol ^:private Resolvable
  (resolve-setting [setting-definition-or-name]
    "Resolve the definition map for a Setting. `setting-definition-or-name` map be a map, keyword, or string."))
(extend-protocol Resolvable
  clojure.lang.IPersistentMap
  (resolve-setting [this] this)

  String
  (resolve-setting [s]
    (resolve-setting (keyword s)))

  clojure.lang.Keyword
  (resolve-setting [k]
    (or (@registered-settings k)
        (throw (ex-info (tru "Unknown setting: {0}" k)
                        {:registered-settings
                         (sort (keys @registered-settings))})))))

The actual watch that triggers this happens in [[metabase.models.setting.cache/cache*]] because the cache might be swapped out depending on which app DB we have in play

this isn't really something that needs to be a multimethod, but I'm using it because the logic can't really live in [[metabase.models.setting.cache]] but the cache has to live here; this is a good enough way to prevent circular references for now

(defmethod setting.cache/call-on-change :default
  [old new]
  (let [rs      @registered-settings
        [d1 d2] (data/diff old new)]
    (doseq [changed-setting (into (set (keys d1))
                                  (set (keys d2)))]
      (when-let [on-change (get-in rs [(keyword changed-setting) :on-change])]
        (on-change (core/get old changed-setting) (core/get new changed-setting))))))

+----------------------------------------------------------------------------------------------------------------+ | get | +----------------------------------------------------------------------------------------------------------------+

(defprotocol ^:private SettingName
  (setting-name ^String [setting-definition-or-name]
    "String name of a Setting, e.g. `\"site-url\"`. Works with strings, keywords, or Setting definition maps."))
(extend-protocol SettingName
  clojure.lang.IPersistentMap
  (setting-name [this]
    (name (:name this)))

  String
  (setting-name [this]
    this)

  clojure.lang.Keyword
  (setting-name [this]
    (name this)))
(defn- database-local-only? [setting]
  (= (:database-local (resolve-setting setting)) :only))
(defn- user-local-only? [setting]
  (= (:user-local (resolve-setting setting)) :only))
(defn- allows-database-local-values? [setting]
  (#{:only :allowed} (:database-local (resolve-setting setting))))
(defn- database-local-value [setting-definition-or-name]
  (let [{setting-name :name, :as setting} (resolve-setting setting-definition-or-name)]
    (when (allows-database-local-values? setting)
      (core/get *database-local-values* setting-name))))
(defn- allows-user-local-values? [setting]
  (#{:only :allowed} (:user-local (resolve-setting setting))))
(defn- allows-site-wide-values? [setting]
  (and
   (not (database-local-only? setting))
   (not (user-local-only? setting))))
(defn- site-wide-only? [setting]
  (and
   (not (allows-database-local-values? setting))
   (not (allows-user-local-values? setting))))
(defn- user-local-value [setting-definition-or-name]
  (let [{setting-name :name, :as setting} (resolve-setting setting-definition-or-name)]
    (when (allows-user-local-values? setting)
      (core/get @@*user-local-values* setting-name))))
(defn- should-set-user-local-value? [setting-definition-or-name]
  (let [setting (resolve-setting setting-definition-or-name)]
    (and (allows-user-local-values? setting)
         @@*user-local-values*)))
(defn- set-user-local-value! [setting-definition-or-name value]
  (let [{setting-name :name} (resolve-setting setting-definition-or-name)]
    ;; Update the atom in *user-local-values* with the new value before writing to the DB. This ensures that
    ;; subsequent setting updates within the same API request will not overwrite this value.
    (swap! @*user-local-values* u/assoc-dissoc setting-name value)
    (t2/update! 'User api/*current-user-id* {:settings (json/generate-string @@*user-local-values*)})))

A dynamic var that controls whether we should enforce checks on setting access. Defaults to false; should be set to true when settings are being written directly via /api/setting endpoints.

(def ^:dynamic *enforce-setting-access-checks*
  false)
(defn- has-feature?
  [feature]
  (u/ignore-exceptions
   (classloader/require 'metabase.public-settings.premium-features))
  (let [has-feature?' (resolve 'metabase.public-settings.premium-features/has-feature?)]
    (has-feature?' feature)))

If advanced-permissions is enabled, check if current user has permissions to edit setting. Return false for all non-admins when advanced-permissions is disabled. Return true for all admins.

(defn has-advanced-setting-access?
  []
  (or api/*is-superuser?*
      (do
        (when config/ee-available?
          (classloader/require 'metabase-enterprise.advanced-permissions.common
                               'metabase.public-settings.premium-features))
        (if-let [current-user-has-application-permissions?
                 (and (has-feature? :advanced-permissions)
                      (resolve 'metabase-enterprise.advanced-permissions.common/current-user-has-application-permissions?))]
          (current-user-has-application-permissions? :setting)
          false))))

This checks whether the current user should have the ability to read or write the provided setting.

By default this function always returns true, but setting access control can be turned on the dynamic var *enforce-setting-access-checks*. This is because this enforcement is only necessary when settings are being accessed directly via the API, but not in most other places on the backend.

(defn- current-user-can-access-setting?
  [setting]
  (or (not *enforce-setting-access-checks*)
      (nil? api/*current-user-id*)
      api/*is-superuser?*
      (and
       ;; Non-admin setting managers can only access settings that are not marked as admin-only
       (not api/*is-superuser?*)
       (has-advanced-setting-access?)
       (not= (:visibility setting) :admin))
      (and
       ;; Non-admins can only access user-local settings not marked as admin-only
       (allows-user-local-values? setting)
       (not= (:visibility setting) :admin))))

Munge names so that they are legal for bash. Only allows for alphanumeric characters, underscores, and hyphens.

(defn- munge-setting-name
  [setting-nm]
  (str/replace (name setting-nm) #"[^a-zA-Z0-9_-]*" ""))

Get the env var corresponding to setting-definition-or-name. (This is used primarily for documentation purposes).

(defn- env-var-name
  ^String [setting-definition-or-name]
  (str "MB_" (-> (setting-name setting-definition-or-name)
                 munge-setting-name
                 (str/replace "-" "_")
                 u/upper-case-en)))

Correctly translate a setting to the keyword it will be found at in [[env/env]].

(defn setting-env-map-name
  [setting-definition-or-name]
  (keyword (str "mb-" (munge-setting-name (setting-name setting-definition-or-name)))))

Get the value of setting-definition-or-name from the corresponding env var, if any. The name of the Setting is converted to uppercase and dashes to underscores; for example, a setting named default-domain can be set with the env var MB_DEFAULT_DOMAIN. Note that this strips out characters that are not legal for shells. Setting foo-bar? will expect to find the key :mb-foo-bar which will be sourced from the environment variable MB_FOO_BAR.

(defn env-var-value
  ^String [setting-definition-or-name]
  (let [setting (resolve-setting setting-definition-or-name)]
    (when (allows-site-wide-values? setting)
      (let [v (env/env (setting-env-map-name setting))]
        (when (seq v)
          v)))))
(def ^:private ^:dynamic *disable-cache* false)

Get the value, if any, of setting-definition-or-name from the DB (using / restoring the cache as needed).

(defn- db-or-cache-value
  ^String [setting-definition-or-name]
  (let [setting       (resolve-setting setting-definition-or-name)
        db-is-set-up? (or (requiring-resolve 'metabase.db/db-is-set-up?)
                          ;; this should never be hit. it is just overly cautious against a NPE here. But no way this
                          ;; cannot resolve
                          (constantly false))
        db-value      #(t2/select-one-fn :value Setting :key (setting-name setting-definition-or-name))]
    ;; cannot use db (and cache populated from db) if db is not set up
    (when (and (db-is-set-up?) (allows-site-wide-values? setting))
      (let [v (if *disable-cache*
                (db-value)
                (do
                  (setting.cache/restore-cache-if-needed!)
                  (let [cache (setting.cache/cache)]
                    (if (nil? cache)
                      ;; If another thread is populating the cache for the first time, we will have a nil value for
                      ;; the cache and must hit the db while the cache populates
                      (db-value)
                      (core/get cache (setting-name setting-definition-or-name))))))]
        (not-empty v)))))

Get the :default value of setting-definition-or-name if one was specified.

(defn default-value
  [setting-definition-or-name]
  (let [{:keys [default]} (resolve-setting setting-definition-or-name)]
    default))

Get the raw value of a Setting from wherever it may be specified. Value is fetched by trying the following sources in order:

  1. From [[user-local-values]] if this Setting is allowed to have User-local values
  2. From [[database-local-values]] if this Setting is allowed to have Database-local values
  3. From the corresponding env var (excluding empty string values)
  4. From the application database (i.e., set via the admin panel) (excluding empty string values)
  5. The default value, if one was specified

!!!!!!!!!! The value returned MAY OR MAY NOT be a String depending on the source !!!!!!!!!!

This is the underlying function powering all the other getters such as methods of [[get-value-of-type]]. These getter functions must be coded to handle either String or non-String values. You can use the three-arity version of this function to do that.

Three-arity version can be used to specify how to parse non-empty String values (parse-fn) and under what conditions values can be returned directly (pred) -- see [[get-value-of-type]] for :boolean for example usage.

(defn get-raw-value
  ([setting-definition-or-name]
   (let [setting    (resolve-setting setting-definition-or-name)
         source-fns [user-local-value
                     database-local-value
                     env-var-value
                     db-or-cache-value
                     default-value]]
     (loop [[f & more] source-fns]
       (let [v (f setting)]
         (cond
           (some? v)  v
           (seq more) (recur more))))))
  ([setting-definition-or-name pred parse-fn]
   (let [parse     (fn [v]
                     (try
                       (parse-fn v)
                       (catch Throwable e
                         (let [{setting-name :name} (resolve-setting setting-definition-or-name)]
                           (throw (ex-info (tru "Error parsing Setting {0}: {1}" setting-name (ex-message e))
                                           {:setting setting-name}
                                           e))))))
         raw-value (get-raw-value setting-definition-or-name)
         v         (cond-> raw-value
                     (string? raw-value) parse)]
     (when (pred v)
       v))))

Get the value of setting-definition-or-name as a value of type setting-type. This is used as the default getter for Settings with setting-type.

Impls should call [[get-raw-value]] to get the underlying possibly-serialized value and parse it appropriately if it comes back as a String; impls should only return values that are of the correct type (e.g. the :boolean impl should only return [[Boolean]] values).

(defmulti get-value-of-type
  {:arglists '([setting-type setting-definition-or-name])}
  (fn [setting-type _]
    (keyword setting-type)))
(defmethod get-value-of-type :string
  [_setting-type setting-definition-or-name]
  (get-raw-value setting-definition-or-name string? identity))
(s/defn string->boolean :- (s/maybe s/Bool)
  "Interpret a `string-value` of a Setting as a boolean."
  [string-value :- (s/maybe s/Str)]
  (when (seq string-value)
    (case (u/lower-case-en string-value)
      "true"  true
      "false" false
      (throw (Exception.
              (tru "Invalid value for string: must be either \"true\" or \"false\" (case-insensitive)."))))))

Strings are parsed as follows:

  • true if lowercased string value is true
  • false if lowercased string value is false.
  • Otherwise, throw an Exception.
(defmethod get-value-of-type :boolean
  [_setting-type setting-definition-or-name]
  (get-raw-value setting-definition-or-name boolean? string->boolean))
(defmethod get-value-of-type :integer
  [_setting-type setting-definition-or-name]
  (get-raw-value setting-definition-or-name integer? #(Long/parseLong ^String %)))
(defmethod get-value-of-type :positive-integer
  [_setting-type setting-definition-or-name]
  (get-raw-value setting-definition-or-name pos-int? #(Long/parseLong ^String %)))
(defmethod get-value-of-type :double
  [_setting-type setting-definition-or-name]
  (get-raw-value setting-definition-or-name double? #(Double/parseDouble ^String %)))
(defmethod get-value-of-type :keyword
  [_setting-type setting-definition-or-name]
  (get-raw-value setting-definition-or-name keyword? keyword))
(defmethod get-value-of-type :timestamp
  [_setting-type setting-definition-or-name]
  (get-raw-value setting-definition-or-name #(instance? Temporal %) u.date/parse))
(defmethod get-value-of-type :json
  [_setting-type setting-definition-or-name]
  (get-raw-value setting-definition-or-name coll? #(json/parse-string % true)))
(defmethod get-value-of-type :csv
  [_setting-type setting-definition-or-name]
  (get-raw-value setting-definition-or-name sequential? (comp first csv/read-csv)))
(defn- default-getter-for-type [setting-type]
  (partial get-value-of-type (keyword setting-type)))

Fetch the value of setting-definition-or-name. What this means depends on the Setting's :getter; by default, this looks for first for a corresponding env var, then checks the cache, then returns the default value of the Setting, if any.

(defn get
  [setting-definition-or-name]
  (let [{:keys [cache? getter enabled? default feature]} (resolve-setting setting-definition-or-name)
        disable-cache?                                   (or *disable-cache* (not cache?))]
    (if (or (and feature (not (has-feature? feature)))
            (and enabled? (not (enabled?))))
      default
      (binding [*disable-cache* disable-cache?]
        (getter)))))

+----------------------------------------------------------------------------------------------------------------+ | set! | +----------------------------------------------------------------------------------------------------------------+

Update an existing Setting. Used internally by [[set-value-of-type!]] for :string below; do not use directly.

(defn- update-setting!
  [setting-name new-value]
  (assert (not= setting-name setting.cache/settings-last-updated-key)
          (tru "You cannot update `settings-last-updated` yourself! This is done automatically."))
  ;; Toucan 2 version of `update!` will do transforms and stuff like that
  (t2/update! Setting :key setting-name {:value new-value}))

Insert a new row for a Setting. Used internally by [[set-value-of-type!]] for :string below; do not use directly.

(defn- set-new-setting!
  [setting-name new-value]
  (try (first (t2/insert-returning-instances! Setting
                                              :key   setting-name
                                              :value new-value))
       ;; if for some reason inserting the new value fails it almost certainly means the cache is out of date
       ;; and there's actually a row in the DB that's not in the cache for some reason. Go ahead and update the
       ;; existing value and log a warning
       (catch Throwable e
         (log/warn (deferred-tru "Error inserting a new Setting:") "\n"
                   (.getMessage e) "\n"
                   (deferred-tru "Assuming Setting already exists in DB and updating existing value."))
         (update-setting! setting-name new-value))))
(defn- obfuscated-value? [v]
  (when (seq v)
    (boolean (re-matches #"^\*{10}.{2}$" v))))

Obfuscate the value of sensitive Setting. We'll still show the last 2 characters so admins can still check that the value is what's expected (e.g. the correct password).

(obfuscate-value "sensitivePASSWORD123") ;; -> "**23"

(defn obfuscate-value
  [s]
  (str "**********" (str/join (take-last 2 (str s)))))

Set the value of a setting-type setting-definition-or-name. A nil value deletes the current value of the Setting (when set in the application database). Returns new-value.

Impls of this method should ultimately call the implementation for :string, which handles the low-level logic of updating the cache and application database.

(defmulti set-value-of-type!
  {:arglists '([setting-type setting-definition-or-name new-value])}
  (fn [setting-type _ _]
    (keyword setting-type)))
(s/defmethod set-value-of-type! :string
  [_setting-type setting-definition-or-name new-value :- (s/maybe s/Str)]
  (let [new-value                         (when (seq new-value)
                                            new-value)
        {:keys [sensitive? deprecated]
         :as setting}                     (resolve-setting setting-definition-or-name)
        obfuscated?                       (and sensitive? (obfuscated-value? new-value))
        setting-name                      (setting-name setting)]
    ;; if someone attempts to set a sensitive setting to an obfuscated value (probably via a misuse of the `set-many!` function, setting values that have not changed), ignore the change. Log a message that we are ignoring it.
    (if obfuscated?
      (log/info (trs "Attempted to set Setting {0} to obfuscated value. Ignoring change." setting-name))
      (do
        (when (and deprecated (not (nil? new-value)))
          (log/warn (trs "Setting {0} is deprecated as of Metabase {1} and may be removed in a future version."
                         setting-name
                         deprecated)))
        (when (and
               (= :only (:user-local setting))
               (not (should-set-user-local-value? setting)))
          (log/warn (trs "Setting {0} can only be set in a user-local way, but there are no *user-local-values*." setting-name)))
        (if (should-set-user-local-value? setting)
          ;; If this is user-local and this is being set in the context of an API call, we don't want to update the
          ;; site-wide value or write or read from the cache
          (set-user-local-value! setting-name new-value)
          (do
            ;; make sure we're not trying to set the value of a Database-local-only Setting
            (when-not (allows-site-wide-values? setting)
              (throw (ex-info (tru "Site-wide values are not allowed for Setting {0}" (:name setting))
                              {:setting (:name setting)})))
            ;; always update the cache entirely when updating a Setting.
            (setting.cache/restore-cache!)
            ;; write to DB
            (cond
              (nil? new-value)
              (t2/delete! (t2/table-name Setting) :key setting-name)
              ;; if there's a value in the cache then the row already exists in the DB; update that
              (contains? (setting.cache/cache) setting-name)
              (update-setting! setting-name new-value)
              ;; if there's nothing in the cache then the row doesn't exist, insert a new one
              :else
              (set-new-setting! setting-name new-value))
            ;; update cached value
            (setting.cache/update-cache! setting-name new-value)
            ;; Record the fact that a Setting has been updated so eventaully other instances (if applicable) find out
            ;; about it (For Settings that don't use the Cache, don't update the `last-updated` value, because it will
            ;; cause other instances to do needless reloading of the cache from the DB)
            (when-not *disable-cache*
              (setting.cache/update-settings-last-updated!))))
        ;; Now return the `new-value`.
        new-value))))
(defmethod set-value-of-type! :keyword
  [_setting-type setting-definition-or-name new-value]
  (set-value-of-type!
   :string setting-definition-or-name
   (u/qualified-name new-value)))
(defmethod set-value-of-type! :boolean
  [setting-type setting-definition-or-name new-value]
  (if (string? new-value)
    (set-value-of-type! setting-type setting-definition-or-name (string->boolean new-value))
    (let [s (case new-value
              true  "true"
              false "false"
              nil   nil)]
      (set-value-of-type! :string setting-definition-or-name s))))
(defmethod set-value-of-type! :integer
  [_setting-type setting-definition-or-name new-value]
  (set-value-of-type!
   :string setting-definition-or-name
   (when new-value
     (assert (or (integer? new-value)
                 (and (string? new-value)
                      (re-matches #"^-?\d+$" new-value))))
     (str new-value))))
(defmethod set-value-of-type! :positive-integer
  [_setting-type setting-definition-or-name new-value]
  (set-value-of-type!
   :string setting-definition-or-name
   (when new-value
     (assert (or (pos-int? new-value)
                 (and (string? new-value)
                      (re-matches #"^[1-9]\d*$" new-value))))
     (str new-value))))
(defmethod set-value-of-type! :double
  [_setting-type setting-definition-or-name new-value]
  (set-value-of-type!
   :string setting-definition-or-name
   (when new-value
     (assert (or (number? new-value)
                 (and (string? new-value)
                      (re-matches #"[+-]?([0-9]*[.])?[0-9]+" new-value))))
     (str new-value))))
(defmethod set-value-of-type! :json
  [_setting-type setting-definition-or-name new-value]
  (set-value-of-type!
   :string setting-definition-or-name
   (some-> new-value json/generate-string)))
(defmethod set-value-of-type! :timestamp
  [_setting-type setting-definition-or-name new-value]
  (set-value-of-type!
   :string setting-definition-or-name
   (some-> new-value u.date/format)))
(defn- serialize-csv [value]
  (cond
    ;; if we're passed as string, assume it's already CSV-encoded
    (string? value)
    value
    (sequential? value)
    (let [s (with-open [writer (StringWriter.)]
              (csv/write-csv writer [value])
              (str writer))]
      (first (str/split-lines s)))
    :else
    value))
(defmethod set-value-of-type! :csv
  [_setting-type setting-definition-or-name new-value]
  (set-value-of-type! :string setting-definition-or-name (serialize-csv new-value)))
(defn- default-setter-for-type [setting-type]
  (partial set-value-of-type! (keyword setting-type)))
(defn- audit-setting-change!
  [{:keys [name audit sensitive?]} previous-value new-value]
  (let [maybe-obfuscate #(cond-> % sensitive? obfuscate-value)]
    (events/publish-event!
     :event/setting-update
     {:details (merge {:key name}
                      (when (not= audit :no-value)
                        {:previous-value (maybe-obfuscate previous-value)
                         :new-value      (maybe-obfuscate new-value)}))
      :user-id api/*current-user-id*
      :model  :model/Setting})))

Returns true if the setting change should be written to the audit_log.

(defn- should-audit?
  [setting]
  (not= (:audit setting) :never))

Calls the setting's setter with new-value, and then writes the change to the audit_log table if necessary.

(defn- set-with-audit-logging!
  [{:keys [setter getter audit] :as setting} new-value]
  (if (should-audit? setting)
    (let [audit-value-fn #(condp = audit
                            :no-value  nil
                            :raw-value (get-raw-value setting)
                            :getter    (getter))
          previous-value (audit-value-fn)]
      (u/prog1 (setter new-value)
        (audit-setting-change! setting previous-value (audit-value-fn))))
    (setter new-value)))

Set the value of setting-definition-or-name. What this means depends on the Setting's :setter; by default, this just updates the Settings cache and writes its value to the DB.

(set :mandrill-api-key "xyz123")

Style note: prefer using the setting directly instead:

(mandrill-api-key "xyz123")

(defn set!
  [setting-definition-or-name new-value]
  (let [{:keys [setter cache? enabled? feature] :as setting} (resolve-setting setting-definition-or-name)
        name                                                 (setting-name setting)]
    (when (and feature (not (has-feature? feature)))
      (throw (ex-info (tru "Setting {0} is not enabled because feature {1} is not available" name feature) setting)))
    (when (and enabled? (not (enabled?)))
      (throw (ex-info (tru "Setting {0} is not enabled" name) setting)))
    (when-not (current-user-can-access-setting? setting)
      (throw (ex-info (tru "You do not have access to the setting {0}" name) setting)))
    (when (= setter :none)
      (throw (UnsupportedOperationException. (tru "You cannot set {0}; it is a read-only setting." name))))
    (binding [*disable-cache* (not cache?)]
      (set-with-audit-logging! setting new-value))))

+----------------------------------------------------------------------------------------------------------------+ | register-setting! | +----------------------------------------------------------------------------------------------------------------+

Register a new Setting with a map of [[SettingDefinition]] attributes. Returns the map it was passed. This is used internally by [[defsetting]]; you shouldn't need to use it yourself.

(defn register-setting!
  [{setting-name :name, setting-ns :namespace, setting-type :type, default :default, :as setting}]
  (let [munged-name (munge-setting-name (name setting-name))]
    (u/prog1 (let [setting-type (s/validate Type (or setting-type :string))]
               (merge
                {:name           setting-name
                 :munged-name    munged-name
                 :namespace      setting-ns
                 :description    nil
                 :doc            nil
                 :type           setting-type
                 :default        default
                 :on-change      nil
                 :getter         (partial (default-getter-for-type setting-type) setting-name)
                 :setter         (partial (default-setter-for-type setting-type) setting-name)
                 :tag            (default-tag-for-type setting-type)
                 :visibility     :admin
                 :sensitive?     false
                 :cache?         true
                 :feature        nil
                 :database-local :never
                 :user-local     :never
                 :deprecated     nil
                 :enabled?       nil
                 ;; Disable auditing by default for user- or database-local settings
                 :audit          (if (site-wide-only? setting) :no-value :never)}
                (dissoc setting :name :type :default)))
      (s/validate SettingDefinition <>)
      (validate-default-value-for-type <>)
      ;; eastwood complains about (setting-name @registered-settings) for shadowing the function `setting-name`
      (when-let [registered-setting (core/get @registered-settings setting-name)]
        (when (not= setting-ns (:namespace registered-setting))
          (throw (ex-info (tru "Setting {0} already registered in {1}" setting-name (:namespace registered-setting))
                          {:existing-setting (dissoc registered-setting :on-change :getter :setter)}))))
      (when-let [same-munge (first (filter (comp #{munged-name} :munged-name)
                                           (vals @registered-settings)))]
        (when (not= setting-name (:name same-munge)) ;; redefinitions are fine
          (throw (ex-info (tru "Setting names in would collide: {0} and {1}"
                               setting-name (:name same-munge))
                          {:existing-setting (dissoc same-munge :on-change :getter :setter)
                           :new-setting      (dissoc <> :on-change :getter :setter)}))))
      (when (and (retired-setting-names (name setting-name)) (not *allow-retired-setting-names*))
        (throw (ex-info (tru "Setting name ''{0}'' is retired; use a different name instead" (name setting-name))
                        {:retired-setting-name (name setting-name)
                         :new-setting          (dissoc <> :on-change :getter :setter)})))
      (when (and (allows-user-local-values? setting) (allows-database-local-values? setting))
        (throw (ex-info (tru "Setting {0} allows both user-local and database-local values; this is not supported"
                             setting-name)
                        {:setting setting})))
      (when (and (:enabled? setting) (:feature setting))
        (throw (ex-info (tru "Setting {0} uses both :enabled? and :feature options, which are mutually exclusive"
                             setting-name)
                        {:setting setting})))
      (swap! registered-settings assoc setting-name <>))))

+----------------------------------------------------------------------------------------------------------------+ | defsetting macro | +----------------------------------------------------------------------------------------------------------------+

(defn- setting-fn-docstring [{:keys [default description], setting-type :type, :as setting}]
  ;; indentation below is intentional to make it clearer what shape the generated documentation is going to take.
  (str
   (description) \newline
   \newline
   (format "`%s` is a `%s` Setting. You can get its value by calling:\n" (setting-name setting) setting-type)
   \newline
   (format "    (%s)\n"                                                  (setting-name setting))
   \newline
   "and set its value by calling:\n"
   \newline
   (format "    (%s! <new-value>)\n"                                     (setting-name setting))
   \newline
   (format "You can also set its value with the env var `%s`.\n"         (env-var-name setting))
   \newline
   "Clear its value by calling:\n"
   \newline
   (format "    (%s! nil)\n"                                             (setting-name setting))
   \newline
   (format "Its default value is `%s`."                                  (pr-str default))))

Impl for [[defsetting]]. Create metadata for [[setting-fn]].

(defn setting-fn-metadata
  [getter-or-setter {:keys [tag deprecated], :as setting}]
  {:arglists   (case getter-or-setter
                 :getter (list (with-meta [] {:tag tag}))
                 :setter (list (with-meta '[new-value] {:tag tag})))
   :deprecated deprecated
   :doc        (setting-fn-docstring setting)})

Impl for [[defsetting]]. Create the automatically defined getter-or-setter function for Settings defined by [[defsetting]].

(defn setting-fn
  [getter-or-setter setting]
  (case getter-or-setter
    :getter (fn setting-getter* []
              (get setting))
    :setter (fn setting-setter* [new-value]
              ;; need to qualify this or otherwise the reader gets this confused with the set! used for things like
              ;; (set! *warn-on-reflection* true)
              ;; :refer-clojure :exclude doesn't seem to work in this case
              (metabase.models.setting/set! setting new-value))))

The next few functions are for validating the Setting description (i.e., docstring) at macroexpansion time. They check that the docstring is a valid deferred i18n form (e.g. [[metabase.util.i18n/deferred-tru]]) so the Setting description will be localized properly when it shows up in the FE admin interface.

(def ^:private allowed-deferred-i18n-forms
  #{`deferred-trs `deferred-tru})

Whether form is a function call/macro call form starting with a symbol in symbols.

(is-form? #{deferred-tru}(deferred-tru "wow")) ; -> true

(defn- is-form?
  [symbols form]
  (when (and (list? form)
             (symbol? (first form)))
    ;; resolve the symbol to a var and convert back to a symbol so we can get the actual name rather than whatever
    ;; alias the current namespace happens to be using
    (let [symb (symbol (resolve (first form)))]
      ((set symbols) symb))))
(defn- valid-trs-or-tru? [desc]
  (is-form? allowed-deferred-i18n-forms desc))

Check that description-form is a i18n form (e.g. [[metabase.util.i18n/deferred-tru]]). Returns description-form as-is.

(defn- validate-description-form
  [description-form]
  (when-not (valid-trs-or-tru? description-form)
    ;; this doesn't need to be i18n'ed because it's a compile-time error.
    (throw (ex-info (str "defsetting docstrings must be a *deferred* i18n form unless the Setting has"
                         " `:visibilty` `:internal`, `:setter` `:none`, or is defined in a test namespace."
                         (format " Got: ^%s %s"
                                 (some-> description-form class (.getCanonicalName))
                                 (pr-str description-form)))
                    {:description-form description-form})))
  description-form)

Is defsetting currently being used in a test namespace?

(defn- in-test?
  []
  (str/ends-with? (ns-name *ns*) "-test"))

Defines a new Setting that will be added to the DB at some point in the future. Conveniently can be used as a getter/setter as well

(defsetting mandrill-api-key (trs "API key for Mandrill.")) (mandrill-api-key) ; get the value (mandrill-api-key! new-value) ; update the value (mandrill-api-key! nil) ; delete the value

A setting can be set from the Admin Panel or via the corresponding env var, eg. MB_MANDRILL_API_KEY for the example above.

You may optionally pass any of the options below:

`:default`

The default value of the setting. This must be of the same type as the Setting type, e.g. the default for an :integer setting must be some sort of integer. (default: nil)

`:type`

:string (default) or one of the other types that implement [[get-value-of-type]] and [[set-value-of-type]]. Non-:string Settings have special default getters and setters that automatically coerce values to the correct types.

`:visibility`

Controls where this setting is visibile, and who can update it. Possible values are:

Visibility | Who Can See It? | Who Can Update It? ---------------- | ---------------------------- | -------------------- :public | The entire world | Admins and Settings Managers :authenticated | Logged-in Users | Admins and Settings Managers :settings-manager| Admins and Settings Managers | Admins and Settings Managers :admin | Admins | Admins :internal | Nobody | No one (usually for env-var-only settings)

'Settings Managers' are non-admin users with the 'settings' permission, which gives them access to the Settings page in the Admin Panel.

`:getter`

A custom getter fn, which takes no arguments. Overrides the default implementation. (This can in turn call functions in this namespace like methods of [[get-value-of-type]] to invoke the 'parent' getter behavior.)

`:setter`

A custom setter fn, which takes a single argument, or :none for read-only settings. Overrides the default implementation. (This can in turn call methods of [[set-value-of-type!]] to invoke 'parent' setter behavior. Keep in mind that the custom setter may be passed nil, which should clear the values of the Setting.)

`:cache?`

Should this Setting be cached? (default true)? Be careful when disabling this, because it could have a very negative performance impact.

`:sensitive?`

Is this a sensitive setting, such as a password, that we should never return in plaintext? (Default: false). Obfuscation is not done by getter functions, but instead by functions that ultimately return these values via the API, such as [[writable-settings]] below. (In other words, code in the backend can continute to consume sensitive Settings normally; sensitivity is a purely user-facing option.)

`:database-local`

The ability of this Setting to be /Database-local/. Valid values are :only, :allowed, and :never. Default: :never. See docstring for [[metabase.models.setting]] for more information.

`:user-local`

Whether this Setting is /User-local/. Valid values are :only, :allowed, and :never. Default: :never. See docstring for [[metabase.models.setting]] for more info.

`:deprecated`

If this setting is deprecated, this should contain a string of the Metabase version in which the setting was deprecated. A deprecation notice will be logged whenever the setting is written. (Default: nil).

`:on-change`

Do you want to update something else when this setting changes? Takes a function which takes 2 arguments, old, and new and calls it with the old and new settings values. By default, the :on-change will be missing, and nothing will happen, in [[call-on-change]] below.

`:feature`

If non-nil, determines the Enterprise feature flag required to use this setting. If the feature is not enabled, the setting will behave the same as if enabled? returns false (see below).

`enabled?`

Function which returns true if the setting should be enabled. If it returns false, the setting will throw an exception when it is attempted to be set, and will return its default value when read. Defaults to always enabled.

`audit`

Keyword that determines what kind of audit log entry should be created when this setting is written. Options are :never, :no-value, :raw-value, and :getter. User- and database-local settings are never audited. :getter should be used for most non-sensitive settings, and will log the value returned by its getter, which may be the default getter or a custom one. :raw-value will audit the raw string value of the setting in the database. (default: :no-value for most settings; :never for user- and database-local settings, settings with no setter, and :sensitive settings.)

(defmacro defsetting
  {:style/indent 1}
  [setting-symbol description & {:as options}]
  {:pre [(symbol? setting-symbol)
         (not (namespace setting-symbol))
         ;; don't put exclamation points in your Setting names. We don't want functions like `exciting!` for the getter
         ;; and `exciting!!` for the setter.
         (not (str/includes? (name setting-symbol) "!"))]}
  (let [description               (if (or (= (:visibility options) :internal)
                                          (= (:setter options) :none)
                                          (in-test?))
                                    description
                                    (validate-description-form description))
        ;; wrap the description form in a thunk, so its result updates with its dependencies
        description               `(fn [] ~description)
        definition-form           (assoc options
                                         :name (keyword setting-symbol)
                                         :description description
                                         :namespace (list 'quote (ns-name *ns*)))
        ;; create symbols for the getter and setter functions e.g. `my-setting` and `my-setting!` respectively.
        ;; preserve metadata from the `setting-symbol` passed to `defsetting`.
        setting-getter-fn-symbol  setting-symbol
        setting-setter-fn-symbol  (-> (symbol (str (name setting-symbol) \!))
                                      (with-meta (meta setting-symbol)))
        ;; create a symbol for the Setting definition from [[register-setting!]]
        setting-definition-symbol (gensym "setting-")]
    `(let [~setting-definition-symbol (register-setting! ~definition-form)]
       (-> (def ~setting-getter-fn-symbol (setting-fn :getter ~setting-definition-symbol))
           (alter-meta! merge (setting-fn-metadata :getter ~setting-definition-symbol)))
       ~(when-not (= (:setter options) :none)
          `(-> (def ~setting-setter-fn-symbol (setting-fn :setter ~setting-definition-symbol))
               (alter-meta! merge (setting-fn-metadata :setter ~setting-definition-symbol)))))))

+----------------------------------------------------------------------------------------------------------------+ | EXTRA UTIL FNS | +----------------------------------------------------------------------------------------------------------------+

Set the value of several Settings at once.

(set-many! {:mandrill-api-key "xyz123", :another-setting "ABC"})

(defn set-many!
  [settings]
  ;; if setting any of the settings fails, roll back the entire DB transaction and the restore the cache from the DB
  ;; to revert any changes in the cache
  (try
    (t2/with-transaction [_conn]
      (doseq [[k v] settings]
        (metabase.models.setting/set! k v)))
    settings
    (catch Throwable e
      (setting.cache/restore-cache!)
      (throw e))))

Get the value of a Setting that should be displayed to a User (i.e. via /api/setting/ endpoints): for Settings set via env vars, or Settings whose value has not been set (i.e., Settings whose value is the same as the default value) no value is displayed; for sensitive Settings, the value is obfuscated.

Accepts options:

  • :getter -- the getter function to use to fetch the Setting value. By default, uses setting/get, which will convert the setting to the appropriate type; you can use (partial get-value-of-type :string) to get all string values of Settings, for example.
(defn user-facing-value
  [setting-definition-or-name & {:keys [getter], :or {getter get}}]
  (let [{:keys [sensitive? visibility default], k :name, :as setting} (resolve-setting setting-definition-or-name)
        unparsed-value                                                (get-value-of-type :string k)
        parsed-value                                                  (getter k)
        ;; `default` and `env-var-value` are probably still in serialized form so compare
        value-is-default?                                             (= parsed-value default)
        value-is-from-env-var?                                        (some-> (env-var-value setting) (= unparsed-value))]
    (cond
      (not (current-user-can-access-setting? setting))
      (throw (ex-info (tru "You do not have access to the setting {0}" k) setting))
      ;; TODO - Settings set via an env var aren't returned for security purposes. It is an open question whether we
      ;; should obfuscate them and still show the last two characters like we do for sensitive values that are set via
      ;; the UI.
      (or value-is-default? value-is-from-env-var?)
      nil
      (= visibility :internal)
      (throw (Exception. (tru "Setting {0} is internal" k)))
      sensitive?
      (obfuscate-value parsed-value)
      :else
      parsed-value)))
(defn- user-facing-info
  [{:keys [default description], k :name, :as setting} & {:as options}]
  (let [set-via-env-var? (boolean (env-var-value setting))]
    {:key            k
     :value          (try
                       (m/mapply user-facing-value setting options)
                       (catch Throwable e
                         (log/error e (trs "Error fetching value of Setting"))))
     :is_env_setting set-via-env-var?
     :env_name       (env-var-name setting)
     :description    (str (description))
     :default        (if set-via-env-var?
                       (tru "Using value of env var {0}" (str \$ (env-var-name setting)))
                       default)}))

Returns a set of setting visibilities that the current user has read access to.

(defn current-user-readable-visibilities
  []
  (set (concat [:public]
               (when @api/*current-user*
                 [:authenticated])
               (when (has-advanced-setting-access?)
                 [:settings-manager])
               (when api/*is-superuser?*
                 [:admin]))))

Returns a set of setting visibilities that the current user has write access to.

(defn current-user-writable-visibilities
  []
  (set (concat []
               (when (has-advanced-setting-access?)
                 [:settings-manager :authenticated :public])
               (when api/*is-superuser?*
                 [:admin]))))

Return a sequence of site-wide Settings maps in a format suitable for consumption by the frontend. (For security purposes, this doesn't return the value of a Setting if it was set via env var).

options are passed to [[user-facing-value]].

This is currently used by GET /api/setting ([[metabase.api.setting/GET_]]; admin-only; powers the Admin Settings page) so all admin-visible Settings should be included. We do not want to return env var values, since admins are not allowed to modify them.

For settings managers who are not admins, only the subset of settings with the :settings-manager visibility level are returned.

(defn writable-settings
  [& {:as options}]
  ;; ignore Database-local values, but not User-local values
  (let [writable-visibilities (current-user-writable-visibilities)]
    (binding [*database-local-values* nil]
      (into
       []
       (comp (filter (fn [setting]
                       (and (contains? writable-visibilities (:visibility setting))
                            (not= (:database-local setting) :only))))
             (map #(m/mapply user-facing-info % options)))
       (sort-by :name (vals @registered-settings))))))

Returns a sequence of site-wide Settings maps, similar to [[writable-settings]]. However, this function excludes User-local Settings in addition to Database-local Settings. Settings that are optionally user-local will be included with their site-wide value, if a site-wide value is set.

options are passed to [[user-facing-value]].

This is used in [[metabase-enterprise.serialization.dump/dump-settings]] to serialize site-wide Settings.

(defn admin-writable-site-wide-settings
  [& {:as options}]
  ;; ignore User-local and Database-local values
  (binding [*user-local-values* (delay (atom nil))
            *database-local-values* nil]
    (into
     []
     (comp (filter (fn [setting]
                     (and (not= (:visibility setting) :internal)
                          (allows-site-wide-values? setting))))
           (map #(m/mapply user-facing-info % options)))
     (sort-by :name (vals @registered-settings)))))

Returns true if a setting can be read according to the provided set of allowed-visibilities, and false otherwise. allowed-visibilities is a set of visibilities that the user can read.

(defn can-read-setting?
  [setting allowed-visibilities]
  (let [setting (resolve-setting setting)]
    (boolean (and (not (:sensitive? setting))
                  (contains? allowed-visibilities (:visibility setting))))))

Returns Settings as a map of setting name -> site-wide value for a given set of [[Visibility]] keywords e.g. #{:public :authenticated}.

Settings marked :sensitive? (e.g. passwords) are excluded.

This is currently used by GET /api/session/properties ([[metabase.api.session/GET_properties]]) and in [[metabase.server.routes.index/load-entrypoint-template]]. These are used as read-only sources of Settings for the frontend client. For that reason, these Settings should include values that come back from environment variables, unless they are marked :sensitive?.

(defn user-readable-values-map
  [visibilities]
  ;; ignore Database-local values, but not User-local values
  (binding [*database-local-values* nil]
    (into
     {}
     (comp (filter (fn [[_setting-name setting]]
                     (and (not (database-local-only? setting))
                          (can-read-setting? setting visibilities))))
           (map (fn [[setting-name]]
                  [setting-name (get setting-name)])))
     @registered-settings)))
 

Settings cache. Cache is a 1:1 mapping of what's in the DB. Cached lookup time is ~60µs, compared to ~1800µs for DB lookup.

(ns metabase.models.setting.cache
  (:require
   [clojure.core :as core]
   [clojure.java.jdbc :as jdbc]
   [metabase.db.connection :as mdb.connection]
   [metabase.util :as u]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [toucan2.core :as t2])
  (:import
   (java.util.concurrent.locks ReentrantLock)))
(set! *warn-on-reflection* true)

Whenever something changes in the Settings cache it will invoke

(call-on-change old-cache new-cache

Actual implementation is provided in [[metabase.models.setting]] rather than here (to prevent circular references).

(defmulti call-on-change
  {:arglists '([old new])}
  (constantly :default))

Setting cache is unique to the application DB; if it's swapped out for tests or mocking or whatever then use a new cache.

(def ^:private ^{:arglists '([])} cache*
  (mdb.connection/memoize-for-application-db
   (fn []
     (doto (atom nil)
       (add-watch :call-on-change (fn [_key _ref old new]
                                    (call-on-change old new)))))))

Fetch the current contents of the Settings cache, a map of key (string) -> value (string).

(defn cache
  []
  @(cache*))

Update the String value of a Setting in the Settings cache.

(defn update-cache!
  [setting-name, ^String new-value]
  (if (seq new-value)
    (swap! (cache*) assoc  setting-name new-value)
    (swap! (cache*) dissoc setting-name)))

CACHE SYNCHRONIZATION

When running multiple Metabase instances (horizontal scaling), it is of course possible for one instance to update a Setting, and, since Settings are cached (to avoid tons of DB calls), for the other instances to then have an out-of-date cache. Thus we need a way for instances to know when their caches are out of date, so they can update them accordingly. Here is our solution:

We will record the last time any Setting was updated in a special Setting called settings-last-updated.

Since settings-last-updated itself is a Setting, it will get fetched as part of each instance's local cache; we can then periodically compare the locally cached value of settings-last-updated with the value in the DB. If our locally cached value is older than the one in the DB, we will flush our cache. When the cache is fetched again, it will have the up-to-date value.

Because different machines can have out-of-sync clocks, we'll rely entirely on the application DB for caclulating and comparing values of settings-last-updated. Because the Setting table itself only stores text values, we'll need to cast it between TEXT and TIMESTAMP SQL types as needed.

Internal key used to store the last updated timestamp for Settings.

(def ^String settings-last-updated-key
  "settings-last-updated")

Update the value of settings-last-updated in the DB; if the row does not exist, insert one.

(defn update-settings-last-updated!
  []
  (log/debug (trs "Updating value of settings-last-updated in DB..."))
  ;; for MySQL, cast(current_timestamp AS char); for H2 & Postgres, cast(current_timestamp AS text)
  (let [current-timestamp-as-string-honeysql (h2x/cast (if (= (mdb.connection/db-type) :mysql) :char :text)
                                                       [:raw "current_timestamp"])]
    ;; attempt to UPDATE the existing row. If no row exists, `t2/update!` will return 0...
    (or (pos? (t2/update! :setting  {:key settings-last-updated-key} {:value current-timestamp-as-string-honeysql}))
        ;; ...at which point we will try to INSERT a new row. Note that it is entirely possible two instances can both
        ;; try to INSERT it at the same time; one instance would fail because it would violate the PK constraint on
        ;; `key`, and throw a SQLException. As long as one instance updates the value, we are fine, so we can go ahead
        ;; and ignore that Exception if one is thrown.
        (try
          ;; Use `simple-insert!` because we do *not* want to trigger pre-insert behavior, such as encrypting `:value`
          (t2/insert! (t2/table-name (t2/resolve-model 'Setting)) :key settings-last-updated-key, :value current-timestamp-as-string-honeysql)
          (catch java.sql.SQLException e
            ;; go ahead and log the Exception anyway on the off chance that it *wasn't* just a race condition issue
            (log/error (trs "Error updating Settings last updated value: {0}"
                            (with-out-str (jdbc/print-sql-exception-chain e))))))))
  ;; Now that we updated the value in the DB, go ahead and update our cached value as well, because we know about the
  ;; changes
  (swap! (cache*) assoc settings-last-updated-key (t2/select-one-fn :value 'Setting :key settings-last-updated-key)))

Check whether our Settings cache is out of date. We know the cache is out of date if either of the following conditions is true:

  • The cache is empty (the (cache* atom is nil), which of course means it needs to be updated
  • There is a value of settings-last-updated in the cache, and it is older than the value of in the DB. (There will be no value until the first time a normal Setting is updated; thus if it is not yet set, we do not yet need to invalidate our cache.)
(defn- cache-out-of-date?
  []
  (log/debug (trs "Checking whether settings cache is out of date (requires DB call)..."))
  (let [current-cache (cache)]
    (boolean
      (or
        ;; is the cache empty?
        (not current-cache)
        ;; if not, get the cached value of `settings-last-updated`, and if it exists...
        (when-let [last-known-update (core/get current-cache settings-last-updated-key)]
          ;; compare it to the value in the DB. This is done be seeing whether a row exists
          ;; WHERE value > <local-value>
          (u/prog1 (t2/select-one-fn :value 'Setting
                     {:where [:and
                              [:= :key settings-last-updated-key]
                              [:> :value last-known-update]]})
            (log/trace "last known Settings update: " (pr-str last-known-update))
            (log/trace "actual last Settings update:" (pr-str <>))
            (when <>
              (log/info (u/format-color 'red
                            (trs "Settings have been changed on another instance, and will be reloaded here."))))))))))

How often we should check whether the Settings cache is out of date (which requires a DB call)?

(def ^:private ^:const cache-update-check-interval-ms
  (u/minutes->ms 1))
(defonce ^:private last-update-check (atom 0))

Has it has been more than a minute since the last time we checked for updates?

(defn- time-for-another-update-check?
  []
  (> (- (System/currentTimeMillis) @last-update-check)
     cache-update-check-interval-ms))

Populate cache with the latest hotness from the db

(defn restore-cache!
  []
  (log/debug (trs "Refreshing Settings cache..."))
  (reset! (cache*) (t2/select-fn->fn :key :value 'Setting)))
(defonce ^:private ^ReentrantLock restore-cache-lock (ReentrantLock.))

Check whether we need to repopulate the cache with fresh values from the DB (because the cache is either empty or known to be out-of-date), and do so if needed. This is intended to be called every time a Setting value is retrieved, so it should be efficient; thus the calculation (should-restore-cache?) is itself TTL-memoized.

(defn restore-cache-if-needed!
  []
  ;; There's a potential race condition here where two threads both call this at the exact same moment, and both get
  ;; `true` when they call `should-restore-cache`, and then both simultaneously try to update the cache (or, one
  ;; updates the cache, but the other calls `should-restore-cache?` and gets `true` before the other calls
  ;; `memo-swap!` (see below))
  ;;
  ;; This is not desirable, since either situation would result in duplicate work. Better to just add a quick lock
  ;; here so only one of them does it, since at any rate waiting for the other thread to finish the task in progress is
  ;; certainly quicker than starting the task ourselves from scratch
  (when (time-for-another-update-check?)
    ;; if the lock is not already held by any thread, including this one...
    (when-not (.isLocked restore-cache-lock)
      ;; attempt to acquire the lock. Returns immediately if lock is is already held.
      (when (.tryLock restore-cache-lock)
        (try
          (reset! last-update-check (System/currentTimeMillis))
          (when (cache-out-of-date?)
            (restore-cache!))
          (finally
            (.unlock restore-cache-lock)))))))
 

Helper macros for defining Settings that can have multiple getter/setter implementations. The implementation that gets used is determined at runtime when the getter or setter is invoked by a dispatch function.

This functionality was originally intended to facilitate separate EE and OSS versions of Settings, but rather than restrict the impls to just :oss and :ee, these macros allow an arbitrary dispatch function and any number of implementations.

See PR #16365 for more context.

(ns metabase.models.setting.multi-setting
  (:require
   [metabase.models.setting :as setting]
   [metabase.util.i18n :refer [tru]]))
(set! *warn-on-reflection* true)

Determine the dispatch value for a multi-Setting defined by define-multi-setting.

(defmulti dispatch-multi-setting
  {:arglists '([setting-key])}
  keyword)

Get the value of a multi-Setting defined by define-multi-setting for the impl obtained by calling (dispatch-multi-setting setting-key).

(defmulti get-multi-setting
  {:arglists '([setting-key impl])}
  (fn [setting-key impl]
    [(keyword setting-key) (keyword impl)]))

Update the value of a multi-Setting defined by define-multi-setting for the impl obtained by calling (dispatch-multi-setting setting-key).

(defmulti set-multi-setting
  {:arglists '([setting-key impl new-value])}
  (fn [setting-key impl _]
    [(keyword setting-key) (keyword impl)]))

Define a Setting that can have multiple getter/setter implementations. The implementation used is determined by calling dispatch-thunk when the Setting getter or setter is invoked. And :getter or :setter defined here will be used for all impls; you can use this to make a multi-Setting read-only, for example by specifying :setter none here.

defsetting : define-multi-setting :: defn : defmulti

(defmacro define-multi-setting
  {:style/indent :defn}
  [setting-symbol doc dispatch-thunk & {:as options}]
  (let [setting-key (keyword setting-symbol)
        options     (merge {:getter `(fn []
                                       (get-multi-setting ~setting-key (dispatch-multi-setting ~setting-key)))
                            :setter `(fn [new-value#]
                                       (set-multi-setting ~setting-key (dispatch-multi-setting ~setting-key) new-value#))}
                       options)]
    `(do
       (let [dispatch-thunk# ~dispatch-thunk]
         (defmethod dispatch-multi-setting ~setting-key
           [~'_]
           (dispatch-thunk#)))
       (setting/defsetting ~setting-symbol
         ~doc
         ~@(mapcat identity options)))))

Define a implementation for a Setting defined by define-multi-setting. Accepts options :getter (a function that takes no args) and/or :setter (a function that takes a single arg, or the keyword :none), the same as defsetting. Note that any of these options defined by define-multi-setting will be used for all impls and ignored here.

define-multi-setting : define-multi-setting-impl :: defmulti : defmethod

See define-multi-setting for more details.

(defmacro define-multi-setting-impl
  [setting-symbol dispatch-value & {:keys [getter setter]}]
  (let [setting-key    (keyword (name setting-symbol))
        dispatch-value (keyword dispatch-value)]
    `(do
       ~(when getter
          `(let [getter# ~getter]
             (defmethod get-multi-setting [~setting-key ~dispatch-value]
               [~'_ ~'_]
               (getter#))))
       ~(when setter
          (if (= setter :none)
            `(defmethod set-multi-setting [~setting-key ~dispatch-value]
               [~'_ ~'_ ~'_]
               (throw (UnsupportedOperationException. (tru "You cannot set {0}; it is a read-only setting." ~setting-key))))
            `(let [setter# ~setter]
               (defmethod set-multi-setting [~setting-key ~dispatch-value]
                 [~'_ ~'_ new-value#]
                 (setter# new-value#))))))))
 
(ns metabase.models.table
  (:require
   [metabase.db.connection :as mdb.connection]
   [metabase.db.util :as mdb.u]
   [metabase.driver :as driver]
   [metabase.models.audit-log :as audit-log]
   [metabase.models.database :refer [Database]]
   [metabase.models.field :refer [Field]]
   [metabase.models.field-values :refer [FieldValues]]
   [metabase.models.humanization :as humanization]
   [metabase.models.interface :as mi]
   [metabase.models.permissions :as perms :refer [Permissions]]
   [metabase.models.serialization :as serdes]
   [metabase.util :as u]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

----------------------------------------------- Constants + Entity -----------------------------------------------

Valid values for Table.visibility_type (field may also be nil). (Basically any non-nil value is a reason for hiding the table.)

(def visibility-types
  #{:hidden :technical :cruft})

Valid values for Table.field_order. :database - use the same order as in the table definition in the DB; :alphabetical - order alphabetically by name; :custom - the user manually set the order in the data model :smart - Try to be smart and order like you'd usually want it: first PK, followed by :type/Names, then :type/Temporals, and from there on in alphabetical order.

(def field-orderings
  #{:database :alphabetical :custom :smart})

--------------------------------------------------- Lifecycle ----------------------------------------------------

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all the Table symbol in our codebase.

(def Table
  :model/Table)
(methodical/defmethod t2/table-name :model/Table [_model] :metabase_table)
(doto :model/Table
  (derive :metabase/model)
  (derive ::mi/read-policy.full-perms-for-perms-set)
  (derive ::mi/write-policy.full-perms-for-perms-set)
  (derive :hook/timestamped?))
(t2/deftransforms :model/Table
  {:entity_type     mi/transform-keyword
   :visibility_type mi/transform-keyword
   :field_order     mi/transform-keyword})
(methodical/defmethod t2/model-for-automagic-hydration [:default :table]
  [_original-model _k]
  :model/Table)
(t2/define-before-insert :model/Table
  [table]
  (let [defaults {:display_name (humanization/name->human-readable-name (:name table))
                  :field_order  (driver/default-field-order (t2/select-one-fn :engine Database :id (:db_id table)))}]
    (merge defaults table)))
(t2/define-before-delete :model/Table
  [{:keys [db_id schema id]}]
  (t2/delete! Permissions :object [:like (str "%" (perms/data-perms-path db_id schema id) "%")]))
(defmethod mi/perms-objects-set :model/Table
  [{db-id :db_id, schema :schema, table-id :id, :as table} read-or-write]
  ;; To read (e.g., fetch metadata) a Table you must have either self-service data permissions for the Table, or write
  ;; permissions for the Table (detailed below). `can-read?` checks the former, while `can-write?` checks the latter;
  ;; the permission-checking function to call when reading a Table depends on the context of the request. When reading
  ;; Tables to power the admin data model page; `can-write?` should be called; in other contexts, `can-read?` should
  ;; be called. (TODO: is there a way to clear up the semantics here?)
  ;;
  ;; To write a Table (e.g. update its metadata):
  ;;   * If Enterprise Edition code is available and the :advanced-permissions feature is enabled, you must have
  ;;     data-model permissions for othe table
  ;;   * Else, you must be an admin
  #{(case read-or-write
      :read  (perms/table-read-path table)
      :write (perms/data-model-write-perms-path db-id schema table-id))})
(defmethod serdes/hash-fields :model/Table
  [_table]
  [:schema :name (serdes/hydrated-hash :db)])

------------------------------------------------ Field ordering -------------------------------------------------

How should we order fields.

(def field-order-rule
  [[:position :asc] [:%lower.name :asc]])

Update :position of field belonging to table table accordingly to :field_order

(defn update-field-positions!
  [table]
  (doall
   (map-indexed (fn [new-position field]
                  (t2/update! Field (u/the-id field) {:position new-position}))
                ;; Can't use `select-field` as that returns a set while we need an ordered list
                (t2/select [Field :id]
                           :table_id  (u/the-id table)
                           {:order-by (case (:field_order table)
                                        :custom       [[:custom_position :asc]]
                                        :smart        [[[:case
                                                         (mdb.u/isa :semantic_type :type/PK)       0
                                                         (mdb.u/isa :semantic_type :type/Name)     1
                                                         (mdb.u/isa :semantic_type :type/Temporal) 2
                                                         :else                                     3]
                                                        :asc]
                                                       [:%lower.name :asc]]
                                        :database     [[:database_position :asc]]
                                        :alphabetical [[:%lower.name :asc]])}))))

Field ordering is valid if all the fields from a given table are present and only from that table.

(defn- valid-field-order?
  [table field-ordering]
  (= (t2/select-pks-set Field
       :table_id (u/the-id table)
       :active   true)
     (set field-ordering)))

Set field order to field-order.

(defn custom-order-fields!
  [table field-order]
  {:pre [(valid-field-order? table field-order)]}
  (t2/update! Table (u/the-id table) {:field_order :custom})
  (doall
    (map-indexed (fn [position field-id]
                   (t2/update! Field field-id {:position        position
                                               :custom_position position}))
                 field-order)))

--------------------------------------------------- Hydration ----------------------------------------------------

(mi/define-simple-hydration-method fields
  :fields
  "Return the Fields belonging to a single `table`."
  [{:keys [id]}]
  (t2/select Field
    :table_id        id
    :active          true
    :visibility_type [:not= "retired"]
    {:order-by field-order-rule}))
(mi/define-simple-hydration-method ^{:arglists '([table])} field-values
  :field_values
  "Return the FieldValues for all Fields belonging to a single `table`."
  [{:keys [id]}]
  (let [field-ids (t2/select-pks-set Field
                    :table_id        id
                    :visibility_type "normal"
                    {:order-by field-order-rule})]
    (when (seq field-ids)
      (t2/select-fn->fn :field_id :values FieldValues, :field_id [:in field-ids]))))
(mi/define-simple-hydration-method ^{:arglists '([table])} pk-field-id
  :pk_field
  "Return the ID of the primary key `Field` for `table`."
  [{:keys [id]}]
  (t2/select-one-pk Field
    :table_id        id
    :semantic_type   (mdb.u/isa :type/PK)
    :visibility_type [:not-in ["sensitive" "retired"]]))
(defn- with-objects [hydration-key fetch-objects-fn tables]
  (let [table-ids         (set (map :id tables))
        table-id->objects (group-by :table_id (when (seq table-ids)
                                                (fetch-objects-fn table-ids)))]
    (for [table tables]
      (assoc table hydration-key (get table-id->objects (:id table) [])))))
(mi/define-batched-hydration-method with-segments
  :segments
  "Efficiently hydrate the Segments for a collection of `tables`."
  [tables]
  (with-objects :segments
    (fn [table-ids]
      (t2/select :model/Segment :table_id [:in table-ids], :archived false, {:order-by [[:name :asc]]}))
    tables))
(mi/define-batched-hydration-method with-metrics
  :metrics
  "Efficiently hydrate the Metrics for a collection of `tables`."
  [tables]
  (with-objects :metrics
    (fn [table-ids]
      (t2/select :model/Metric :table_id [:in table-ids], :archived false, {:order-by [[:name :asc]]}))
    tables))

Efficiently hydrate the Fields for a collection of tables.

(defn with-fields
  [tables]
  (with-objects :fields
    (fn [table-ids]
      (t2/select Field
        :active          true
        :table_id        [:in table-ids]
        :visibility_type [:not= "retired"]
        {:order-by       field-order-rule}))
    tables))

------------------------------------------------ Convenience Fns -------------------------------------------------

Return the Database associated with this Table.

(defn database
  [table]
  (t2/select-one Database :id (:db_id table)))

Retrieve the Database ID for the given table-id.

(def ^{:arglists '([table-id])} table-id->database-id
  (mdb.connection/memoize-for-application-db
   (fn [table-id]
     {:pre [(integer? table-id)]}
     (t2/select-one-fn :db_id Table, :id table-id))))

------------------------------------------------- Serialization -------------------------------------------------

(defmethod serdes/dependencies "Table" [table]
  [[{:model "Database" :id (:db_id table)}]])
(defmethod serdes/generate-path "Table" [_ table]
  (let [db-name (t2/select-one-fn :name 'Database :id (:db_id table))]
    (filterv some? [{:model "Database" :id db-name}
                    (when (:schema table)
                      {:model "Schema" :id (:schema table)})
                    {:model "Table" :id (:name table)}])))
(defmethod serdes/entity-id "Table" [_ {:keys [name]}]
  name)
(defmethod serdes/load-find-local "Table"
  [path]
  (let [db-name     (-> path first :id)
        schema-name (when (= 3 (count path))
                      (-> path second :id))
        table-name  (-> path last :id)
        db-id       (t2/select-one-pk Database :name db-name)]
    (t2/select-one Table :name table-name :db_id db-id :schema schema-name)))
(defmethod serdes/extract-one "Table"
  [_model-name _opts {:keys [db_id] :as table}]
  (-> (serdes/extract-one-basics "Table" table)
      (assoc :db_id (t2/select-one-fn :name 'Database :id db_id))))
(defmethod serdes/load-xform "Table"
  [{:keys [db_id] :as table}]
  (-> (serdes/load-xform-basics table)
      (assoc :db_id (t2/select-one-fn :id 'Database :name db_id))))
(defmethod serdes/storage-path "Table" [table _ctx]
  (concat (serdes/storage-table-path-prefix (serdes/path table))
          [(:name table)]))

-------------------------------------------------- Audit Log Table -------------------------------------------------

(defmethod audit-log/model-details Table
  [table _event-type]
  (select-keys table [:id :name :db_id]))
 

Each row in the table_privileges table contains the privileges that the current user or role has on a given table.

The table_privileges table just a cache of the data returned from driver/table-privileges, but it's stored in the database so that we can query it more easily.

(ns metabase.models.table-privileges
  (:require
   [methodical.core :as methodical]
   [toucan2.core :as t2]))
(methodical/defmethod t2/table-name :model/TablePrivileges [_model] :table_privileges)
(derive :model/TablePrivileges :metabase/model)
 
(ns metabase.models.task-history
  (:require
   [cheshire.generate :refer [add-encoder encode-map]]
   [java-time.api :as t]
   [metabase.models.interface :as mi]
   [metabase.models.permissions :as perms]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

----------------------------------------------- Entity & Lifecycle -----------------------------------------------

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase.

(def TaskHistory
  :model/TaskHistory)
(methodical/defmethod t2/table-name :model/TaskHistory [_model] :task_history)
(doto :model/TaskHistory
  (derive :metabase/model)
  (derive ::mi/read-policy.full-perms-for-perms-set)
  (derive ::mi/write-policy.full-perms-for-perms-set))

Permissions to read or write Task. If advanced-permissions is enabled it requires superusers or non-admins with monitoring permissions, Otherwise it requires superusers.

(defmethod mi/perms-objects-set TaskHistory
  [_task _read-or-write]
  #{(if (premium-features/enable-advanced-permissions?)
      (perms/application-perms-path :monitoring)
      "/")})

Deletes older TaskHistory rows. Will order TaskHistory by ended_at and delete everything after num-rows-to-keep. This is intended for a quick cleanup of old rows. Returns true if something was deleted.

(defn cleanup-task-history!
  [num-rows-to-keep]
  ;; Ideally this would be one query, but MySQL does not allow nested queries with a limit. The query below orders the
  ;; tasks by the time they finished, newest first. Then finds the first row after skipping `num-rows-to-keep`. Using
  ;; the date that task finished, it deletes everything after that. As we continue to add TaskHistory entries, this
  ;; ensures we'll have a good amount of history for debugging/troubleshooting, but not grow too large and fill the
  ;; disk.
  (when-let [clean-before-date (t2/select-one-fn :ended_at TaskHistory {:limit    1
                                                                        :offset   num-rows-to-keep
                                                                        :order-by [[:ended_at :desc]]})]
    (t2/delete! (t2/table-name TaskHistory) :ended_at [:<= clean-before-date])))
(t2/deftransforms :model/TaskHistory
  {:task_details mi/transform-json})

Return all TaskHistory entries, applying limit and offset if not nil

(mu/defn all
  [limit  :- [:maybe ms/PositiveInt]
   offset :- [:maybe ms/IntGreaterThanOrEqualToZero]]
  (t2/select TaskHistory (merge {:order-by [[:ended_at :desc]]}
                                (when limit
                                  {:limit limit})
                                (when offset
                                  {:offset offset}))))

+----------------------------------------------------------------------------------------------------------------+ | with-task-history macro | +----------------------------------------------------------------------------------------------------------------+

Schema for info passed to the with-task-history macro.

(def ^:private TaskHistoryInfo
  [:map {:closed true}
   [:task                          ms/NonBlankString] ; task name, i.e. `send-pulses`. Conventionally lisp-cased
   [:db_id        {:optional true} [:maybe :int]]     ; DB involved, for sync operations or other tasks where this is applicable.
   [:task_details {:optional true} [:maybe :map]]])   ; additional map of details to include in the recorded row
(defn- save-task-history! [start-time-ms info]
  (let [end-time-ms (System/currentTimeMillis)
        duration-ms (- end-time-ms start-time-ms)]
    (try
      (first (t2/insert-returning-instances! TaskHistory
                                             (assoc info
                                                    :started_at (t/instant start-time-ms)
                                                    :ended_at   (t/instant end-time-ms)
                                                    :duration   duration-ms)))
      (catch Throwable e
        (log/warn e (trs "Error saving task history"))))))

Impl for with-task-history macro; see documentation below.

(mu/defn do-with-task-history
  [info :- TaskHistoryInfo f]
  (let [start-time-ms (System/currentTimeMillis)]
    (try
      (u/prog1 (f)
        (save-task-history! start-time-ms info))
      (catch Throwable e
        (let [info (assoc info :task_details {:status        :failed
                                              :exception     (class e)
                                              :message       (.getMessage e)
                                              :stacktrace    (u/filtered-stacktrace e)
                                              :ex-data       (ex-data e)
                                              :original-info (:task_details info)})]
          (save-task-history! start-time-ms info))
        (throw e)))))

Execute body, recording a TaskHistory entry when the task completes; if it failed to complete, records an entry containing information about the Exception. info should contain at least a name for the task (conventionally lisp-cased) as :task; see the TaskHistoryInfo schema in this namespace for other optional keys.

(with-task-history {:task "send-pulses"} ...)

(defmacro with-task-history
  {:style/indent 1}
  [info & body]
  `(do-with-task-history ~info (fn [] ~@body)))

TaskHistory can contain an exception for logging purposes, so use the built-in serialization of a Throwable->map to make this something that can be JSON encoded.

(add-encoder
 Throwable
 (fn [throwable json-generator]
   (encode-map (Throwable->map throwable) json-generator)))
 
(ns metabase.models.timeline
  (:require
   [java-time.api :as t]
   [metabase.models.collection.root :as collection.root]
   [metabase.models.permissions :as perms]
   [metabase.models.serialization :as serdes]
   [metabase.models.timeline-event :as timeline-event]
   [metabase.util.date-2 :as u.date]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase.

(def Timeline
  :model/Timeline)
(methodical/defmethod t2/table-name :model/Timeline  [_model] :timeline)
(doto :model/Timeline
  (derive :metabase/model)
  (derive ::perms/use-parent-collection-perms)
  (derive :hook/timestamped?)
  (derive :hook/entity-id))

transforms

(t2/define-after-select :model/Timeline
  [timeline]
  ;; We used to have a "balloons" icon but we removed it.
  ;; Use the default icon instead. (metabase#34586, metabase#35129)
  (update timeline :icon (fn [icon]
                           (if (= icon "balloons") timeline-event/default-icon icon))))

functions

Load timelines based on collection-id passed in (nil means the root collection). Hydrates the events on each timeline at :events on the timeline.

(defn timelines-for-collection
  [collection-id {:keys [:timeline/events? :timeline/archived?] :as options}]
  (cond-> (t2/hydrate (t2/select Timeline
                              :collection_id collection-id
                              :archived (boolean archived?))
                   :creator
                   [:collection :can_write])
    (nil? collection-id) (->> (map collection.root/hydrate-root-collection))
    events? (timeline-event/include-events options)))
(defmethod serdes/hash-fields :model/Timeline
  [_timeline]
  [:name (serdes/hydrated-hash :collection) :created_at])

serialization

(defmethod serdes/extract-query "Timeline" [_model-name opts]
  (eduction (map #(timeline-event/include-events-singular % {:all? true}))
            (serdes/extract-query-collections Timeline opts)))
(defn- extract-events [events]
  (sort-by :timestamp
           (for [event events]
             (-> (into (sorted-map) event)
                 (dissoc :creator :id :timeline_id :updated_at)
                 (update :creator_id  serdes/*export-user*)
                 (update :timestamp   #(u.date/format (t/offset-date-time %)))))))
(defmethod serdes/extract-one "Timeline"
  [_model-name _opts timeline]
  (let [timeline (if (contains? timeline :events)
                   timeline
                   (timeline-event/include-events-singular timeline {:all? true}))]
    (-> (serdes/extract-one-basics "Timeline" timeline)
        (update :events        extract-events)
        (update :collection_id serdes/*export-fk* 'Collection)
        (update :creator_id    serdes/*export-user*))))
(defmethod serdes/load-xform "Timeline" [timeline]
  (-> timeline
      serdes/load-xform-basics
      (update :collection_id serdes/*import-fk* 'Collection)
      (update :creator_id    serdes/*import-user*)))
(defmethod serdes/load-one! "Timeline" [ingested maybe-local]
  (let [timeline ((get-method serdes/load-one! :default) (dissoc ingested :events) maybe-local)]
    (doseq [event (:events ingested)]
      (let [local (t2/select-one 'TimelineEvent :timeline_id (:id timeline) :timestamp (u.date/parse (:timestamp event)))
            event (assoc event
                         :timeline_id (:entity_id timeline)
                         :serdes/meta [{:model "Timeline"      :id (:entity_id timeline)}
                                       {:model "TimelineEvent" :id (u.date/format (t/offset-date-time (:timestamp event)))}])]
        (serdes/load-one! event local)))))
(defmethod serdes/dependencies "Timeline" [{:keys [collection_id]}]
  [[{:model "Collection" :id collection_id}]])
 
(ns metabase.models.timeline-event
  (:require
   [metabase.models.interface :as mi]
   [metabase.models.serialization :as serdes]
   [metabase.util.date-2 :as u.date]
   [metabase.util.honey-sql-2 :as h2x]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase.

(def TimelineEvent
  :model/TimelineEvent)
(methodical/defmethod t2/table-name :model/TimelineEvent  [_model] :timeline_event)
(doto TimelineEvent
  (derive :metabase/model)
  (derive :hook/timestamped?)
  (derive ::mi/read-policy.full-perms-for-perms-set)
  (derive ::mi/write-policy.full-perms-for-perms-set))

schemas

The default icon for Timeline and TimelineEvents.

(def default-icon
  "star")

Schema for Timeline and TimelineEvents icon

(def Icon
  [:enum default-icon "cake" "mail" "warning" "bell" "cloud"])

Timeline Event Source Schema. For Snowplow Events, where the Event is created from is important. Events are added from one of three sources: collections, questions (cards in backend code), or directly with an API call. An API call is indicated by having no source key in the timeline-event request.

(def Source
  [:enum "collections" "question"])

transforms

(t2/define-after-select :model/TimelineEvent
  [timeline-event]
  ;; We used to have a "balloons" icon but we removed it.
  ;; Use the default icon instead. (metabase#34586, metabase#35129)
  (update timeline-event :icon (fn [icon]
                                 (if (= icon "balloons") default-icon icon))))

permissions

(defmethod mi/perms-objects-set :model/TimelineEvent
  [event read-or-write]
  (let [timeline (or (:timeline event)
                     (t2/select-one 'Timeline :id (:timeline_id event)))]
    (mi/perms-objects-set timeline read-or-write)))

hydration

(mi/define-simple-hydration-method timeline
  :timeline
  "Attach the parent `:timeline` to this [[TimelineEvent]]."
  [{:keys [timeline_id]}]
  (t2/select-one 'Timeline :id timeline_id))

Fetch events for timelines in timeline-ids. Can include optional start and end dates in the options map, as well as all?. By default, will return only unarchived events, unless all? is truthy and will return all events regardless of archive state.

(defn- fetch-events
  [timeline-ids {:events/keys [all? start end]}]
  (let [clause {:where [:and
                        ;; in our collections
                        [:in :timeline_id timeline-ids]
                        (when-not all?
                          [:= :archived false])
                        (when (or start end)
                          [:or
                           ;; absolute time in bounds
                           [:and
                            [:= :time_matters true]
                            ;; less than or equal?
                            (when start
                              [:<= start :timestamp])
                            (when end
                              [:<= :timestamp end])]
                           ;; non-specic time in bounds
                           [:and
                            [:= :time_matters false]
                            (when start
                              [:<= (h2x/->date start) (h2x/->date :timestamp)])
                            (when end
                              [:<= (h2x/->date :timestamp) (h2x/->date end)])]])]}]
    (t2/hydrate (t2/select TimelineEvent clause) :creator)))

Include events on timelines passed in. Options are optional and include whether to return unarchived events or all events regardless of archive status (all?), and start and end parameters for events.

(defn include-events
  [timelines options]
  (if-not (seq timelines)
    []
    (let [timeline-id->events (->> (fetch-events (map :id timelines) options)
                                   (group-by :timeline_id))]
      (for [{:keys [id] :as timeline} timelines]
        (let [events (timeline-id->events id)]
          (when timeline
            (assoc timeline :events (if events events []))))))))

Similar to [[include-events]] but allows for passing a single timeline not in a collection.

(defn include-events-singular
  ([timeline] (include-events-singular timeline {}))
  ([timeline options]
   (first (include-events [timeline] options))))

model

(defmethod serdes/hash-fields :model/TimelineEvent
  [_timeline-event]
  [:name :timestamp (serdes/hydrated-hash :timeline) :created_at])

serialization TimelineEvents are inlined under their Timelines, but we can reuse the [[load-one!]] logic using [[load-xform]].

(defmethod serdes/load-xform "TimelineEvent" [event]
  (-> event
      serdes/load-xform-basics
      (update :timeline_id serdes/*import-fk* 'Timeline)
      (update :creator_id  serdes/*import-user*)
      (update :timestamp   u.date/parse)
      (update :created_at  #(if (string? %) (u.date/parse %) %))))
 
(ns metabase.models.user
  (:require
   [clojure.data :as data]
   [clojure.string :as str]
   [metabase.api.common :as api]
   [metabase.config :as config]
   [metabase.db.query :as mdb.query]
   [metabase.events :as events]
   [metabase.integrations.common :as integrations.common]
   [metabase.models.audit-log :as audit-log]
   [metabase.models.collection :as collection]
   [metabase.models.interface :as mi]
   [metabase.models.permissions :as perms]
   [metabase.models.permissions-group :as perms-group]
   [metabase.models.permissions-group-membership
    :as perms-group-membership
    :refer [PermissionsGroupMembership]]
   [metabase.models.serialization :as serdes]
   [metabase.models.session :refer [Session]]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings :as public-settings]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.util :as u]
   [metabase.util.i18n :as i18n :refer [deferred-tru trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [metabase.util.password :as u.password]
   [methodical.core :as methodical]
   [toucan2.core :as t2]
   [toucan2.tools.default-fields :as t2.default-fields]))
(set! *warn-on-reflection* true)

----------------------------------------------- Entity & Lifecycle -----------------------------------------------

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], not it's a reference to the toucan2 model name. We'll keep this till we replace all these symbols in our codebase.

(def User
  :model/User)
(methodical/defmethod t2/table-name :model/User [_model] :core_user)
(methodical/defmethod t2/model-for-automagic-hydration [:default :author]     [_original-model _k] :model/User)
(methodical/defmethod t2/model-for-automagic-hydration [:default :creator]    [_original-model _k] :model/User)
(methodical/defmethod t2/model-for-automagic-hydration [:default :updated_by] [_original-model _k] :model/User)
(methodical/defmethod t2/model-for-automagic-hydration [:default :user]       [_original-model _k] :model/User)
(doto :model/User
  (derive :metabase/model)
  (derive :hook/updated-at-timestamped?))
(t2/deftransforms :model/User
  {:login_attributes mi/transform-json-no-keywordization
   :settings         mi/transform-encrypted-json
   :sso_source       mi/transform-keyword
   :type             mi/transform-keyword})
(def ^:private allowed-user-types
  #{:internal :personal :api-key})
(def ^:private insert-default-values
  {:date_joined  :%now
   :last_login   nil
   :is_active    true
   :is_superuser false})

When User :password is specified for an INSERT or UPDATE, add a new :password_salt, and hash the password.

(defn- hashed-password-values
  [{:keys [password], :as user}]
  (when password
    (assert (not (:password_salt user))
            ;; this is dev-facing so it doesn't need to be i18n'ed
            "Don't try to pass an encrypted password to insert! or update!. Password encryption is handled by pre- methods.")
    (let [salt (str (random-uuid))]
      {:password_salt salt
       :password      (u.password/hash-bcrypt (str salt password))})))

Returns the user's settings (defaulting to an empty map) or nil if the user/user-id isn't set

(defn user-local-settings
  [user-or-user-id]
  (when user-or-user-id
    (or
     (if (integer? user-or-user-id)
       (:settings (t2/select-one [User :settings] :id user-or-user-id))
       (:settings user-or-user-id))
     {})))
(t2/define-before-insert :model/User
  [{:keys [email password reset_token locale], :as user}]
  ;; these assertions aren't meant to be user-facing, the API endpoints should be validation these as well.
  (assert (u/email? email))
  (assert ((every-pred string? (complement str/blank?)) password))
  (when-let [user-type (:type user)]
    (assert
     (contains? allowed-user-types user-type)))
  (when locale
    (assert (i18n/available-locale? locale) (tru "Invalid locale: {0}" (pr-str locale))))
  (merge
   insert-default-values
   user
   (hashed-password-values user)
   ;; lower-case the email before saving
   {:email (u/lower-case-en email)}
   ;; if there's a reset token encrypt that as well
   (when reset_token
     {:reset_token (u.password/hash-bcrypt reset_token)})
   ;; normalize the locale
   (when locale
     {:locale (i18n/normalized-locale-string locale)})))
(t2/define-after-insert :model/User
  [{user-id :id, superuser? :is_superuser, :as user}]
  (u/prog1 user
    (let [current-version (:tag config/mb-version-info)]
      (log/info (trs "Setting User {0}''s last_acknowledged_version to {1}, the current version" user-id current-version))
      ;; Can't use mw.session/with-current-user due to circular require
      (binding [api/*current-user-id*       user-id
                setting/*user-local-values* (delay (atom (user-local-settings user)))]
        (setting/set! :last-acknowledged-version current-version)))
    ;; add the newly created user to the magic perms groups.
    (log/info (trs "Adding User {0} to All Users permissions group..." user-id))
    (when superuser?
      (log/info (trs "Adding User {0} to All Users permissions group..." user-id)))
    (let [groups (filter some? [(perms-group/all-users)
                                (when superuser? (perms-group/admin))])]
      (binding [perms-group-membership/*allow-changing-all-users-group-members* true]
        ;; do a 'simple' insert against the Table name so we don't trigger the after-insert behavior
        ;; for [[metabase.models.permissions-group-membership]]... we don't want it recursively trying to update
        ;; the user
        (t2/insert! (t2/table-name :model/PermissionsGroupMembership)
                    (for [group groups]
                      {:user_id  user-id
                       :group_id (u/the-id group)}))))))
(t2/define-before-update :model/User
  [{:keys [id] :as user}]
  ;; when `:is_superuser` is toggled add or remove the user from the 'Admin' group as appropriate
  (let [{reset-token :reset_token
         superuser? :is_superuser
         active? :is_active
         :keys [email locale]}    (t2/changes user)
        in-admin-group?           (t2/exists? PermissionsGroupMembership
                                              :group_id (:id (perms-group/admin))
                                              :user_id  id)]
    ;; Do not let the last admin archive themselves
    (when (and in-admin-group?
               (false? active?))
      (perms-group-membership/throw-if-last-admin!))
    (when (some? superuser?)
      (cond
        (and superuser?
             (not in-admin-group?))
        (t2/insert! (t2/table-name PermissionsGroupMembership)
                    :group_id (u/the-id (perms-group/admin))
                    :user_id  id)
        ;; don't use [[t2/delete!]] here because that does the opposite and tries to update this user which leads to a
        ;; stack overflow of calls between the two. TODO - could we fix this issue by using a `post-delete` method?
        (and (not superuser?)
             in-admin-group?)
        (t2/delete! (t2/table-name PermissionsGroupMembership)
                    :group_id (u/the-id (perms-group/admin))
                    :user_id  id)))
    ;; make sure email and locale are valid if set
    (when email
      (assert (u/email? email)))
    (when locale
      (assert (i18n/available-locale? locale) (tru "Invalid locale: {0}" (pr-str locale))))
    ;; delete all subscriptions to pulses/alerts/etc. if the User is getting archived (`:is_active` status changes)
    (when (false? active?)
      (t2/delete! 'PulseChannelRecipient :user_id id))
    ;; If we're setting the reset_token then encrypt it before it goes into the DB
    (cond-> user
      true        (merge (hashed-password-values (t2/changes user)))
      reset-token (update :reset_token u.password/hash-bcrypt)
      locale      (update :locale i18n/normalized-locale-string)
      email       (update :email u/lower-case-en))))

Conditionally add a :common_name key to user by combining their first and last names, or using their email if names are nil. The key will only be added if user contains the required keys to derive it correctly.

(defn add-common-name
  [{:keys [first_name last_name email], :as user}]
  (let [common-name (if (or first_name last_name)
                      (str/trim (str first_name " " last_name))
                      email)]
    (cond-> user
      (and (contains? user :first_name)
           (contains? user :last_name)
           common-name)
      (assoc :common_name common-name))))
(t2/define-after-select :model/User
  [user]
  (add-common-name user))

Sequence of columns that are normally returned when fetching a User from the DB.

(def ^:private default-user-columns
  [:id :email :date_joined :first_name :last_name :last_login :is_superuser :is_qbnewb])

Sequence of columns that we can/should return for admins fetching a list of all Users, or for the current user fetching themselves. Needed to power the admin page.

(def admin-or-self-visible-columns
  (into default-user-columns [:sso_source :is_active :updated_at :login_attributes :locale]))

Sequence of columns that we will allow non-admin Users to see when fetching a list of Users. Why can non-admins see other Users at all? I honestly would prefer they couldn't, but we need to give them a list of emails to power Pulses.

(def non-admin-or-self-visible-columns
  [:id :email :first_name :last_name])

Sequence of columns Group Managers can see when fetching a list of Users..

(def group-manager-visible-columns
  (into non-admin-or-self-visible-columns [:is_superuser :last_login]))
(t2.default-fields/define-default-fields :model/User default-user-columns)
(defmethod serdes/hash-fields User
  [_user]
  [:email])

Fetch set of IDs of PermissionsGroup a User belongs to.

(defn group-ids
  [user-or-id]
  (when user-or-id
    (t2/select-fn-set :group_id PermissionsGroupMembership :user_id (u/the-id user-or-id))))

Group Membership info of a User. In which :isgroupmanager is only included if advanced-permissions is enabled.

(def UserGroupMembership
  [:map
   [:id ms/PositiveInt]
   ;; is_group_manager only included if `advanced-permissions` is enabled
   [:is_group_manager {:optional true} :boolean]])

-------------------------------------------------- Permissions ---------------------------------------------------

Return a set of all permissions object paths that user-or-id has been granted access to. (2 DB Calls)

(defn permissions-set
  [user-or-id]
  (set (when-let [user-id (u/the-id user-or-id)]
         (concat
          ;; Current User always gets readwrite perms for their Personal Collection and for its descendants! (1 DB Call)
          (map perms/collection-readwrite-path (collection/user->personal-collection-and-descendant-ids user-or-id))
          ;; include the other Perms entries for any Group this User is in (1 DB Call)
          (map :object (mdb.query/query {:select [:p.object]
                                         :from   [[:permissions_group_membership :pgm]]
                                         :join   [[:permissions_group :pg] [:= :pgm.group_id :pg.id]
                                                  [:permissions :p]        [:= :p.group_id :pg.id]]
                                         :where  [:= :pgm.user_id user-id]}))))))

--------------------------------------------------- Hydration ----------------------------------------------------

(mi/define-batched-hydration-method add-user-group-memberships
  :user_group_memberships
  "Add to each `user` a list of Group Memberships Info with each item is a map with 2 keys [:id :is_group_manager].
  In which `is_group_manager` is only added when `advanced-permissions` is enabled."
  [users]
  (when (seq users)
    (let [user-id->memberships (group-by :user_id (t2/select [PermissionsGroupMembership :user_id [:group_id :id] :is_group_manager]
                                                             :user_id [:in (set (map u/the-id users))]))
          membership->group    (fn [membership]
                                 (select-keys membership
                                              [:id (when (premium-features/enable-advanced-permissions?)
                                                     :is_group_manager)]))]
      (for [user users]
        (assoc user :user_group_memberships (map membership->group (user-id->memberships (u/the-id user))))))))
(mi/define-batched-hydration-method add-group-ids
  :group_ids
  "Efficiently add PermissionsGroup `group_ids` to a collection of `users`.
  TODO: deprecate :group_ids and use :user_group_memberships instead"
  [users]
  (when (seq users)
    (let [user-id->memberships (group-by :user_id (t2/select [PermissionsGroupMembership :user_id :group_id]
                                                    :user_id [:in (set (map u/the-id users))]))]
      (for [user users]
        (assoc user :group_ids (set (map :group_id (user-id->memberships (u/the-id user)))))))))
(mi/define-batched-hydration-method add-has-invited-second-user
  :has_invited_second_user
  "Adds the `has_invited_second_user` flag to a collection of `users`. This should be `true` for only the user who
  underwent the initial app setup flow (with an ID of 1), iff more than one user exists. This is used to modify
  the wording for this user on a homepage banner that prompts them to add their database."
  [users]
  (when (seq users)
    (let [user-count (t2/count User)]
      (for [user users]
        (assoc user :has_invited_second_user (and (= (:id user) 1)
                                                  (> user-count 1)))))))
(mi/define-batched-hydration-method add-is-installer
  :is_installer
  "Adds the `is_installer` flag to a collection of `users`. This should be `true` for only the user who
  underwent the initial app setup flow (with an ID of 1). This is used to modify the experience of the
  starting page for users."
  [users]
  (when (seq users)
    (for [user users]
      (assoc user :is_installer (= (:id user) 1)))))

--------------------------------------------------- Helper Fns ---------------------------------------------------

(declare form-password-reset-url set-password-reset-token!)
(defn- send-welcome-email! [new-user invitor sent-from-setup?]
  (let [reset-token               (set-password-reset-token! (u/the-id new-user))
        should-link-to-login-page (and (public-settings/sso-enabled?)
                                       (not (public-settings/enable-password-login)))
        join-url                  (if should-link-to-login-page
                                    (str (public-settings/site-url) "/auth/login")
                                    ;; NOTE: the new user join url is just a password reset with an indicator that this is a first time user
                                    (str (form-password-reset-url reset-token) "#new"))]
    (classloader/require 'metabase.email.messages)
    ((resolve 'metabase.email.messages/send-new-user-email!) new-user invitor join-url sent-from-setup?)))

Login attributes, currently not collected for LDAP or Google Auth. Will ultimately be stored as JSON.

(def LoginAttributes
  (mu/with-api-error-message
    [:map-of ms/KeywordOrString :any]
    (deferred-tru "login attribute keys must be a keyword or string")))

Required/optionals parameters needed to create a new user (for any backend)

(def NewUser
  [:map
   [:first_name       {:optional true} [:maybe ms/NonBlankString]]
   [:last_name        {:optional true} [:maybe ms/NonBlankString]]
   [:email                             ms/Email]
   [:password         {:optional true} [:maybe ms/NonBlankString]]
   [:login_attributes {:optional true} [:maybe LoginAttributes]]
   [:sso_source       {:optional true} [:maybe ms/NonBlankString]]
   [:type             {:optional true} [:maybe ms/KeywordOrString]]])

Map with info about the admin creating the user, used in the new user notification code

(def ^:private Invitor
  [:map
   [:email      ms/Email]
   [:first_name [:maybe ms/NonBlankString]]])

Creates a new user, defaulting the password when not provided

(mu/defn ^:private insert-new-user!
  [new-user :- NewUser]
  (first (t2/insert-returning-instances! User (update new-user :password #(or % (str (random-uuid)))))))

Creates a new user with a default password, when deserializing eg. a :creator_id field whose email address doesn't match any existing user.

(defn serdes-synthesize-user!
  [new-user]
  (insert-new-user! new-user))

Convenience function for inviting a new User and sending out the welcome email.

(mu/defn create-and-invite-user!
  [new-user :- NewUser invitor :- Invitor setup? :- :boolean]
  ;; create the new user
  (u/prog1 (insert-new-user! new-user)
    (events/publish-event! :event/user-invited
                           {:object
                            (assoc <>
                                   :invite_method "email"
                                   :sso_source (:sso_source new-user))})
    (send-welcome-email! <> invitor setup?)))

Convenience for creating a new user via Google Auth. This account is considered active immediately; thus all active admins will receive an email right away.

(mu/defn create-new-google-auth-user!
  [new-user :- NewUser]
  (u/prog1 (insert-new-user! (assoc new-user :sso_source "google"))
    ;; send an email to everyone including the site admin if that's set
    (when (integrations.common/send-new-sso-user-admin-email?)
      (classloader/require 'metabase.email.messages)
      ((resolve 'metabase.email.messages/send-user-joined-admin-notification-email!) <>, :google-auth? true))))

Convenience for creating a new user via LDAP. This account is considered active immediately; thus all active admins will receive an email right away.

(mu/defn create-new-ldap-auth-user!
  [new-user :- NewUser]
  (insert-new-user!
   (-> new-user
       ;; We should not store LDAP passwords
       (dissoc :password)
       (assoc :sso_source "ldap"))))

Update the stored password for a specified User; kill any existing Sessions and wipe any password reset tokens.

The password is automatically hashed with a random salt; this happens in [[hashed-password-values]] which is called by [[pre-insert]] or [[pre-update]])

TODO -- it seems like maybe this should just be part of the [[pre-update]] logic whenever :password changes; then we can remove this function altogether.

(defn set-password!
  [user-id password]
  ;; when changing/resetting the password, kill any existing sessions
  (t2/delete! (t2/table-name Session) :user_id user-id)
  ;; NOTE: any password change expires the password reset token
  (t2/update! User user-id
              {:password        password
               :reset_token     nil
               :reset_triggered nil}))

Updates a given User and generates a password reset token for them to use. Returns the URL for password reset.

(defn set-password-reset-token!
  [user-id]
  {:pre [(integer? user-id)]}
  (u/prog1 (str user-id \_ (random-uuid))
    (t2/update! User user-id
                {:reset_token     <>
                 :reset_triggered (System/currentTimeMillis)})))

Generate a properly formed password reset url given a password reset token.

(defn form-password-reset-url
  [reset-token]
  {:pre [(string? reset-token)]}
  (str (public-settings/site-url) "/auth/reset_password/" reset-token))

Set the user's group memberships to equal the supplied group IDs. Returns true if updates were made, nil otherwise.

(defn set-permissions-groups!
  [user-or-id new-groups-or-ids]
  (let [user-id            (u/the-id user-or-id)
        old-group-ids      (group-ids user-id)
        new-group-ids      (set (map u/the-id new-groups-or-ids))
        [to-remove to-add] (data/diff old-group-ids new-group-ids)]
    (when (seq (concat to-remove to-add))
      (t2/with-transaction [_conn]
       (when (seq to-remove)
         (t2/delete! PermissionsGroupMembership :user_id user-id, :group_id [:in to-remove]))
       ;; a little inefficient, but we need to do a separate `insert!` for each group we're adding membership to,
       ;; because `insert-many!` does not currently trigger methods such as `pre-insert`. We rely on those methods to
       ;; do things like automatically set the `is_superuser` flag for a User
       ;; TODO use multipel insert here
       (doseq [group-id to-add]
         (t2/insert! PermissionsGroupMembership {:user_id user-id, :group_id group-id}))))
    true))

---------------------------------------- USER SETTINGS ----------------------------------------

NB: Settings are also defined where they're used, such as in metabase.events.view-log

(defsetting last-acknowledged-version
  (deferred-tru "The last version for which a user dismissed the 'What's new?' modal.")
  :user-local :only
  :type :string)

------------------------------------------ AUDIT LOG ------------------------------------------

(defmethod audit-log/model-details :model/User
  [entity event-type]
  (case event-type
    :user-update               (select-keys (t2/hydrate entity :user_group_memberships)
                                            [:groups :first_name :last_name :email
                                             :invite_method :sso_source
                                             :user_group_memberships])
    :user-invited              (select-keys (t2/hydrate entity :user_group_memberships)
                                            [:groups :first_name :last_name :email
                                             :invite_method :sso_source
                                             :user_group_memberships])
    :password-reset-initiated  (select-keys entity [:token])
    :password-reset-successful (select-keys entity [:token])
    {}))
 

The ViewLog is used to log an event where a given User views a given object such as a Table or Card (Question).

(ns metabase.models.view-log
  (:require
   [metabase.models.interface :as mi]
   [methodical.core :as m]
   [toucan2.core :as t2]))

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase.

(def ViewLog
  :model/ViewLog)
(m/defmethod t2/table-name :model/ViewLog [_model] :view_log)
(doto ViewLog
  (derive :metabase/model)
  (derive ::mi/read-policy.always-allow)
  (derive ::mi/write-policy.always-allow))
(t2/define-before-insert :model/ViewLog
  [log-entry]
  (let [defaults {:timestamp :%now}]
    (merge defaults log-entry)))
(t2/deftransforms :model/ViewLog
  {:metadata mi/transform-json})
 
(ns metabase.moderation
  (:require
   [medley.core :as m]
   [metabase.models.interface :as mi]
   [metabase.util :as u]
   [toucan2.core :as t2]))

Schema enum of the acceptable values for the moderated_item_type column

(def moderated-item-types
  [:enum "card" :card])

Maps DB name of the moderated item type to the model symbol (used for t2/select and such)

(def moderated-item-type->model
  {"card" 'Card
   :card  'Card})

Convert a moderated item instance to the keyword stored in the database

(defn- object->type
  [instance]
  (u/lower-case-en (name (t2/model instance))))
(mi/define-batched-hydration-method moderation-reviews-for-items
  :moderation_reviews
  "Hydrate moderation reviews onto a seq of items. All are cards or the nils that end up here on text dashboard
  cards. In the future could have dashboards here as well."
  [items]
  ;; no need to do work on empty items. Also, can have nil here due to text cards. I think this is a bug in toucan. To
  ;; get here we are `(t2/hydrate dashboard [:dashcards [:card :moderation_reviews] :series] ...)` But dashcards
  ;; dont have to have cards. but the hydration will pass the nil card id into here.  NOTE: it is important that each
  ;; item that comes into this comes out. The nested hydration is positional, not by an id so everything that comes in
  ;; must go out in the same order
  (when (seq items)
    (let [item-ids    (not-empty (keep :id items))
          all-reviews (when item-ids
                        (group-by (juxt :moderated_item_type :moderated_item_id)
                                  (t2/select 'ModerationReview
                                             :moderated_item_type "card"
                                             :moderated_item_id [:in item-ids]
                                             {:order-by [[:id :desc]]})))]
      (for [item items]
        (if (nil? item)
          nil
          (let [k ((juxt (comp keyword object->type) u/the-id) item)]
            (assoc item :moderation_reviews (get all-reviews k ()))))))))
(mi/define-batched-hydration-method moderation-user-details
  :moderator_details
  "User details on moderation reviews"
  [moderation-reviews]
  (when (seq moderation-reviews)
    (let [id->user (m/index-by :id
                               (t2/select 'User :id [:in (map :moderator_id moderation-reviews)]))]
      (for [mr moderation-reviews]
        (assoc mr :user (get id->user (:moderator_id mr)))))))
(mi/define-simple-hydration-method moderated-item
  :moderated_item
  "The moderated item for a given request or review"
  [{:keys [moderated_item_id moderated_item_type]}]
  (when (and moderated_item_type moderated_item_id)
    (t2/select-one (moderated-item-type->model moderated_item_type) :id moderated_item_id)))
 

Utilities for working with permissions, particularly the permission paths which are stored in the DB. These should typically not be used outside of permissions-related namespaces such as metabase.models.permissions.

(ns metabase.permissions.util
  (:require
   [clojure.string :as str]
   [malli.core :as mc]
   [metabase.util.malli :as mu]
   [metabase.util.regex :as u.regex]))

+----------------------------------------------------------------------------------------------------------------+ | PATH CLASSIFICATION + VALIDATION | +----------------------------------------------------------------------------------------------------------------+

Regex for a valid character for a name that appears in a permissions path (e.g. a schema name or a Collection name). Character is valid if it is either: 1. Any character other than a slash 2. A forward slash, escaped by a backslash: \/ 3. A backslash escaped by a backslash: \\

(def path-char-rx
  "Regex for a valid character for a name that appears in a permissions path (e.g. a schema name or a Collection name).
  Character is valid if it is either:
    1. Any character other than a slash
    2. A forward slash, escaped by a backslash: `\\/`
    3. A backslash escaped by a backslash: `\\\\`"
  (u.regex/rx [:or #"[^\\/]" #"\\/" #"\\\\"]))
(def ^:private data-rx->data-kind
  {      #"db/\d+/"                                                                     :dk/db
   [:and #"db/\d+/" "native" "/"]                                                       :dk/db-native
   [:and #"db/\d+/" "schema" "/"]                                                       :dk/db-schema
   [:and #"db/\d+/" "schema" "/" path-char-rx "*" "/"]                                  :dk/db-schema-name
   [:and #"db/\d+/" "schema" "/" path-char-rx "*" "/table/\\d+/"]                       :dk/db-schema-name-and-table
   [:and #"db/\d+/" "schema" "/" path-char-rx "*" "/table/\\d+/" "read/"]               :dk/db-schema-name-table-and-read
   [:and #"db/\d+/" "schema" "/" path-char-rx "*" "/table/\\d+/" "query/"]              :dk/db-schema-name-table-and-query
   [:and #"db/\d+/" "schema" "/" path-char-rx "*" "/table/\\d+/" "query/" "segmented/"] :dk/db-schema-name-table-and-segmented})
(def ^:private DataKind (into [:enum] (vals data-rx->data-kind)))

*-permissions-rx

The *-permissions-rx do not have anchors, since they get combined (and anchors placed around them) below. Take care to use anchors where they make sense.

Paths starting with /db/ is a DATA ACCESS permissions path

Paths that do not start with /db/ (e.g. /download/db/...) do not involve granting data access, and are not data-permissions. They are other kinds of paths, for example: see [[download-permissions-rx]].

(def v1-data-permissions-rx
  (into [:or] (keys data-rx->data-kind)))
(def ^:private v2-data-permissions-rx [:and "data/" v1-data-permissions-rx])
(def ^:private v2-query-permissions-rx [:and "query/" v1-data-permissions-rx])

Any path starting with /download/ is a DOWNLOAD permissions path /download/db/:id/ -> permissions to download 1M rows in query results /download/limited/db/:id/ -> permissions to download 1k rows in query results

(def ^:private download-permissions-rx
  [:and "download/" [:? "limited/"]
   [:and #"db/\d+/"
    [:? [:or "native/"
         [:and "schema/"
          [:? [:and path-char-rx "*/"
               [:? #"table/\d+/"]]]]]]]])

Any path starting with /data-model/ is a DATA MODEL permissions path /download/db/:id/ -> permissions to access the data model for the DB

(def ^:private data-model-permissions-rx
  [:and "data-model/"
   [:and #"db/\d+/"
    [:? [:and "schema/"
         [:? [:and path-char-rx "*/"
              [:? #"table/\d+/"]]]]]]])

any path starting with /details/ is a DATABASE CONNECTION DETAILS permissions path /details/db/:id/ -> permissions to edit the connection details and settings for the DB

(def ^:private db-conn-details-permissions-rx
  [:and "details/" #"db/\d+/"])

.../execute/ -> permissions to run query actions in the DB

(def ^:private execute-permissions-rx
  [:and "execute/" [:or "" #"db/\d+/"]])
(def ^:private collection-permissions-rx
  [:and "collection/"
   [:or ;; /collection/:id/ -> readwrite perms for a specific Collection
    [:and #"\d+/"
     ;; /collection/:id/read/ -> read perms for a specific Collection
     [:? "read/"]]
    ;; /collection/root/ -> readwrite perms for the Root Collection
    [:and "root/"
     ;; /collection/root/read/ -> read perms for the Root Collection
     [:? "read/"]]
    ;; /collection/namespace/:namespace/root/ -> readwrite perms for 'Root' Collection in non-default
    ;; namespace (only really used for EE)
    [:and "namespace/" path-char-rx "+/root/"
     ;; /collection/namespace/:namespace/root/read/ -> read perms for 'Root' Collection in
     ;; non-default namespace
     [:? "read/"]]]])

Any path starting with /application is a permissions that is not scoped by database or collection /application/setting/ -> permissions to access /admin/settings page /application/monitoring/ -> permissions to access tools, audit and troubleshooting /application/subscription/ -> permisisons to create/edit subscriptions and alerts

(def ^:private non-scoped-permissions-rx
  [:and "application/"
   [:or "setting/" "monitoring/" "subscription/"]])

Any path starting with /block/ is for BLOCK aka anti-permissions. currently only supported at the DB level. e.g. /block/db/1/ => block collection-based access to Database 1

(def ^:private block-permissions-rx
  #"block/db/\d+/")

Root Permissions, i.e. for admin

(def ^:private admin-permissions-rx  "")

Regex for a valid permissions path. The [[metabase.util.regex/rx]] macro is used to make the big-and-hairy regex somewhat readable.

(def path-regex-v1
  (u.regex/rx
   "^/" [:or
         v1-data-permissions-rx
         download-permissions-rx
         data-model-permissions-rx
         db-conn-details-permissions-rx
         execute-permissions-rx
         collection-permissions-rx
         non-scoped-permissions-rx
         block-permissions-rx
         admin-permissions-rx]
   "$"))
(def ^:private rx->kind
  [[(u.regex/rx "^/" v1-data-permissions-rx "$")         :data]
   [(u.regex/rx "^/" v2-data-permissions-rx "$")         :data-v2]
   [(u.regex/rx "^/" v2-query-permissions-rx "$")        :query-v2]
   [(u.regex/rx "^/" download-permissions-rx "$")        :download]
   [(u.regex/rx "^/" data-model-permissions-rx "$")      :data-model]
   [(u.regex/rx "^/" db-conn-details-permissions-rx "$") :db-conn-details]
   [(u.regex/rx "^/" execute-permissions-rx "$")         :execute]
   [(u.regex/rx "^/" collection-permissions-rx "$")      :collection]
   [(u.regex/rx "^/" non-scoped-permissions-rx "$")      :non-scoped]
   [(u.regex/rx "^/" block-permissions-rx "$")           :block]
   [(u.regex/rx "^/" admin-permissions-rx "$")           :admin]])

Regex for a valid permissions path. built with [[metabase.util.regex/rx]] to make the big-and-hairy regex somewhat readable. Will not match: - a v1 data path like "/db/1" or "/db/1/" - a block path like "block/db/2/"

(def path-regex-v2
  (u.regex/rx
   "^/" [:or
         v2-data-permissions-rx
         v2-query-permissions-rx
         download-permissions-rx
         data-model-permissions-rx
         db-conn-details-permissions-rx
         execute-permissions-rx
         collection-permissions-rx
         non-scoped-permissions-rx
         admin-permissions-rx]
   "$"))

A permission path.

(def Path 
  [:or {:title "Path"} [:re path-regex-v1] [:re path-regex-v2]])
(def ^:private Kind
  (into [:enum {:title "Kind"}] (map second rx->kind)))
(mu/defn classify-path :- Kind
  "Classifies a permission [[metabase.models.permissions/Path]] into a [[metabase.models.permissions/Kind]], or throws."
  [path :- Path]
  (let [result (keep (fn [[permission-rx kind]]
                       (when (re-matches (u.regex/rx permission-rx) path) kind))
                     rx->kind)]
    (when-not (= 1 (count result))
      (throw (ex-info (str "Unclassifiable path! " (pr-str {:path path :result result}))
                      {:path path :result result})))
    (first result)))

A permissions path that's guaranteed to be a v1 data-permissions path

(def DataPath 
  [:re (u.regex/rx "^/" v1-data-permissions-rx "$")])
(mu/defn classify-data-path :- DataKind
  "Classifies data path permissions [[metabase.models.permissions/DataPath]] into a [[metabase.models.permissions/DataKind]]"
  [data-path :- DataPath]
  (let [result (keep (fn [[data-rx kind]]
                       (when (re-matches (u.regex/rx [:and "^/" data-rx]) data-path) kind))
                     data-rx->data-kind)]
    (when-not (= 1 (count result))
      (throw (ex-info "Unclassified data path!!" {:data-path data-path :result result})))
    (first result)))

Is path a valid, known permissions path?

(let [path-validator (mc/validator Path)]
  (defn valid-path?
    ^Boolean [^String path]
    (path-validator path)))

Schema for a permissions path with a valid format.

(def PathSchema
  [:re
   {:error/message "Valid permissions path"}
   (re-pattern (str "^/(" path-char-rx "*/)*$"))])

Is path a string with a valid permissions path format? This is a less strict version of [[valid-path?]] which just checks that the path components contain alphanumeric characters or dashes, separated by slashes This should be used for schema validation in most places, to preserve downgradability when new permissions paths are added.

(let [path-format-validator (mc/validator PathSchema)]
  (defn valid-path-format?
    ^Boolean [^String path]
    (path-format-validator path)))

+----------------------------------------------------------------------------------------------------------------+ | PATH UTILS | +----------------------------------------------------------------------------------------------------------------+

Escape slashes in something that might be passed as a string part of a permissions path (e.g. DB schema name or Collection name).

(escape-path-component "a/b") ;-> "a\/b"

(defn escape-path-component
  "Escape slashes in something that might be passed as a string part of a permissions path (e.g. DB schema name or
  Collection name).
    (escape-path-component \"a/b\") ;-> \"a\\/b\""
  [s]
  (some-> s
          (str/replace #"\\" "\\\\\\\\")   ; \ -> \\
          (str/replace #"/" "\\\\/"))) ; / -> \/

lookup table to generate v2 query + data permission from a v1 data permission.

(letfn [(delete [s to-delete] (str/replace s to-delete ""))
        (data-query-split [path] [(str "/data" path) (str "/query" path)])]
  (def ^:private data-kind->rewrite-fn
    {:dk/db                                 data-query-split
     :dk/db-native                          (fn [path] (data-query-split (delete path "native/")))
     :dk/db-schema                          (fn [path] [(str "/data" (delete path "schema/")) (str "/query" path)])
     :dk/db-schema-name                     data-query-split
     :dk/db-schema-name-and-table           data-query-split
     :dk/db-schema-name-table-and-read      (constantly [])
     :dk/db-schema-name-table-and-query     (fn [path] (data-query-split (delete path "query/")))
     :dk/db-schema-name-table-and-segmented (fn [path] (data-query-split (delete path "query/segmented/")))}))
(mu/defn ->v2-path :- [:vector [:re path-regex-v2]]
  "Takes either a v1 or v2 path, and translates it into one or more v2 paths."
  [path :- [:or [:re path-regex-v1] [:re path-regex-v2]]]
  (let [kind (classify-path path)]
    (case kind
      :data (let [data-permission-kind (classify-data-path path)
                  rewrite-fn (data-kind->rewrite-fn data-permission-kind)]
              (rewrite-fn path))
      :admin ["/"]
      :block []
      ;; for sake of idempotency, v2 perm-paths should be unchanged.
      (:data-v2 :query-v2) [path]
      ;; other paths should be unchanged too.
      [path])))
 
(ns metabase.plugins
  (:require
   [clojure.core.memoize :as memoize]
   [clojure.java.classpath :as classpath]
   [clojure.java.io :as io]
   [clojure.string :as str]
   [environ.core :as env]
   [metabase.config :as config]
   [metabase.plugins.classloader :as classloader]
   [metabase.plugins.initialize :as plugins.init]
   [metabase.util.files :as u.files]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [metabase.util.yaml :as yaml])
  (:import
   (java.io File)
   (java.nio.file Files Path)))
(set! *warn-on-reflection* true)
(defn- plugins-dir-filename ^String []
  (or (env/env :mb-plugins-dir)
      (.getAbsolutePath (io/file "plugins"))))
(def ^:private plugins-dir*
  ;; Memoized so we don't log the error messages multiple times if the plugins directory doesn't change
  (memoize/memo
   (fn [filename]
     (try
       ;; attempt to create <current-dir>/plugins if it doesn't already exist. Check that the directory is readable.
       (let [path (u.files/get-path filename)]
         (u.files/create-dir-if-not-exists! path)
         (assert (Files/isWritable path)
           (trs "Metabase does not have permissions to write to plugins directory {0}" filename))
         {:path  path, :temp false})
       ;; If we couldn't create the directory, or the directory is not writable, fall back to a temporary directory
       ;; rather than failing to launch entirely. Log instructions for what should be done to fix the problem.
       (catch Throwable e
         (log/warn
          e
          (trs "Metabase cannot use the plugins directory {0}" filename)
          "\n"
          (trs "Please make sure the directory exists and that Metabase has permission to write to it.")
          (trs "You can change the directory Metabase uses for modules by setting the environment variable MB_PLUGINS_DIR.")
          (trs "Falling back to a temporary directory for now."))
         ;; Check whether the fallback temporary directory is writable. If it's not, there's no way for us to
         ;; gracefully proceed here. Throw an Exception detailing the critical issues.
         (let [path (u.files/get-path (System/getProperty "java.io.tmpdir"))]
           (assert (Files/isWritable path)
             (trs "Metabase cannot write to temporary directory. Please set MB_PLUGINS_DIR to a writable directory and restart Metabase."))
           {:path path, :temp true}))))))

Map with a :path key containing the Path to the Metabase plugins directory, and a :temp key indicating whether a temporary directory was used.

(defn plugins-dir-info
  ^Path []
  (plugins-dir* (plugins-dir-filename)))

Get a Path to the Metabase plugins directory, creating it if needed. If it cannot be created for one reason or another, or if we do not have write permissions for it, use a temporary directory instead.

This is a wrapper around plugins-dir-info which also contains a :temp key indicating whether a temporary directory was used.

(defn plugins-dir
  []
  (:path (plugins-dir-info)))
(defn- extract-system-modules! []
  (when (io/resource "modules")
    (let [plugins-path (plugins-dir)]
      (u.files/with-open-path-to-resource [modules-path "modules"]
        (u.files/copy-files! modules-path plugins-path)))))

+----------------------------------------------------------------------------------------------------------------+ | loading/initializing plugins | +----------------------------------------------------------------------------------------------------------------+

(defn- add-to-classpath! [^Path jar-path]
  (classloader/add-url-to-classpath! (-> jar-path .toUri .toURL)))
(defn- plugin-info [^Path jar-path]
  (some-> (u.files/slurp-file-from-archive jar-path "metabase-plugin.yaml")
          yaml/parse-string))

Initiaize plugin using parsed info from a plugin maifest. Returns truthy if plugin was successfully initialized; falsey otherwise.

(defn- init-plugin-with-info!
  [info]
  (plugins.init/init-plugin-with-info! info))

Init plugin JAR file; returns truthy if plugin initialization was successful.

(defn- init-plugin!
  [^Path jar-path]
  (if-let [info (plugin-info jar-path)]
    ;; for plugins that include a metabase-plugin.yaml manifest run the normal init steps, don't add to classpath yet
    (init-plugin-with-info! (assoc info :add-to-classpath! #(add-to-classpath! jar-path)))
    ;; for all other JARs just add to classpath and call it a day
    (add-to-classpath! jar-path)))

+----------------------------------------------------------------------------------------------------------------+ | load-plugins! | +----------------------------------------------------------------------------------------------------------------+

(defn- plugins-paths []
  (for [^Path path (u.files/files-seq (plugins-dir))
        :when      (and (u.files/regular-file? path)
                        (u.files/readable? path)
                        (str/ends-with? (.getFileName path) ".jar")
                        (or (not (str/ends-with? (.getFileName path) "spark-deps.jar"))
                            ;; if the JAR in question is the spark deps JAR we cannot load it because it's signed, and
                            ;; the Metabase JAR itself as well as plugins no longer are; Java will throw an Exception
                            ;; if different JARs with `metabase` packages have different signing keys. Go ahead and
                            ;; ignore it but let people know they can get rid of it.
                            (log/warn
                             (trs "spark-deps.jar is no longer needed by Metabase 0.32.0+. You can delete it from the plugins directory."))))]
    path))

Return a sequence of [[java.io.File]] paths for metabase-plugin.yaml plugin manifests for drivers on the classpath.Load local plugin manifest files when running in dev or test mode, to simulate what would happen when loading those same plugins from the uberjar. This is needed because some plugin manifests define driver methods and the like that aren't defined elsewhere.

(when (or config/is-dev? config/is-test?)
  (defn- load-local-plugin-manifest! [^Path path]
    (some-> (slurp (str path)) yaml/parse-string plugins.init/init-plugin-with-info!))
  (defn- driver-manifest-paths
    []
    ;; only include plugin manifests if they're on the system classpath.
    (concat
     (for [^File file (classpath/system-classpath)
           :when      (and (.isDirectory file)
                           (not (.isHidden file))
                           (str/includes? (str file) "modules/drivers")
                           (or (str/ends-with? (str file) "resources")
                               (str/ends-with? (str file) "resources-ee")))
           :let       [manifest-file (io/file file "metabase-plugin.yaml")]
           :when      (.exists manifest-file)]
       manifest-file)
     ;; for hacking on 3rd-party drivers locally: set
     ;; `-Dmb.dev.additional.driver.manifest.paths=/path/to/whatever/metabase-plugin.yaml` or
     ;; `MB_DEV_ADDITIONAL_DRIVER_MANIFEST_PATHS=...` to have that plugin manifest get loaded during startup. Specify
     ;; multiple plugin manifests by comma-separating them.
     (when-let [additional-paths (env/env :mb-dev-additional-driver-manifest-paths)]
       (map u.files/get-path (str/split additional-paths #",")))))
  (defn- load-local-plugin-manifests!
    []
    ;; TODO - this should probably do an actual search in case we ever add any additional directories
    (doseq [manifest-path (driver-manifest-paths)]
      (log/info (trs "Loading local plugin manifest at {0}" (str manifest-path)))
      (load-local-plugin-manifest! manifest-path))))
(defn- has-manifest? ^Boolean [^Path path]
  (boolean (u.files/file-exists-in-archive? path "metabase-plugin.yaml")))
(defn- init-plugins! [paths]
  ;; sort paths so that ones that correspond to JARs with no plugin manifest (e.g. a dependency like the Oracle JDBC
  ;; driver `ojdbc8.jar`) always get initialized (i.e., added to the classpath) first; that way, Metabase drivers that
  ;; depend on them (such as Oracle) can be initialized the first time we see them.
  ;;
  ;; In Clojure world at least `false` < `true` so we can use `sort-by` to get non-Metabase-plugin JARs in front
  (doseq [^Path path (sort-by has-manifest? paths)]
    (try
      (init-plugin! path)
      (catch Throwable e
        (log/error e (trs "Failied to initialize plugin {0}" (.getFileName path)))))))
(defn- load! []
  (log/info (trs "Loading plugins in {0}..." (str (plugins-dir))))
  (extract-system-modules!)
  (let [paths (plugins-paths)]
    (init-plugins! paths))
  (when (or config/is-dev? config/is-test?)
    (load-local-plugin-manifests!)))
(defonce ^:private loaded? (atom false))

Load Metabase plugins. The are JARs shipped as part of Metabase itself, under the resources/modules directory (the source for these JARs is under the modules directory); and others manually added by users to the Metabase plugins directory, which defaults to ./plugins.

When loading plugins, Metabase performs the following steps:

  • Metabase creates the plugins directory if it does not already exist.
  • Any plugins that are shipped as part of Metabase itself are extracted from the Metabase uberjar (or resources directory when running with the Clojure CLI) into the plugins directory.
  • Each JAR in the plugins directory that does not include a Metabase plugin manifest is added to the classpath.
  • For JARs that include a Metabase plugin manifest (a metabase-plugin.yaml file), a lazy-loading Metabase driver is registered; when the driver is initialized (automatically, when certain methods are called) the JAR is added to the classpath and the driver namespace is loaded

This function will only perform loading steps the first time it is called — it is safe to call this function more than once.

(defn load-plugins!
  []
  (when-not @loaded?
    (locking loaded?
      (when-not @loaded?
        (load!)
        (reset! loaded? true)))))
 

Logic for getting and setting the context classloader we'll use for loading Metabase plugins. Use the-classloader to get the Classloader you should use with calls to Class/forName; call it for side effects to ensure the current thread context classloader will have access to JARs we add at runtime before calling require.

The classloader is guaranteed to be an instance of DynamicClassLoader, which means we can add URLs to it at runtime with dynapath; use add-url-to-classpath! to add URLs to the classpath to make sure they are added to the correct classloader.

If you are unfamiliar with ClassLoaders in general, I found this article pretty helpful: https://www.javaworld.com/article/2077344/core-java/find-a-way-out-of-the-classloader-maze.html.

<3 Cam

(ns metabase.plugins.classloader
  (:refer-clojure :exclude [require])
  (:require
   [clojure.string :as str]
   [dynapath.util :as dynapath]
   [metabase.util.log :as log])
  (:import
   (clojure.lang DynamicClassLoader RT)
   (java.net URL)))
(set! *warn-on-reflection* true)

The context classloader we'll use for all threads, once we figure out what that is. Guaranteed to be an instance of DynamicClassLoader.

(defonce ^:private  shared-context-classloader
  (delay
    ;; If the Clojure runtime base loader is already an instance of DynamicClassLoader (e.g. it is something like
    ;; `clojure.lang.Compiler/LOADER` we can go ahead and use that in the future. This is usually the case when doing
    ;; REPL-based development or running via the Clojure CLI; when running from the UberJAR
    ;; `clojure.lang.Compiler/LOADER` is not set and thus this will return the current thread's context classloader,
    ;; which is usually just the System classloader.
    ;;
    ;; The base loader is what Clojure ultimately uses to loading namespaces with `require` so adding URLs to it is
    ;; they way to go, if we can)
    (or
     (when-let [base-loader (RT/baseLoader)]
       (when (instance? DynamicClassLoader base-loader)
         (log/tracef "Using Clojure base loader as shared context classloader: %s" base-loader)
         base-loader))
     ;; Otherwise if we need to create our own go ahead and do it
     ;;
     ;; Make a new classloader using the current thread's context classloader as it's parent. In cases where we hit
     ;; this condition (i.e., when running from the uberjar), the current thread's context classloader should be the
     ;; system classloader. Since it will be the same for other threads too it doesn't matter if we ignore *their*
     ;; context classloaders by giving them this one. No other places in the codebase should be modifying classloaders
     ;; anyway.
     (let [new-classloader (DynamicClassLoader. (.getContextClassLoader (Thread/currentThread)))]
       (log/tracef "Using NEWLY CREATED classloader as shared context classloader: %s" new-classloader)
       new-classloader))))

True if classloader and ancestor are the same object, or if classloader has ancestor as an ancestor in its parent chain, e.g. as a parent, its parent's parent, etc.

(defn- has-classloader-as-ancestor?
  [^ClassLoader classloader, ^ClassLoader ancestor]
  (cond
    (identical? classloader ancestor)
    true
    classloader
    (recur (.getParent classloader) ancestor)
    :else
    false))

True if the shared-context-classloader has been set and it is an ancestor of classloader.

(defn- has-shared-context-classloader-as-ancestor?
  [^ClassLoader classloader]
  (has-classloader-as-ancestor? classloader @shared-context-classloader))

Fetch the context classloader for the current thread; ensure it has a our shared context classloader as an ancestor somewhere in its hierarchy, changing the thread's context classloader when needed.

This function should be used when loading classes (such as JDBC drivers) with Class/forName; and for side-effects before calling require, to ensure the context classloader for the current thread is one that has access to the JARs we've added to the classpath.

(defn the-classloader
  ^ClassLoader []
  (or
   ;; if the context classloader already has the classloader we'll add URLs to as an ancestor return it as-is
   (let [current-thread-context-classloader (.getContextClassLoader (Thread/currentThread))]
     (when (has-shared-context-classloader-as-ancestor? current-thread-context-classloader)
       current-thread-context-classloader))
   ;; otherwise set the current thread's context classloader to the shared context classloader
   (let [shared-classloader @shared-context-classloader]
     (log/tracef "Setting current thread context classloader to shared classloader %s..." shared-classloader)
     (.setContextClassLoader (Thread/currentThread) shared-classloader)
     shared-classloader)))

Return a sequence of classloaders representing the hierarchy for classloader by iterating over calls to .getParent. The classloaders are in order from most distant ancestor to least; i.e. first item in the sequence is the highest classloader in the hierarchy (which should be the platform classloader).

(defn- classloader-hierarchy
  [^ClassLoader classloader]
  (reverse (take-while some? (iterate #(.getParent ^ClassLoader %) classloader))))

Find the highest-level DynamicClassLoader, starting our search with the current thread's context classloader; the classloader will be changed as needed by a call to the-classloader. The call to the-classloader, will, as a side-effect, make the current thread's context classloader one that has the shared classloader that we add URLs as an ancestor if it does not already have it as one.

This classloader is the one we'll add URLs to.

Why? In nREPL-based usage, the REPL creates a new classloader for each statement, using the prior one as its parent; if we add URLs to the lowest classloader on the chain, any other threads using an ancestor classloader won't have the new URL. By adding the URL to the highest-level classloader we can, the current thread and other threads will be ultimately have access to that URL.

(defn- the-top-level-classloader
  (^DynamicClassLoader []
   (the-top-level-classloader (the-classloader)))
  (^DynamicClassLoader [^DynamicClassLoader classloader]
   (some #(when (instance? DynamicClassLoader %) %)
         (classloader-hierarchy classloader))))
(defn- require* [& args]
  ;; during compilation, don't load any namespaces. This is going to totally screw up our compilation because
  ;; namespaces can end up being compiled twice because the topological sort in the build script doesn't take these
  ;; calls into account
  (when-not *compile-files*
    ;; as elsewhere make sure Clojure is using our context classloader (which should normally be true anyway) because
    ;; that's the one that will have access to the JARs we've added to the classpath at runtime
    ;;
    ;; this is done for side-effects
    (the-classloader)
    (try
      (binding [*use-context-classloader* true]
        ;; serialize requires
        (locking clojure.lang.RT/REQUIRE_LOCK
          (apply clojure.core/require args)))
      (catch Throwable e
        (throw (ex-info (.getMessage e)
                        {:classloader      (the-classloader)
                         :classpath-urls   (map str (dynapath/all-classpath-urls (the-classloader)))
                         :system-classpath (sort (str/split (System/getProperty "java.class.path") #"[:;]"))}
                        e))))))

Just like vanilla require, but ensures we're using our shared classloader to do it. Always use this over vanilla require -- otherwise namespaces might get loaded by the wrong ClassLoader, resulting in weird, hard-to-debug errors.

Added benefit -- this is also thread-safe, unlike vanilla require.

(defn require
  ([x]
   ;; Check whether the lib is already loaded (we only do this in simple cases where with just one arg -- this is
   ;; most of the calls anyway). If the lib is already loaded we can skip acquiring the lock and expensive stuff like
   ;; bindings and the try-catch
   (let [already-loaded? (and (symbol? x)
                              ((loaded-libs) x))]
     (when-not already-loaded?
       (require* x))))
  ([x & more]
   (apply require* x more)))
(defonce ^:private already-added (atom #{}))

Add a URL (presumably for a local JAR) to the classpath.

(defn add-url-to-classpath!
  [^URL url]
  (when-not (@already-added url)
    (swap! already-added conj url)
    ;; `add-classpath-url` will return non-truthy if it couldn't add the URL, e.g. because the classloader wasn't one
    ;; that allowed it
    (assert (dynapath/add-classpath-url (the-top-level-classloader) url))
    ;; don't i18n this or we will have circular refs
    (log/infof "Added URL %s to classpath" url)))
 
(ns metabase.plugins.dependencies
  (:require
   [clojure.string :as str]
   [environ.core :as env]
   [metabase.plugins.classloader :as classloader]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]))
(set! *warn-on-reflection* true)
(def ^:private plugins-with-unsatisfied-deps
  (atom #{}))
(defn- dependency-type [{classname :class, plugin :plugin, env-var :env-var}]
  (cond
    classname :class
    plugin    :plugin
    env-var   :env-var
    :else     :unknown))
(defmulti ^:private dependency-satisfied?
  {:arglists '([initialized-plugin-names info dependency])}
  (fn [_ _ dep] (dependency-type dep)))
(defmethod dependency-satisfied? :default [_ {{plugin-name :name} :info} dep]
  (log/error
   (u/format-color 'red
       (trs "Plugin {0} declares a dependency that Metabase does not understand: {1}" plugin-name dep))
   (trs "Refer to the plugin manifest reference for a complete list of valid plugin dependencies:")
   "https://github.com/metabase/metabase/wiki/Metabase-Plugin-Manifest-Reference")
  false)
(defonce ^:private already-logged (atom #{}))

Log a message a single time, such as warning that a plugin cannot be initialized because of required dependencies. Subsequent calls with duplicate messages are automatically ignored.

(defn log-once
  {:style/indent 1}
  ([message]
   (log-once nil message))
  ([plugin-name-or-nil message]
   (let [k [plugin-name-or-nil message]]
     (when-not (contains? @already-logged k)
       (swap! already-logged conj k)
       (log/info message)))))
(defn- warn-about-required-dependencies [plugin-name message]
  (log-once plugin-name
    (str (u/format-color 'red (trs "Metabase cannot initialize plugin {0} due to required dependencies." plugin-name))
         " "
         message)))
(defmethod dependency-satisfied? :class
  [_ {{plugin-name :name} :info} {^String classname :class, message :message, :as _dep}]
  (try
    (Class/forName classname false (classloader/the-classloader))
    (catch ClassNotFoundException _
      (warn-about-required-dependencies plugin-name (or message (trs "Class not found: {0}" classname)))
      false)))
(defmethod dependency-satisfied? :plugin
  [initialized-plugin-names {{plugin-name :name} :info} {dep-plugin-name :plugin}]
  (log-once plugin-name (trs "Plugin ''{0}'' depends on plugin ''{1}''" plugin-name dep-plugin-name))
  ((set initialized-plugin-names) dep-plugin-name))
(defmethod dependency-satisfied? :env-var
  [_ {{plugin-name :name} :info} {env-var-name :env-var}]
  (if (str/blank? (env/env (keyword env-var-name)))
    (do
      (log-once plugin-name (trs "Plugin ''{0}'' depends on environment variable ''{1}'' being set to something"
                                 plugin-name
                                 env-var-name))
      false)
    true))
(defn- all-dependencies-satisfied?*
  [initialized-plugin-names {:keys [dependencies], {plugin-name :name} :info, :as info}]
  (let [dep-satisfied? (fn [dep]
                         (u/prog1 (dependency-satisfied? initialized-plugin-names info dep)
                           (log-once plugin-name
                             (trs "{0} dependency {1} satisfied? {2}" plugin-name (dissoc dep :message) (boolean <>)))))]
    (every? dep-satisfied? dependencies)))

Check whether all dependencies are satisfied for a plugin; return truthy if all are; otherwise log explanations about why they are not, and return falsey.

For plugins that might have their dependencies satisfied in the near future

(defn all-dependencies-satisfied?
  [initialized-plugin-names info]
  (or
   (all-dependencies-satisfied?* initialized-plugin-names info)
   (do
     (swap! plugins-with-unsatisfied-deps conj info)
     (log-once (u/format-color 'yellow
                   (trs "Plugins with unsatisfied deps: {0}" (mapv (comp :name :info) @plugins-with-unsatisfied-deps))))
     false)))
(defn- remove-plugins-with-satisfied-deps [plugins initialized-plugin-names ready-for-init-atom]
  ;; since `remove-plugins-with-satisfied-deps` could theoretically be called multiple times we need to reset the atom
  ;; used to return the plugins ready for init so we don't accidentally include something in there twice etc.
  (reset! ready-for-init-atom nil)
  (set
   (for [info  plugins
         :let  [ready? (when (all-dependencies-satisfied?* initialized-plugin-names info)
                         (swap! ready-for-init-atom conj info))]
         :when (not ready?)]
     info)))

Updates internal list of plugins that still have unmet dependencies; returns sequence of plugin infos for all plugins that are now ready for initialization.

(defn update-unsatisfied-deps!
  [initialized-plugin-names]
  (let [ready-for-init (atom nil)]
    (swap! plugins-with-unsatisfied-deps remove-plugins-with-satisfied-deps initialized-plugin-names ready-for-init)
    @ready-for-init))
 

Logic for performing the init-steps listed in a Metabase plugin's manifest. For driver plugins that specify that we should lazy-load, these steps are lazily performed the first time non-trivial driver methods (such as connecting to a Database) are called; for all other Metabase plugins these are perfomed during launch.

The entire list of possible init steps is below, as impls for the do-init-step! multimethod.

(ns metabase.plugins.init-steps
  (:require
   [metabase.plugins.classloader :as classloader]
   [metabase.plugins.jdbc-proxy :as jdbc-proxy]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]))

Perform a driver init step. Steps are listed in init: in the plugin manifest; impls for each step are found below by dispatching off the value of step: for each step. Other properties specified for that step are passed as a map.

(defmulti ^:private do-init-step!
  {:arglists '([m])}
  (comp keyword :step))
(defmethod do-init-step! :load-namespace [{nmspace :namespace}]
  (log/debug (u/format-color 'blue (trs "Loading plugin namespace {0}..." nmspace)))
  (classloader/require (symbol nmspace)))
(defmethod do-init-step! :register-jdbc-driver [{class-name :class}]
  (jdbc-proxy/create-and-register-proxy-driver! class-name))

Perform the initialization steps for a Metabase plugin as specified under init: in its plugin manifest (metabase-plugin.yaml) by calling do-init-step! for each step.

(defn do-init-steps!
  [init-steps]
  (doseq [step init-steps]
    (do-init-step! step)))
 

Logic related to initializing plugins, i.e. running the init steps listed in the plugin manifest. This is done when Metabase launches as soon as all dependencies for that plugin are met; for plugins with unmet dependencies, it is retried after other plugins are loaded (e.g. for things like BigQuery which depend on the shared Google driver.)

Note that this is not the same thing as initializing drivers -- drivers are initialized lazily when first needed; this step on the other hand runs at launch time and sets up that lazy load logic.

(ns metabase.plugins.initialize
  (:require
   [metabase.plugins.dependencies :as deps]
   [metabase.plugins.init-steps :as init-steps]
   [metabase.plugins.lazy-loaded-driver :as lazy-loaded-driver]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [schema.core :as s]))
(defonce ^:private initialized-plugin-names (atom #{}))
(defn- init!
  [{:keys [add-to-classpath!], init-steps :init, {plugin-name :name} :info, driver-or-drivers :driver, :as info}]
  {:pre [(string? plugin-name)]}
  (when (deps/all-dependencies-satisfied? @initialized-plugin-names info)
    ;; for each driver, if it's lazy load, register a lazy-loaded placeholder driver
    (let [drivers (u/one-or-many driver-or-drivers)]
      (doseq [{:keys [lazy-load], :or {lazy-load true}, :as driver} drivers]
        (when lazy-load
          (lazy-loaded-driver/register-lazy-loaded-driver! (assoc info :driver driver))))
      ;; if *any* of the drivers is not lazy-load, initialize it now
      (when (some false? (map :lazy-load drivers))
        (when add-to-classpath!
          (add-to-classpath!))
        (init-steps/do-init-steps! init-steps)))
    ;; record this plugin as initialized and find any plugins ready to be initialized because depended on this one !
    ;;
    ;; Fun fact: we already have the `plugin-initialization-lock` if we're here so we don't need to worry about
    ;; getting it again
    (let [plugins-ready-to-init (deps/update-unsatisfied-deps! (swap! initialized-plugin-names conj plugin-name))]
      (when (seq plugins-ready-to-init)
        (log/debug (u/format-color 'yellow (trs "Dependencies satisfied; these plugins will now be loaded: {0}"
                                                (mapv (comp :name :info) plugins-ready-to-init)))))
      (doseq [plugin-info plugins-ready-to-init]
        (init! plugin-info)))
    :ok))
(defn- initialized? [{{plugin-name :name} :info}]
  (@initialized-plugin-names plugin-name))

Initialize plugin using parsed info from a plugin manifest. Returns truthy if plugin was successfully initialized; falsey otherwise.

(s/defn init-plugin-with-info!
  [info :- {:info     {:name s/Str, :version s/Str, s/Keyword s/Any}
            s/Keyword s/Any}]
  (or
   (initialized? info)
   (locking initialized-plugin-names
     (or
      (initialized? info)
      (init! info)))))
 

JDBC proxy driver used for drivers added at runtime. DriverManager refuses to recognize drivers that weren't loaded by the system classloader, so we need to wrap our drivers loaded at runtime with a proxy class loaded at launch time.

(ns metabase.plugins.jdbc-proxy
  (:require
   [metabase.plugins.classloader :as classloader]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [potemkin.types :as p.types]
   [pretty.core :refer [PrettyPrintable]])
  (:import
   (java.sql Driver DriverManager)))
(set! *warn-on-reflection* true)

-------------------------------------------------- Proxy Driver --------------------------------------------------

TODO -- why not use java.sql.Wrapper here instead of defining a new protocol that basically does the same thing?

(p.types/defprotocol+ ^:private ProxyDriver
  (wrapped-driver [this]
    "Get the JDBC driver wrapped by a Metabase JDBC proxy driver."))
(defn- proxy-driver ^Driver [^Driver driver]
  (reify
    PrettyPrintable
    (pretty [_]
      (list 'proxy-driver driver))
    ProxyDriver
    (wrapped-driver [_]
      driver)
    Driver
    (acceptsURL [_ url]
      (.acceptsURL driver url))
    (connect [_ url info]
      (.connect driver url info))
    (getMajorVersion [_]
      (.getMajorVersion driver))
    (getMinorVersion [_]
      (.getMinorVersion driver))
    (getParentLogger [_]
      (.getParentLogger driver))
    (getPropertyInfo [_ url info]
      (.getPropertyInfo driver url info))
    (jdbcCompliant [_]
      (.jdbcCompliant driver))))

Create a new JDBC proxy driver to wrap driver with class-name, but only if that class WAS NOT loaded by the System ClassLoader. Registers the driver with JDBC, and deregisters the class it wraps if that class is already registered.

This is necessary because the DriverManager will not recognize any drivers that are NOT loaded by the System ClassLoader.

(defn create-and-register-proxy-driver!
  [^String class-name]
  (let [klass (Class/forName class-name true (classloader/the-classloader))
        loaded-by-system-classloader? (identical? (.getClassLoader klass) (ClassLoader/getSystemClassLoader))]
    ;; if the System ClassLoader loaded this class, don't create the proxy driver, because that can break things in
    ;; some situations -- Oracle for example doesn't seem to behave properly when you do this. This mainly affects dev
    ;; which merges driver dependencies into the core project deps.
    (if loaded-by-system-classloader?
      (log/debug (u/format-color 'cyan (trs "Not creating proxy JDBC driver for class {0} -- original driver was loaded by system ClassLoader"
                                            class-name)))
      (let [driver (proxy-driver (.newInstance klass))]
        (log/debug (u/format-color 'blue (trs "Registering JDBC proxy driver for {0}..." class-name)))
        (DriverManager/registerDriver driver)
        ;; deregister the non-proxy version of the driver so it doesn't try to handle our URLs. Most JDBC drivers register
        ;; themseleves when the classes are loaded
        (doseq [driver (enumeration-seq (DriverManager/getDrivers))
                :when  (instance? klass driver)]
          (log/debug (u/format-color 'cyan (trs "Deregistering original JDBC driver {0}..." driver)))
          (DriverManager/deregisterDriver driver))))))
 

Implementation for a delayed-load driver that implements a few basic driver methods (available?, display-name, and connection-properties) needed for things like setup using the information provided in the plugin manifest. Other methods resolve drivers using driver/the-initialized-driver, which calls initialize!; we'll wait until that call to do more memory-intensive things like registering a JDBC driver or loading the actual driver namespace.

See https://github.com/metabase/metabase/wiki/Metabase-Plugin-Manifest-Reference for all the options allowed for a plugin manifest.

(ns metabase.plugins.lazy-loaded-driver
  (:require
   [metabase.driver :as driver]
   [metabase.driver.common :as driver.common]
   [metabase.plugins.init-steps :as init-steps]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log])
  (:import
   (clojure.lang MultiFn)))
(set! *warn-on-reflection* true)
(defn- parse-connection-property [prop]
  (cond
    (string? prop)
    (or (driver.common/default-options (keyword prop))
        (driver.common/default-connection-info-fields (keyword prop))
        (throw (Exception. (trs "Default connection property {0} does not exist." prop))))
    (not (map? prop))
    (throw (Exception. (trs "Invalid connection property {0}: not a string or map." prop)))
    (:merge prop)
    (into {} (map parse-connection-property) (:merge prop))
    :else
    prop))

Parse the connection properties included in the plugin manifest. These can be one of several things -- a key referring to one of the default maps in driver.common, a entire custom map, or a list of maps to merge: (e.g. for overriding part, but not all, of a default option).

(defn- parse-connection-properties
  [{:keys [connection-properties]}]
  (->> (map parse-connection-property connection-properties)
       (map u/one-or-many)
       (apply concat)))
(defn- make-initialize! [driver add-to-classpath! init-steps]
  (fn [_]
    ;; First things first: add the driver to the classpath!
    (when add-to-classpath!
      (add-to-classpath!))
    ;; remove *this* implementation of `initialize!`, because as you will see below, we want to give
    ;; lazy-load drivers the option to implement `initialize!` and do other things, which means we need to
    ;; manually call it. When we do so we don't want to get stuck in an infinite loop of calls back to this
    ;; implementation
    (remove-method driver/initialize! driver)
    ;; ok, do the init steps listed in the plugin mainfest
    (u/profile (u/format-color 'magenta (trs "Load lazy loading driver {0}" driver))
      (init-steps/do-init-steps! init-steps))
    ;; ok, now go ahead and call `driver/initialize!` a second time on the driver in case it actually has
    ;; an implementation of `initialize!` other than this one. If it does not, we'll just end up hitting
    ;; the default implementation, which is a no-op
    (driver/initialize! driver)))

Register a basic shell of a Metabase driver using the information from its Metabase plugin

(defn register-lazy-loaded-driver!
  [{:keys                                                                                            [add-to-classpath!]
    init-steps                                                                                       :init
    contact-info                                                                                     :contact-info
    superseded-by                                                                                    :superseded-by
    {driver-name :name, :keys [abstract display-name parent], :or {abstract false}, :as driver-info} :driver}]
  {:pre [(map? driver-info)]}
  (let [driver           (keyword driver-name)
        connection-props (parse-connection-properties driver-info)]
    ;; Make sure the driver has required properties like driver-name
    (when-not (seq driver-name)
      (throw (ex-info (trs "Cannot initialize plugin: missing required property `driver-name`")
               driver-info)))
    ;; if someone forgot to include connection properties for a non-abstract driver throw them a bone and warn them
    ;; about it
    (when (and (not abstract)
               (empty? connection-props))
      (log/warn
       (u/format-color 'red (trs "Warning: plugin manifest for {0} does not include connection properties" driver))))
    ;; ok, now add implementations for the so-called "non-trivial" driver multimethods
    (doseq [[^MultiFn multifn, f]
            {driver/initialize!           (make-initialize! driver add-to-classpath! init-steps)
             driver/display-name          (when display-name (constantly display-name))
             driver/contact-info          (constantly contact-info)
             driver/connection-properties (constantly connection-props)
             driver/superseded-by         (constantly (keyword superseded-by))}]
      (when f
        (.addMethod multifn driver f)))
    ;; finally, register the Metabase driver
    (log/debug (u/format-color 'magenta (trs "Registering lazy loading driver {0}..." driver)))
    (driver/register! driver, :parent (set (map keyword (u/one-or-many parent))), :abstract? abstract)))
 
(ns metabase.public-settings
  (:require
   [clojure.string :as str]
   [java-time.api :as t]
   [metabase.api.common :as api]
   [metabase.config :as config]
   [metabase.models.interface :as mi]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.util :as u]
   [metabase.util.fonts :as u.fonts]
   [metabase.util.i18n
    :as i18n
    :refer [available-locales-with-names deferred-tru trs tru]]
   [metabase.util.log :as log]
   [metabase.util.password :as u.password]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

These modules register settings but are otherwise unused. They still must be imported.

(comment premium-features/keep-me)
(defsetting application-name
  (deferred-tru "This will replace the word \"Metabase\" wherever it appears.")
  :visibility :public
  :type       :string
  :audit      :getter
  :feature    :whitelabel
  :default    "Metabase")

Returns the value of the [[application-name]] setting so setting docstrings can be generated during the compilation stage. Use this instead of application-name in descriptions, otherwise the application-name setting's :enabled? function will be called during compilation, which will fail because it will attempt to perform i18n, which is not allowed during compilation.

(defn application-name-for-setting-descriptions
  []
  (if *compile-files*
    "Metabase"
    (binding [setting/*disable-cache* true]
      (application-name))))
(defn- google-auth-enabled? []
  (boolean (setting/get :google-auth-enabled)))
(defn- ldap-enabled? []
  (classloader/require 'metabase.api.ldap)
  ((resolve 'metabase.api.ldap/ldap-enabled)))
(defn- ee-sso-configured? []
  (when config/ee-available?
    (classloader/require 'metabase-enterprise.sso.integrations.sso-settings))
  (when-let [varr (resolve 'metabase-enterprise.sso.integrations.sso-settings/other-sso-enabled?)]
    (varr)))

Any SSO provider is configured and enabled

(defn sso-enabled?
  []
  (or (google-auth-enabled?)
      (ldap-enabled?)
      (ee-sso-configured?)))
(defsetting check-for-updates
  (deferred-tru "Identify when new versions of Metabase are available.")
  :type    :boolean
  :audit   :getter
  :default true)
(defsetting version-info
  (deferred-tru "Information about available versions of Metabase.")
  :type    :json
  :audit   :never
  :default {}
  :doc     false)
(defsetting version-info-last-checked
  (deferred-tru "Indicates when Metabase last checked for new versions.")
  :visibility :public
  :type       :timestamp
  :audit      :never
  :default    nil
  :doc        false)
(defsetting startup-time-millis
  (deferred-tru "The startup time in milliseconds")
  :visibility :public
  :type       :double
  :audit      :never
  :default    0.0
  :doc        false)
(defsetting site-name
  (deferred-tru "The name used for this instance of {0}."
                (application-name-for-setting-descriptions))
  :default    "Metabase"
  :audit      :getter
  :visibility :settings-manager)
(defsetting custom-homepage
  (deferred-tru "Pick a dashboard to serve as the homepage. If people lack permissions to view the selected dashboard, Metabase will redirect them to the default homepage.")
  :default    false
  :type       :boolean
  :audit      :getter
  :visibility :public)
(defsetting custom-homepage-dashboard
  (deferred-tru "ID of dashboard to use as a homepage")
  :type       :integer
  :visibility :public
  :audit      :getter)
(defsetting dismissed-custom-dashboard-toast
  (deferred-tru "Toggle which is true after a user has dismissed the custom dashboard toast.")
  :user-local :only
  :visibility :authenticated
  :type       :boolean
  :default    false
  :audit      :never)

::uuid-nonce is a Setting that sets a site-wide random UUID value the first time it is fetched.

(defmethod setting/get-value-of-type ::uuid-nonce
  [_ setting]
  (or (setting/get-value-of-type :string setting)
      (let [value (str (random-uuid))]
        (setting/set-value-of-type! :string setting value)
        value)))
(defmethod setting/set-value-of-type! ::uuid-nonce
  [_ setting new-value]
  (setting/set-value-of-type! :string setting new-value))
(defmethod setting/default-tag-for-type ::uuid-nonce
  [_]
  `String)

Unique identifier used for this instance of {0}. This is set once and only once the first time it is fetched via its magic getter. Nice!

(defsetting site-uuid
  ;; Don't i18n this docstring because it's not user-facing! :)
  :visibility :authenticated
  :setter     :none
  ;; magic getter will either fetch value from DB, or if no value exists, set the value to a random UUID.
  :type       ::uuid-nonce
  :doc        false)

In the interest of respecting everyone's privacy and keeping things as anonymous as possible we have a different site-wide UUID that we use for the EE/premium features token feature check API calls. It works in fundamentally the same way as [[site-uuid]] but should only be used by the token check logic in [[metabase.public-settings.premium-features/fetch-token-status]]. (site-uuid is used for anonymous analytics/stats and if we sent it along with the premium features token check API request it would no longer be anonymous.)

(defsetting site-uuid-for-premium-features-token-checks
  :visibility :internal
  :setter     :none
  :type       ::uuid-nonce
  :doc        false)

A different site-wide UUID that we use for the version info fetching API calls. Do not use this for any other applications. (See [[site-uuid-for-premium-features-token-checks]] for more reasoning.)

(defsetting site-uuid-for-version-info-fetching
  :visibility :internal
  :setter     :none
  :type       ::uuid-nonce)

UUID that we use for generating urls users to unsubscribe from alerts. The hash is generated by hash(secretuuid + email + subscriptionid) = url. Do not use this for any other applications. (See #29955)

(defsetting site-uuid-for-unsubscribing-url
  :visibility :internal
  :setter     :none
  :type       ::uuid-nonce)
(defn- normalize-site-url [^String s]
  (let [ ;; remove trailing slashes
        s (str/replace s #"/$" )
        ;; add protocol if missing
        s (if (str/starts-with? s "http")
            s
            (str "http://" s))]
    ;; check that the URL is valid
    (when-not (u/url? s)
      (throw (ex-info (tru "Invalid site URL: {0}" (pr-str s)) {:url (pr-str s)})))
    s))
(declare redirect-all-requests-to-https!)

This value is guaranteed to never have a trailing slash :D It will also prepend http:// to the URL if there's no protocol when it comes in

(defsetting site-url
  (deferred-tru
   (str "This URL is used for things like creating links in emails, auth redirects, and in some embedding scenarios, "
        "so changing it could break functionality or get you locked out of this instance."))
  :visibility :public
  :audit      :getter
  :getter     (fn []
                (try
                  (some-> (setting/get-value-of-type :string :site-url) normalize-site-url)
                  (catch clojure.lang.ExceptionInfo e
                    (log/error e (trs "site-url is invalid; returning nil for now. Will be reset on next request.")))))
  :setter     (fn [new-value]
                (let [new-value (some-> new-value normalize-site-url)
                      https?    (some-> new-value (str/starts-with?  "https:"))]
                  ;; if the site URL isn't HTTPS then disable force HTTPS redirects if set
                  (when-not https?
                    (redirect-all-requests-to-https! false))
                  (setting/set-value-of-type! :string :site-url new-value))))
(defsetting site-locale
  (deferred-tru
    (str "The default language for all users across the {0} UI, system emails, pulses, and alerts. "
         "Users can individually override this default language from their own account settings.")
    (application-name-for-setting-descriptions))
  :default    "en"
  :visibility :public
  :audit      :getter
  :getter     (fn []
                (let [value (setting/get-value-of-type :string :site-locale)]
                  (when (i18n/available-locale? value)
                    value)))
  :setter     (fn [new-value]
                (when new-value
                  (when-not (i18n/available-locale? new-value)
                    (throw (ex-info (tru "Invalid locale {0}" (pr-str new-value)) {:status-code 400}))))
                (setting/set-value-of-type! :string :site-locale (some-> new-value i18n/normalized-locale-string))))
(defsetting admin-email
  (deferred-tru "The email address users should be referred to if they encounter a problem.")
  :visibility :authenticated
  :audit      :getter)
(defsetting anon-tracking-enabled
  (deferred-tru "Enable the collection of anonymous usage data in order to help {0} improve."
                (application-name-for-setting-descriptions))
  :type       :boolean
  :default    true
  :visibility :public
  :audit      :getter)
(defsetting ga-code
  (deferred-tru "Google Analytics tracking code.")
  :default    "UA-60817802-1"
  :visibility :public
  :doc        false)
(defsetting ga-enabled
  (deferred-tru "Boolean indicating whether analytics data should be sent to Google Analytics on the frontend")
  :type       :boolean
  :setter     :none
  :getter     (fn [] (and config/is-prod? (anon-tracking-enabled)))
  :visibility :public
  :audit      :never
  :doc        false)
(defsetting map-tile-server-url
  (deferred-tru "The map tile server URL template used in map visualizations, for example from OpenStreetMaps or MapBox.")
  :default    "https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png"
  :visibility :public
  :audit      :getter)
(defsetting landing-page
  (deferred-tru "Default page to show people when they log in.")
  :visibility :public
  :type       :string
  :default    
  :audit      :getter)
(defsetting enable-public-sharing
  (deferred-tru "Enable admins to create publicly viewable links (and embeddable iframes) for Questions and Dashboards?")
  :type       :boolean
  :default    false
  :visibility :authenticated
  :audit      :getter)
(defsetting enable-nested-queries
  (deferred-tru "Allow using a saved question or Model as the source for other queries?")
  :type       :boolean
  :default    true
  :visibility :authenticated
  :audit      :getter)
(defsetting enable-query-caching
  (deferred-tru "Enabling caching will save the results of queries that take a long time to run.")
  :type       :boolean
  :default    false
  :visibility :authenticated
  :audit      :getter)
(defsetting persisted-models-enabled
  (deferred-tru "Allow persisting models into the source database.")
  :type       :boolean
  :default    false
  :visibility :public
  :audit      :getter)
(defsetting persisted-model-refresh-cron-schedule
  (deferred-tru "cron syntax string to schedule refreshing persisted models.")
  :type       :string
  :default    "0 0 0/6 * * ? *"
  :visibility :admin
  :audit      :getter)

Although depending on the database, we can support much larger cached values (1GB for PG, 2GB for H2 and 4GB for MySQL) we are not curretly setup to deal with data of that size. The datatypes we are using will hold this data in memory and will not truly be streaming. This is a global max in order to prevent our users from setting the caching value so high it becomes a performance issue. The value below represents 200MB

(def ^:private ^:const global-max-caching-kb
  (* 200 1024))
(defsetting query-caching-max-kb
  (deferred-tru "The maximum size of the cache, per saved question, in kilobytes:")
  ;; (This size is a measurement of the length of *uncompressed* serialized result *rows*. The actual size of
  ;; the results as stored will vary somewhat, since this measurement doesn't include metadata returned with the
  ;; results, and doesn't consider whether the results are compressed, as the `:db` backend does.)
  :type    :integer
  :default 1000
  :audit   :getter
  :setter  (fn [new-value]
             (when (and new-value
                        (> (cond-> new-value
                             (string? new-value) Integer/parseInt)
                           global-max-caching-kb))
               (throw (IllegalArgumentException.
                       (str
                        (tru "Failed setting `query-caching-max-kb` to {0}." new-value)
                        " "
                        (tru "Values greater than {0} ({1}) are not allowed."
                             global-max-caching-kb (u/format-bytes (* global-max-caching-kb 1024)))))))
             (setting/set-value-of-type! :integer :query-caching-max-kb new-value)))
(defsetting query-caching-max-ttl
  (deferred-tru "The absolute maximum time to keep any cached query results, in seconds.")
  :type    :double
  :default (* 60.0 60.0 24.0 100.0) ; 100 days
  :audit   :getter)

TODO -- this isn't really a TTL at all. Consider renaming to something like -min-duration

(defsetting query-caching-min-ttl
  (deferred-tru "{0} will cache all saved questions with an average query execution time longer than this many seconds:"
                 (application-name-for-setting-descriptions))
  :type    :double
  :default 60.0
  :audit   :getter)
(defsetting query-caching-ttl-ratio
  (deferred-tru
   (str "To determine how long each saved question''s cached result should stick around, we take the query''s average "
        "execution time and multiply that by whatever you input here. So if a query takes on average 2 minutes to run, "
        "and you input 10 for your multiplier, its cache entry will persist for 20 minutes."))
  :type    :integer
  :default 10
  :audit   :getter)
(defsetting notification-link-base-url
  (deferred-tru "By default \"Site Url\" is used in notification links, but can be overridden.")
  :visibility :internal
  :type       :string
  :feature    :whitelabel
  :audit      :getter)
(defsetting deprecation-notice-version
  (deferred-tru "Metabase version for which a notice about usage of deprecated features has been shown.")
  :visibility :admin
  :doc        false
  :audit      :never)
(defsetting loading-message
  (deferred-tru "Message to show while a query is running.")
  :visibility :public
  :feature    :whitelabel
  :type       :keyword
  :default    :doing-science
  :audit      :getter)
(defsetting application-colors
  (deferred-tru
    (str "These are the primary colors used in charts and throughout {0}. "
         "You might need to refresh your browser to see your changes take effect.")
    (application-name-for-setting-descriptions))
  :visibility :public
  :type       :json
  :feature    :whitelabel
  :default    {}
  :audit      :getter)
(defsetting application-font
  (deferred-tru "This will replace “Lato” as the font family.")
  :visibility :public
  :type       :string
  :default    "Lato"
  :feature    :whitelabel
  :audit      :getter
  :setter     (fn [new-value]
                  (when new-value
                    (when-not (u.fonts/available-font? new-value)
                      (throw (ex-info (tru "Invalid font {0}" (pr-str new-value)) {:status-code 400}))))
                  (setting/set-value-of-type! :string :application-font new-value)))
(defsetting application-font-files
  (deferred-tru "Tell us where to find the file for each font weight. You don’t need to include all of them, but it’ll look better if you do.")
  :visibility :public
  :type       :json
  :audit      :getter
  :feature    :whitelabel)

The primary color, a.k.a. brand color

(defn application-color
  []
  (or (:brand (application-colors)) "#509EE3"))

The first 'Additional chart color'

(defn secondary-chart-color
  []
  (or (:accent3 (application-colors)) "#EF8C8C"))
(defsetting application-logo-url
  (deferred-tru "For best results, use an SVG file with a transparent background.")
  :visibility :public
  :type       :string
  :audit      :getter
  :feature    :whitelabel
  :default    "app/assets/img/logo.svg")
(defsetting application-favicon-url
  (deferred-tru "The url or image that you want to use as the favicon.")
  :visibility :public
  :type       :string
  :audit      :getter
  :feature    :whitelabel
  :default    "app/assets/img/favicon.ico")
(defsetting show-metabot
  (deferred-tru "Enables Metabot character on the home page")
  :visibility :public
  :type       :boolean
  :audit      :getter
  :feature    :whitelabel
  :default    true)
(defsetting show-lighthouse-illustration
  (deferred-tru "Display the lighthouse illustration on the home and login pages.")
  :visibility :public
  :type       :boolean
  :audit      :getter
  :feature    :whitelabel
  :default    true)
(def ^:private help-link-options
  #{:metabase :hidden :custom})
(defsetting help-link
  (deferred-tru
   (str
    "Keyword setting to control whitelabeling of the help link. Valid values are `:metabase`, `:hidden`, and "
    "`:custom`. If `:custom` is set, the help link will use the URL specified in the `help-link-custom-destination`, "
    "or be hidden if it is not set."))
  :default    :default
  :type       :keyword
  :audit      :getter
  :visibility :public
  :feature    :whitelabel
  :default    :metabase
  :setter     (fn [value]
                (when-not (help-link-options (keyword value))
                  (throw (ex-info (tru "Invalid help link option")
                                  {:value value
                                   :valid-options help-link-options})))
                (setting/set-value-of-type! :keyword :help-link value)))

Checks that the provided URL is either a valid HTTP/HTTPS URL or a mailto: link. Returns nil if the input is valid; throws an exception if it is not.

(defn- validate-help-url
  [url]
  (let [validation-exception (ex-info (tru "Please make sure this is a valid URL")
                                      {:url url})]
   (if-let [matches (re-matches #"^mailto:(.*)" url)]
     (when-not (u/email? (second matches))
       (throw validation-exception))
     (when-not (u/url? url)
       (throw validation-exception)))))
(defsetting help-link-custom-destination
  (deferred-tru "Custom URL for the help link.")
  :visibility :public
  :type       :string
  :audit      :getter
  :feature    :whitelabel
  :setter     (fn [new-value]
                (let [new-value-string (str new-value)]
                 (validate-help-url new-value-string)
                 (setting/set-value-of-type! :string :help-link-custom-destination new-value-string))))
(defsetting enable-password-login
  (deferred-tru "Allow logging in by email and password.")
  :visibility :public
  :type       :boolean
  :default    true
  :feature    :disable-password-login
  :audit      :raw-value
  :getter     (fn []
                ;; if `:enable-password-login` has an *explict* (non-default) value, and SSO is configured, use that;
                ;; otherwise this always returns true.
                (let [v (setting/get-value-of-type :boolean :enable-password-login)]
                  (if (and (some? v)
                           (sso-enabled?))
                    v
                    true))))
(defsetting breakout-bins-num
  (deferred-tru
    (str "When using the default binning strategy and a number of bins is not provided, "
         "this number will be used as the default."))
  :type    :integer
  :default 8
  :audit   :getter)
(defsetting breakout-bin-width
  (deferred-tru
   (str "When using the default binning strategy for a field of type Coordinate (such as Latitude and Longitude), "
        "this number will be used as the default bin width (in degrees)."))
  :type    :double
  :default 10.0
  :audit   :getter)
(defsetting custom-formatting
  (deferred-tru "Object keyed by type, containing formatting settings")
  :type       :json
  :default    {}
  :visibility :public
  :audit      :getter)
(defsetting enable-xrays
  (deferred-tru "Allow users to explore data using X-rays")
  :type       :boolean
  :default    true
  :visibility :authenticated
  :audit      :getter)
(defsetting show-homepage-data
  (deferred-tru
   (str "Whether or not to display data on the homepage. "
        "Admins might turn this off in order to direct users to better content than raw data"))
  :type       :boolean
  :default    true
  :visibility :authenticated
  :audit      :getter)
(defsetting show-homepage-xrays
  (deferred-tru
    (str "Whether or not to display x-ray suggestions on the homepage. They will also be hidden if any dashboards are "
         "pinned. Admins might hide this to direct users to better content than raw data"))
  :type       :boolean
  :default    true
  :visibility :authenticated
  :audit      :getter)
(defsetting show-homepage-pin-message
  (deferred-tru
   (str "Whether or not to display a message about pinning dashboards. It will also be hidden if any dashboards are "
        "pinned. Admins might hide this to direct users to better content than raw data"))
  :type       :boolean
  :default    true
  :visibility :authenticated
  :doc        false
  :audit      :getter)
(defsetting source-address-header
  (deferred-tru "Identify the source of HTTP requests by this header's value, instead of its remote address.")
  :default "X-Forwarded-For"
  :audit   :getter
  :getter  (fn [] (some-> (setting/get-value-of-type :string :source-address-header)
                          u/lower-case-en)))

If public sharing is disabled and object has a :public_uuid, remove it so people don't try to use it (since it won't work). Intended for use as part of a post-select implementation for Cards and Dashboards.

(defn remove-public-uuid-if-public-sharing-is-disabled
  [object]
  (if (and (:public_uuid object)
           (not (enable-public-sharing)))
    (assoc object :public_uuid nil)
    object))

Available fonts

(defsetting available-fonts
  :visibility :public
  :setter     :none
  :getter     u.fonts/available-fonts
  :doc        false)

Available i18n locales

(defsetting available-locales
  :visibility :public
  :setter     :none
  :getter     available-locales-with-names
  :doc        false)

Available report timezone options

(defsetting available-timezones
  :visibility :public
  :setter     :none
  :getter     (comp sort t/available-zone-ids)
  :doc        false)

Whether this instance has a Sample Database database

(defsetting has-sample-database?
  :visibility :authenticated
  :setter     :none
  :getter     (fn [] (t2/exists? :model/Database, :is_sample true))
  :doc        false)

Current password complexity requirements

(defsetting password-complexity
  :visibility :public
  :setter     :none
  :getter     u.password/active-password-complexity)
(defsetting session-cookies
  (deferred-tru "When set, enforces the use of session cookies for all users which expire when the browser is closed.")
  :type       :boolean
  :visibility :public
  :default    nil
  :audit      :getter)

Metabase's version info

(defsetting version
  :visibility :public
  :setter     :none
  :getter     (constantly config/mb-version-info)
  :doc        false)

Features registered for this instance's token

(defsetting token-features
  :visibility :public
  :setter     :none
  :getter     (fn [] {:advanced_permissions           (premium-features/enable-advanced-permissions?)
                      :audit_app                      (premium-features/enable-audit-app?)
                      :cache_granular_controls        (premium-features/enable-cache-granular-controls?)
                      :config_text_file               (premium-features/enable-config-text-file?)
                      :content_verification           (premium-features/enable-content-verification?)
                      :dashboard_subscription_filters (premium-features/enable-dashboard-subscription-filters?)
                      :disable_password_login         (premium-features/can-disable-password-login?)
                      :email_allow_list               (premium-features/enable-email-allow-list?)
                      :email_restrict_recipients      (premium-features/enable-email-restrict-recipients?)
                      :embedding                      (premium-features/hide-embed-branding?)
                      :hosting                        (premium-features/is-hosted?)
                      :official_collections           (premium-features/enable-official-collections?)
                      :sandboxes                      (premium-features/enable-sandboxes?)
                      :session_timeout_config         (premium-features/enable-session-timeout-config?)
                      :snippet_collections            (premium-features/enable-snippet-collections?)
                      :sso_google                     (premium-features/enable-sso-google?)
                      :sso_jwt                        (premium-features/enable-sso-jwt?)
                      :sso_ldap                       (premium-features/enable-sso-ldap?)
                      :sso_saml                       (premium-features/enable-sso-saml?)
                      :whitelabel                     (premium-features/enable-whitelabeling?)})
  :doc        false)
(defsetting redirect-all-requests-to-https
  (deferred-tru "Force all traffic to use HTTPS via a redirect, if the site URL is HTTPS")
  :visibility :public
  :type       :boolean
  :default    false
  :audit      :getter
  :setter     (fn [new-value]
                ;; if we're trying to enable this setting, make sure `site-url` is actually an HTTPS URL.
                (when (if (string? new-value)
                        (setting/string->boolean new-value)
                        new-value)
                  (assert (some-> (site-url) (str/starts-with? "https:"))
                          (tru "Cannot redirect requests to HTTPS unless `site-url` is HTTPS.")))
                (setting/set-value-of-type! :boolean :redirect-all-requests-to-https new-value)))
(defsetting start-of-week
  (deferred-tru
    (str "This will affect things like grouping by week or filtering in GUI queries. "
         "It won''t affect most SQL queries, "
         "although it is used to set the WEEK_START session variable in Snowflake."))
  :visibility :public
  :type       :keyword
  :default    :sunday
  :audit      :raw-value
  :getter     (fn []
                ;; if something invalid is somehow in the DB just fall back to Sunday
                (when-let [value (setting/get-value-of-type :keyword :start-of-week)]
                  (if (#{:monday :tuesday :wednesday :thursday :friday :saturday :sunday} value)
                    value
                    :sunday)))
  :setter      (fn [new-value]
                 (when new-value
                   (assert (#{:monday :tuesday :wednesday :thursday :friday :saturday :sunday} (keyword new-value))
                           (trs "Invalid day of week: {0}" (pr-str new-value))))
                 (setting/set-value-of-type! :keyword :start-of-week new-value)))
(defsetting cloud-gateway-ips
  (deferred-tru "Metabase Cloud gateway IP addresses, to configure connections to DBs behind firewalls")
  :visibility :public
  :type       :string
  :setter     :none
  :getter (fn []
            (when (premium-features/is-hosted?)
              (some-> (setting/get-value-of-type :string :cloud-gateway-ips)
                      (str/split #",")))))
(defsetting show-database-syncing-modal
  (deferred-tru
    (str "Whether an introductory modal should be shown after the next database connection is added. "
         "Defaults to false if any non-default database has already finished syncing for this instance."))
  :visibility :admin
  :type       :boolean
  :audit      :never
  :getter     (fn []
                (let [v (setting/get-value-of-type :boolean :show-database-syncing-modal)]
                  (if (nil? v)
                    (not (t2/exists? :model/Database
                                     :is_sample false
                                     :is_audit false
                                     :initial_sync_status "complete"))
                    ;; frontend should set this value to `true` after the modal has been shown once
                    v))))
(defsetting uploads-enabled
  (deferred-tru "Whether or not uploads are enabled")
  :visibility :authenticated
  :type       :boolean
  :audit      :getter
  :default    false)
(defn- not-handling-api-request?
  []
  (nil? @api/*current-user*))

Sets the :uploads-database-id setting, with an appropriate permission check.

(defn set-uploads-database-id!
  [new-id]
  (if (or (not-handling-api-request?)
          (mi/can-write? :model/Database new-id))
    (setting/set-value-of-type! :integer :uploads-database-id new-id)
    (api/throw-403)))
(defsetting uploads-database-id
  (deferred-tru "Database ID for uploads")
  :visibility :authenticated
  :type       :integer
  :audit      :getter
  :setter     set-uploads-database-id!)
(defsetting uploads-schema-name
  (deferred-tru "Schema name for uploads")
  :visibility :authenticated
  :type       :string
  :audit      :getter)
(defsetting uploads-table-prefix
  (deferred-tru "Prefix for upload table names")
  :visibility :authenticated
  :type       :string
  :audit      :getter)
(defsetting attachment-table-row-limit
  (deferred-tru "Maximum number of rows to render in an alert or subscription image.")
  :visibility :internal
  :type       :positive-integer
  :default    20
  :audit      :getter
  :getter     (fn []
                (let [value (setting/get-value-of-type :positive-integer :attachment-table-row-limit)]
                  (if-not (pos-int? value)
                    20
                    value))))
 

Settings related to checking premium token validity and which premium features it allows.

(ns metabase.public-settings.premium-features
  (:require
   [cheshire.core :as json]
   [clj-http.client :as http]
   [clojure.core.memoize :as memoize]
   [clojure.spec.alpha :as s]
   [clojure.string :as str]
   [environ.core :refer [env]]
   [malli.core :as mc]
   [metabase.api.common :as api]
   [metabase.config :as config]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.plugins.classloader :as classloader]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [metabase.util.string :as u.str]
   [toucan2.connection :as t2.conn]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

Schema for a valid premium token. Must be 64 lower-case hex characters.

(def ^:private ValidToken
  #"^[0-9a-f]{64}$")

Base URL to use for token checks. Hardcoded by default but for development purposes you can use a local server. Specify the env var METASTORE_DEV_SERVER_URL.

(def token-check-url
  (or
   ;; only enable the changing the token check url during dev because we don't want people switching it out in production!
   (when config/is-dev?
     (some-> (env :metastore-dev-server-url)
             ;; remove trailing slashes
             (str/replace  #"/$" "")))
   "https://token-check.metabase.com"))

Store URL, used as a fallback for token checks and for fetching the list of cloud gateway IPs.

(def store-url
  "https://store.metabase.com")

+----------------------------------------------------------------------------------------------------------------+ | TOKEN VALIDATION | +----------------------------------------------------------------------------------------------------------------+

(declare premium-embedding-token)

Primarily used for the settings because we don't wish it to be 100%. (HUH?)

let's prevent the DB from getting slammed with calls to get the active user count, we only really need one in flight at a time.

(let [f        (fn []
                 {:post [(integer? %)]}
                 (log/debug (u/colorize :yellow "GETTING ACTIVE USER COUNT!"))
                 (assert ((requiring-resolve 'metabase.db/db-is-set-up?)) "Metabase DB is not yet set up")
                 ;; force this to use a new Connection, it seems to be getting called in situations where the Connection
                 ;; is from a different thread and is invalid by the time we get to use it
                 (let [result (binding [t2.conn/*current-connectable* nil]
                                (t2/count :model/User :is_active true :type :personal))]
                   (log/debug (u/colorize :green "=>") result)
                   result))
      memoized (memoize/ttl
                f
                :ttl/threshold (u/minutes->ms 5))
      lock     (Object.)]
  (defn- cached-active-users-count
    []
    (locking lock
      (memoized))))
(defsetting active-users-count
  (deferred-tru "Cached number of active users. Refresh every 5 minutes.")
  :visibility :admin
  :type       :integer
  :audit      :never
  :default    0
  :getter     (fn []
                (if-not ((requiring-resolve 'metabase.db/db-is-set-up?))
                 0
                 (cached-active-users-count))))
(defn- token-status-url [token base-url]
  (when (seq token)
    (format "%s/api/%s/v2/status" base-url token)))
(def ^:private ^:const fetch-token-status-timeout-ms (u/seconds->ms 10))
(def ^:private TokenStatus
  [:map
   [:valid                          :boolean]
   [:status                         ms/NonBlankString]
   [:error-details {:optional true} [:maybe ms/NonBlankString]]
   [:features      {:optional true} [:sequential ms/NonBlankString]]
   [:trial         {:optional true} :boolean]
   [:valid-thru    {:optional true} ms/NonBlankString]]) ; ISO 8601 timestamp
(defn- fetch-token-and-parse-body
  [token base-url]
  (some-> (token-status-url token base-url)
          (http/get {:query-params {:users      (cached-active-users-count)
                                    :site-uuid  (setting/get :site-uuid-for-premium-features-token-checks)
                                    :mb-version (:tag config/mb-version-info)}})
          :body
          (json/parse-string keyword)))
(mu/defn ^:private fetch-token-status* :- TokenStatus
  "Fetch info about the validity of `token` from the MetaStore."
  [token :- :string]
  ;; attempt to query the metastore API about the status of this token. If the request doesn't complete in a
  ;; reasonable amount of time throw a timeout exception
  (log/infof "Checking with the MetaStore to see whether token '%s' is valid..." (u.str/mask token))
  (if-not (mc/validate ValidToken token)
    (do
      (log/error (u/format-color 'red "Invalid token format!"))
      {:valid         false
       :status        "invalid"
       :error-details (trs "Token should be 64 hexadecimal characters.")})
    (let [fut    (future
                   (try (fetch-token-and-parse-body token token-check-url)
                        (catch Exception e1
                          (log/error e1 (trs "Error fetching token status from {0}:" token-check-url))
                          ;; Try the fallback URL, which was the default URL prior to 45.2
                          (try (fetch-token-and-parse-body token store-url)
                               ;; if there was an error fetching the token from both the normal and fallback URLs, log the
                               ;; first error and return a generic message about the token being invalid. This message
                               ;; will get displayed in the Settings page in the admin panel so we do not want something
                               ;; complicated
                               (catch Exception e2
                                 (log/error e2 (trs "Error fetching token status from {0}:" store-url))
                                 (let [body (u/ignore-exceptions (some-> (ex-data e1) :body (json/parse-string keyword)))]
                                   (or
                                     body
                                     {:valid         false
                                      :status        (tru "Unable to validate token")
                                      :error-details (.getMessage e1)})))))))
          result (deref fut fetch-token-status-timeout-ms ::timed-out)]
      (if (= result ::timed-out)
        (do
          (future-cancel fut)
          {:valid         false
           :status        (tru "Unable to validate token")
           :error-details (tru "Token validation timed out.")})
        result))))

TTL-memoized version of fetch-token-status*. Caches API responses for 5 minutes. This is important to avoid making too many API calls to the Store, which will throttle us if we make too many requests; putting in a bad token could otherwise put us in a state where valid-token->features* made API calls over and over, never itself getting cached because checks failed.

(def ^{:arglists '([token])} fetch-token-status
  ;; don't blast the token status check API with requests if this gets called a bunch of times all at once -- wait for
  ;; the first request to finish
  (let [lock (Object.)
        f    (memoize/ttl
              (fn [token]
                ;; this is a sanity check to make sure we can actually get the active user count BEFORE we try to call
                ;; [[fetch-token-status*]], because `fetch-token-status*` catches Exceptions and therefore caches failed
                ;; results. We were running into issues in the e2e tests where `active-users-count` was timing out
                ;; because of to weird timeouts after restoring the app DB from a snapshot, which would cause other
                ;; tests to fail because a timed-out token check would get cached as a result.
                (assert ((requiring-resolve 'metabase.db/db-is-set-up?)) "Metabase DB is not yet set up")
                (u/with-timeout (u/seconds->ms 5)
                  (cached-active-users-count))
                (fetch-token-status* token))
              :ttl/threshold (u/minutes->ms 5))]
    (fn [token]
      (locking lock
        (f token)))))
(mu/defn ^:private valid-token->features* :- [:set ms/NonBlankString]
  [token :- ValidToken]
  (let [{:keys [valid status features error-details]} (fetch-token-status token)]
    ;; if token isn't valid throw an Exception with the `:status` message
    (when-not valid
      (throw (ex-info status
                      {:status-code 400, :error-details error-details})))
    ;; otherwise return the features this token supports
    (set features)))

Amount of time to cache the status of a valid embedding token before forcing a re-check

(def ^:private ^:const valid-token-recheck-interval-ms
  (u/hours->ms 24)) ; once a day

Check whether token is valid. Throws an Exception if not. Returns a set of supported features if it is.

(def ^:private ^{:arglists '([token])} valid-token->features
  ;; this is just `valid-token->features*` with some light caching
  (let [f (memoize/ttl valid-token->features* :ttl/threshold valid-token-recheck-interval-ms)]
    (fn [token]
      (assert ((requiring-resolve 'metabase.db/db-is-set-up?)) "Metabase DB is not yet set up")
      (f token))))
(defsetting token-status
  (deferred-tru "Cached token status for premium features. This is to avoid an API request on the the first page load.")
  :visibility :admin
  :type       :json
  :audit      :never
  :setter     :none
  :getter     (fn [] (some-> (premium-embedding-token) (fetch-token-status))))

+----------------------------------------------------------------------------------------------------------------+ | SETTING & RELATED FNS | +----------------------------------------------------------------------------------------------------------------+

(defsetting premium-embedding-token     ; TODO - rename this to premium-features-token?
  (deferred-tru "Token for premium features. Go to the MetaStore to get yours!")
  :audit :never
  :setter
  (fn [new-value]
    ;; validate the new value if we're not unsetting it
    (try
      (when (seq new-value)
        (when-not (mc/validate ValidToken new-value)
          (throw (ex-info (tru "Token format is invalid.")
                          {:status-code 400, :error-details "Token should be 64 hexadecimal characters."})))
        (valid-token->features new-value)
        (log/info (trs "Token is valid.")))
      (setting/set-value-of-type! :string :premium-embedding-token new-value)
      (catch Throwable e
        (log/error e (trs "Error setting premium features token"))
        (throw (ex-info (.getMessage e) (merge
                                         {:message (.getMessage e), :status-code 400}
                                         (ex-data e)))))))) ; merge in error-details if present
(let [cached-logger (memoize/ttl
                     ^{::memoize/args-fn (fn [[token _e]] [token])}
                     (fn [_token e]
                       (log/error (trs "Error validating token") ":" (ex-message e))
                       (log/debug e (trs "Error validating token")))
                     ;; log every five minutes
                     :ttl/threshold (* 1000 60 5))]
  (mu/defn token-features :- [:set ms/NonBlankString]
    "Get the features associated with the system's premium features token."
    []
    (try
      (or (some-> (premium-embedding-token) valid-token->features)
          #{})
      (catch Throwable e
        (cached-logger (premium-embedding-token) e)
        #{}))))

True if we have a valid premium features token with ANY features.

(defn- has-any-features?
  []
  (boolean (seq (token-features))))

Does this instance's premium token have feature?

(has-feature? :sandboxes) ; -> true (has-feature? :toucan-management) ; -> false

(defn has-feature?
  [feature]
  (contains? (token-features) (name feature)))

Returns an error that can be used to throw when an enterprise feature check fails.

(defn ee-feature-error
  [feature-name]
  (ex-info (tru "{0} is a paid feature not currently available to your instance. Please upgrade to use it. Learn more at metabase.com/upgrade/"
                feature-name)
           {:status-code 402}))

Check if an token with feature is present. If not, throw an error with a message using feature-name. feature-name should be a localized string unless used in a CLI context. (assert-has-feature :sandboxes (tru "Sandboxing")) => throws an error with a message using "Sandboxing" as the feature name.

(mu/defn assert-has-feature
  [feature-flag :- keyword?
   feature-name :- [:or string? mu/localized-string-schema]]
  (when-not (has-feature? feature-flag)
    (throw (ee-feature-error feature-name))))

Check if has at least one of feature in features. Throw an error if none of the features are available.

(mu/defn assert-has-any-features
  [feature-flag :- [:sequential keyword?]
   feature-name :- [:or string? mu/localized-string-schema]]
  (when-not (some has-feature? feature-flag)
    (throw (ee-feature-error feature-name))))
(defn- default-premium-feature-getter [feature]
  (fn []
    (and config/ee-available?
         (has-feature? feature))))

Set of defined premium feature keywords.

(def premium-features
  (atom #{}))

Convenience for generating a [[metabase.models.setting/defsetting]] form for a premium token feature. (The Settings definitions for Premium token features all look more or less the same, so this prevents a lot of code duplication.)

(defmacro ^:private define-premium-feature
  [setting-name docstring feature & {:as options}]
  (let [options (merge {:type       :boolean
                        :visibility :public
                        :setter     :none
                        :audit      :never
                        :getter     `(default-premium-feature-getter ~(some-> feature name))}
                       options)]
    `(do
      (swap! premium-features conj ~feature)
      (defsetting ~setting-name
        ~docstring
        ~@(mapcat identity options)))))

Logo Removal and Full App Embedding. Should we hide the 'Powered by Metabase' attribution on the embedding pages? true if we have a valid premium embedding token.

(define-premium-feature hide-embed-branding?
  :embedding
  ;; This specific feature DOES NOT require the EE code to be present in order for it to return truthy, unlike
  ;; everything else.
  :getter #(has-feature? :embedding))

Should we allow full whitelabel embedding (reskinning the entire interface?)

(define-premium-feature enable-whitelabeling?
  :whitelabel)

Should we enable the Audit Logs interface in the Admin UI?

(define-premium-feature enable-audit-app?
  :audit-app)

Should we enable restrict email domains for subscription recipients?

(define-premium-feature ^{:added "0.41.0"} enable-email-allow-list?
  :email-allow-list)

Should we enable granular controls for cache TTL at the database, dashboard, and card level?

(define-premium-feature ^{:added "0.41.0"} enable-cache-granular-controls?
  :cache-granular-controls)

Should we enable initialization on launch from a config file?

(define-premium-feature ^{:added "0.41.0"} enable-config-text-file?
  :config-text-file)

Should we enable data sandboxes (row-level permissions)?

(define-premium-feature enable-sandboxes?
  :sandboxes)

Should we enable JWT-based authentication?

(define-premium-feature enable-sso-jwt?
  :sso-jwt)

Should we enable SAML-based authentication?

(define-premium-feature enable-sso-saml?
  :sso-saml)

Should we enable advanced configuration for LDAP authentication?

(define-premium-feature enable-sso-ldap?
  :sso-ldap)

Should we enable advanced configuration for Google Sign-In authentication?

(define-premium-feature enable-sso-google?
  :sso-google)

Should we enable any SSO-based authentication?

(defn enable-any-sso?
  []
  (or (enable-sso-jwt?)
      (enable-sso-saml?)
      (enable-sso-ldap?)
      (enable-sso-google?)))

Should we enable configuring session timeouts?

(define-premium-feature enable-session-timeout-config?
  :session-timeout-config)

Can we disable login by password?

(define-premium-feature can-disable-password-login?
  :disable-password-login)

Should we enable filters for dashboard subscriptions?

(define-premium-feature ^{:added "0.41.0"} enable-dashboard-subscription-filters?
  :dashboard-subscription-filters)

Should we enable extra knobs around permissions (block access, and in the future, moderator roles, feature-level permissions, etc.)?

(define-premium-feature ^{:added "0.41.0"} enable-advanced-permissions?
  :advanced-permissions)

Should we enable verified content, like verified questions and models (and more in the future, like actions)?

(define-premium-feature ^{:added "0.41.0"} enable-content-verification?
  :content-verification)

Should we enable Official Collections?

(define-premium-feature ^{:added "0.41.0"} enable-official-collections?
  :official-collections)

Should we enable SQL snippet folders?

(define-premium-feature ^{:added "0.41.0"} enable-snippet-collections?
  :snippet-collections)

Enable the v2 SerDes functionality

(define-premium-feature ^{:added "0.45.0"} enable-serialization?
  :serialization)

Enable restrict email recipients?

(define-premium-feature ^{:added "0.47.0"} enable-email-restrict-recipients?
  :email-restrict-recipients)

Is the Metabase instance running in the cloud?

(defsetting is-hosted?
  :type       :boolean
  :visibility :public
  :setter     :none
  :audit      :never
  :getter     (fn [] (boolean ((token-features) "hosting")))
  :doc        false)

Should we various other enhancements, e.g. NativeQuerySnippet collection permissions?

enhancements are not currently a specific "feature" that EE tokens can have or not have. Instead, it's a catch-all term for various bits of EE functionality that we assume all EE licenses include. (This may change in the future.)

By checking whether (token-features) is non-empty we can see whether we have a valid EE token. If the token is valid, we can enable EE enhancements.

DEPRECATED -- it should now be possible to use the new 0.41.0+ features for everything previously covered by 'enhancements'.

(define-premium-feature ^:deprecated enable-enhancements?
  :enhancements
  :getter #(and config/ee-available? (has-any-features?)))

+----------------------------------------------------------------------------------------------------------------+ | Defenterprise Macro | +----------------------------------------------------------------------------------------------------------------+

Is the current namespace an Enterprise Edition namespace?

(defn- in-ee?
  []
  (str/starts-with? (ns-name *ns*) "metabase-enterprise"))

A map from fully-qualified EE function names to maps which include their EE and OSS implementations, as well as any additional options. This information is used to dynamically dispatch a call to the right implementation, depending on the available feature flags.

   For example:
     {ee-ns/ee-fn-name {:oss      oss-fn
                        :ee       ee-fn
                        :feature  :embedding
                        :fallback :oss}
(defonce
  registry
  (atom {}))

Adds new values to the registry, associated with the provided function name.

(defn register-mapping!
  [ee-fn-name values]
  (swap! registry update ee-fn-name merge values))
(defn- check-feature
  [feature]
  (or (= feature :none)
      (has-feature? feature)))

Dynamically tries to require an enterprise namespace and determine the correct implementation to call, based on the availability of EE code and the necessary premium feature. Returns a fn which, when invoked, applies its args to one of the EE implementation, the OSS implementation, or the fallback function.

(defn dynamic-ee-oss-fn
  [ee-ns ee-fn-name]
  (fn [& args]
    (u/ignore-exceptions (classloader/require ee-ns))
    (let [{:keys [ee oss feature fallback]} (get @registry ee-fn-name)]
      (cond
        (and ee (check-feature feature))
        (apply ee args)
        (and ee (fn? fallback))
        (apply fallback args)
        :else
        (apply oss args)))))

Throws an exception if the required :feature option is not present.

(defn- validate-ee-args
  [{feature :feature :as options}]
  (when-not feature
    (throw (ex-info (trs "The :feature option is required when using defenterprise in an EE namespace!")
                    {:options options}))))

The exception to throw when the provided option is not included in the options map.

(defn- oss-options-error
  [option options]
  (ex-info (trs "{0} option for defenterprise should not be set in an OSS namespace! Set it on the EE function instead." option)
           {:options options}))

Throws exceptions if EE options are provided, or if an EE namespace is not provided.

(defn validate-oss-args
  [ee-ns {:keys [feature fallback] :as options}]
  (when-not ee-ns
    (throw (Exception. (str (trs "An EE namespace must be provided when using defenterprise in an OSS namespace!")
                            " "
                            (trs "Add it immediately before the argument list.")))))
  (when feature (throw (oss-options-error :feature options)))
  (when fallback (throw (oss-options-error :fallback options))))

The exception to throw when defenterprise is used without a docstring.

(defn- docstr-exception
  [fn-name]
  (Exception. (tru "Enterprise function {0}/{1} does not have a docstring. Go add one!" (ns-name *ns*) fn-name)))

Impl macro for defenterprise and defenterprise-schema. Don't use this directly.

(defmacro defenterprise-impl
  [{:keys [fn-name docstr ee-ns fn-tail options schema? return-schema]}]
  (when-not docstr (throw (docstr-exception fn-name)))
  (let [oss-or-ee (if (in-ee?) :ee :oss)]
    (case oss-or-ee
      :ee  (validate-ee-args options)
      :oss (validate-oss-args '~ee-ns options))
    `(let [ee-ns#        '~(or ee-ns (ns-name *ns*))
           ee-fn-name#   (symbol (str ee-ns# "/" '~fn-name))
           oss-or-ee-fn# ~(if schema?
                            `(mu/fn ~(symbol (str fn-name)) :- ~return-schema ~@fn-tail)
                            `(fn ~(symbol (str fn-name)) ~@fn-tail))]
       (register-mapping! ee-fn-name# (merge ~options {~oss-or-ee oss-or-ee-fn#}))
       (def
         ~(vary-meta fn-name assoc :arglists ''([& args]))
         ~docstr
         (dynamic-ee-oss-fn ee-ns# ee-fn-name#)))))
(defn- options-conformer
  [conformed-options]
  (into {} (map (comp (juxt :k :v) second) conformed-options)))
(s/def ::defenterprise-options
  (s/&
   (s/*
    (s/alt
     :feature  (s/cat :k #{:feature}  :v keyword?)
     :fallback (s/cat :k #{:fallback} :v #(or (#{:oss} %) (symbol? %)))))
   (s/conformer options-conformer)))
(s/def ::defenterprise-args
  (s/cat :docstr  (s/? string?)
         :ee-ns   (s/? symbol?)
         :options (s/? ::defenterprise-options)
         :fn-tail (s/* any?)))
(s/def ::defenterprise-schema-args
  (s/cat :return-schema      (s/? (s/cat :- #{:-}
                                             :schema any?))
         :defenterprise-args (s/? ::defenterprise-args)))

Defines a function that has separate implementations between the Metabase Community Edition (aka OSS) and Enterprise Edition (EE).

When used in a OSS namespace, defines a function that should have a corresponding implementation in an EE namespace (using the same macro). The EE implementation will be used preferentially to the OSS implementation if it is available. The first argument after the function name should be a symbol of the namespace containing the EE implementation. The corresponding EE function must have the same name as the OSS function.

When used in an EE namespace, the namespace of the corresponding OSS implementation does not need to be included -- it will be inferred automatically, as long as a corresponding [[defenterprise]] call exists in an OSS namespace.

Two additional options can be defined, when using this macro in an EE namespace. These options should be defined immediately before the args list of the function:

`:feature`

A keyword representing a premium feature which must be present for the EE implementation to be used. Use :none to always run the EE implementation if available, regardless of token (WARNING: this is not recommended for most use cases. You probably want to gate your code by a specific premium feature.)

`:fallback`

The keyword :oss, or a function representing the fallback mechanism which should be used if the instance does not have the premium feature defined by the :feature option. If a function is provided, it will be called with the same args as the EE function. If :oss is provided, it causes the OSS implementation of the function to be called. (Default: :oss)

(defmacro defenterprise
  [fn-name & defenterprise-args]
  {:pre [(symbol? fn-name)]}
  (let [parsed-args (s/conform ::defenterprise-args defenterprise-args)
        _           (when (s/invalid? parsed-args)
                      (throw (ex-info "Failed to parse defenterprise args"
                                      (s/explain-data ::defenterprise-args parsed-args))))
        args        (assoc parsed-args :fn-name fn-name)]
    `(defenterprise-impl ~args)))

A version of defenterprise which allows for schemas to be defined for the args and return value. Schema syntax is the same as when using mu/defn. Otherwise identical to defenterprise; see the docstring of that macro for usage details.

(defmacro defenterprise-schema
  [fn-name & defenterprise-args]
  {:pre [(symbol? fn-name)]}
  (let [parsed-args (s/conform ::defenterprise-schema-args defenterprise-args)
        _           (when (s/invalid? parsed-args)
                      (throw (ex-info "Failed to parse defenterprise-schema args"
                                      (s/explain-data ::defenterprise-schema-args parsed-args))))
        args        (-> (:defenterprise-args parsed-args)
                        (assoc :schema? true)
                        (assoc :return-schema (-> parsed-args :return-schema :schema))
                        (assoc :fn-name fn-name))]
    `(defenterprise-impl ~args)))

Returns a boolean if the current user uses sandboxing for any database. In OSS this is always false. Will throw an error if [[api/current-user-id]] is not bound.

(defenterprise sandboxed-user?
  metabase-enterprise.sandbox.api.util
  []
  (when-not api/*current-user-id*
    ;; If no *current-user-id* is bound we can't check for sandboxes, so we should throw in this case to avoid
    ;; returning `false` for users who should actually be sandboxes.
    (throw (ex-info (str (tru "No current user found"))
                    {:status-code 403})))
  ;; oss doesn't have sandboxing. But we throw if no current-user-id so the behavior doesn't change when ee version
  ;; becomes available
  false)

Returns a boolean if the current user uses connection impersonation for any database. In OSS this is always false. Will throw an error if [[api/current-user-id]] is not bound.

(defenterprise impersonated-user?
  metabase-enterprise.advanced-permissions.api.util
  []
  (when-not api/*current-user-id*
    ;; If no *current-user-id* is bound we can't check for impersonations, so we should throw in this case to avoid
    ;; returning `false` for users who should actually be using impersonations.
    (throw (ex-info (str (tru "No current user found"))
                    {:status-code 403})))
  ;; oss doesn't have connection impersonation. But we throw if no current-user-id so the behavior doesn't change when
  ;; ee version becomes available
  false)

Returns a boolean if the current user uses sandboxing or connection impersonation for any database. In OSS is always false. Will throw an error if [[api/current-user-id]] is not bound.

(defn sandboxed-or-impersonated-user?
  []
  (or (sandboxed-user?)
      (impersonated-user?)))
 

Public API for sending Pulses.

(ns metabase.pulse
  (:require
   [clojure.string :as str]
   [metabase.api.common :as api]
   [metabase.config :as config]
   [metabase.email :as email]
   [metabase.email.messages :as messages]
   [metabase.events :as events]
   [metabase.integrations.slack :as slack]
   [metabase.models.dashboard :as dashboard :refer [Dashboard]]
   [metabase.models.dashboard-card :as dashboard-card]
   [metabase.models.database :refer [Database]]
   [metabase.models.interface :as mi]
   [metabase.models.pulse :as pulse :refer [Pulse]]
   [metabase.models.serialization :as serdes]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.public-settings :as public-settings]
   [metabase.pulse.markdown :as markdown]
   [metabase.pulse.parameters :as pulse-params]
   [metabase.pulse.render :as render]
   [metabase.pulse.util :as pu]
   [metabase.query-processor :as qp]
   [metabase.query-processor.dashboard :as qp.dashboard]
   [metabase.query-processor.timezone :as qp.timezone]
   [metabase.server.middleware.session :as mw.session]
   [metabase.shared.parameters.parameters :as shared.params]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.retry :as retry]
   [metabase.util.ui-logic :as ui-logic]
   [metabase.util.urls :as urls]
   [toucan2.core :as t2])
  (:import
   (clojure.lang ExceptionInfo)))

------------------------------------------------- PULSE SENDING --------------------------------------------------

Check if the card is empty

(defn- is-card-empty?
  [card]
  (if-let [result (:result card)]
    (or (zero? (-> result :row_count))
        ;; Many aggregations result in [[nil]] if there are no rows to aggregate after filters
        (= [[nil]]
           (-> result :data :rows)))
    ;; Text cards have no result; treat as empty
    true))

For the specific case of Dashboard Subscriptions we should use :default parameter values as the actual :value for the parameter if none is specified. Normally the FE client will take :default and pass it in as :value if it wants to use it (see #20503 for more details) but this obviously isn't an option for Dashboard Subscriptions... so go thru parameters and change :default to :value unless a :value is explicitly specified.

(defn- merge-default-values
  [parameters]
  (for [{default-value :default, :as parameter} parameters]
    (merge
     (when default-value
       {:value default-value})
     (dissoc parameter :default))))

Returns subscription result for a card.

This function should be executed under pulse's creator permissions.

(defn- execute-dashboard-subscription-card
  [dashboard dashcard card-or-id parameters]
  (assert api/*current-user-id* "Makes sure you wrapped this with a `with-current-user`.")
  (try
    (let [card-id (u/the-id card-or-id)
          card    (t2/select-one :model/Card :id card-id)
          result  (qp.dashboard/run-query-for-dashcard-async
                   :dashboard-id  (u/the-id dashboard)
                   :card-id       card-id
                   :dashcard-id   (u/the-id dashcard)
                   :context       :pulse ; TODO - we should support for `:dashboard-subscription` and use that to differentiate the two
                   :export-format :api
                   :parameters    parameters
                   :middleware    {:process-viz-settings? true
                                   :js-int-to-string?     false}
                   :run           (fn [query info]
                                    (qp/process-query-and-save-with-max-results-constraints!
                                     (assoc query :async? false)
                                     info)))]
      (when-not (and (get-in dashcard [:visualization_settings :card.hide_empty]) (is-card-empty? result))
        {:card     card
         :dashcard dashcard
         :result   result
         :type     :card}))
    (catch Throwable e
      (log/warn e (trs "Error running query for Card {0}" card-or-id)))))

Check if dashcard is a virtual with type ttype, if true returns the dashcard, else returns nil.

There are currently 3 types of virtual card: "text", "action", "link".

(defn virtual-card-of-type?
  [dashcard ttype]
  (when (= ttype (get-in dashcard [:visualization_settings :virtual_card :display]))
    dashcard))
(defn- link-card-entity->url
  [{:keys [db_id id model] :as _entity}]
  (case model
    "card"       (urls/card-url id)
    "dataset"    (urls/card-url id)
    "collection" (urls/collection-url id)
    "dashboard"  (urls/dashboard-url id)
    "database"   (urls/database-url id)
    "table"      (urls/table-url db_id id)))
(defn- link-card->text-part
  [{:keys [entity url] :as _link-card}]
  (let [url-link-card? (some? url)]
    {:text (str (format
                  "### [%s](%s)"
                  (if url-link-card? url (:name entity))
                  (if url-link-card? url (link-card-entity->url entity)))
                (when-let [description (if url-link-card? nil (:description entity))]
                  (format "\n%s" description)))
     :type :text}))

Convert a dashcard that is a link card to pulse part.

This function should be executed under pulse's creator permissions.

(defn- dashcard-link-card->part
  [dashcard]
  (assert api/*current-user-id* "Makes sure you wrapped this with a `with-current-user`.")
  (let [link-card (get-in dashcard [:visualization_settings :link])]
    (cond
      (some? (:url link-card))
      (link-card->text-part link-card)
      ;; if link card link to an entity, update the setting because
      ;; the info in viz-settings might be out-of-date
      (some? (:entity link-card))
      (let [{:keys [model id]} (:entity link-card)
            instance           (t2/select-one
                                 (serdes/link-card-model->toucan-model model)
                                 (dashboard-card/link-card-info-query-for-model model id))]
        (when (mi/can-read? instance)
          (link-card->text-part (assoc link-card :entity instance)))))))
(defn- escape-heading-markdown
  [dashcard]
  (if (= "heading" (get-in dashcard [:visualization_settings :virtual_card :display]))
    (update-in dashcard [:visualization_settings :text] #(str "## " (shared.params/escape-chars % shared.params/escaped-chars-regex)))
    dashcard))

Given a dashcard returns its part based on its type.

The result will follow the pulse's creator permissions.

(defn- dashcard->part
  [dashcard pulse dashboard]
  (assert api/*current-user-id* "Makes sure you wrapped this with a `with-current-user`.")
  (cond
    (:card_id dashcard)
    (let [parameters (merge-default-values (pulse-params/parameters pulse dashboard))]
      (execute-dashboard-subscription-card dashboard dashcard (:card_id dashcard) parameters))
    ;; actions
    (virtual-card-of-type? dashcard "action")
    nil
    ;; link cards
    (virtual-card-of-type? dashcard "link")
    (dashcard-link-card->part dashcard)
    ;; text cards have existed for a while and I'm not sure if all existing text cards
    ;; will have virtual_card.display = "text", so assume everything else is a text card
    :else
    (let [parameters (merge-default-values (pulse-params/parameters pulse dashboard))]
      (-> dashcard
          (pulse-params/process-virtual-dashcard parameters)
          escape-heading-markdown
          :visualization_settings
          (assoc :type :text)))))
(defn- dashcards->part
  [dashcards pulse dashboard]
  (let [ordered-dashcards (sort dashboard-card/dashcard-comparator dashcards)]
    (doall (for [dashcard ordered-dashcards
                 :let     [part (dashcard->part dashcard pulse dashboard)]
                 :when    (some? part)]
             part))))
(defn- tab->part
  [{:keys [name]}]
  {:text name
   :type :tab-title})

Fetch all the dashcards in a dashboard for a Pulse, and execute non-text cards.

The gerenerated parts will follow the pulse's creator permissions.

(defn- execute-dashboard
  [{pulse-creator-id :creator_id, :as pulse} dashboard & {:as _options}]
  (let [dashboard-id      (u/the-id dashboard)]
    (mw.session/with-current-user pulse-creator-id
      (if (dashboard/has-tabs? dashboard)
        (let [tabs-with-cards (t2/hydrate (t2/select :model/DashboardTab :dashboard_id dashboard-id) :tab-cards)]
         (doall (flatten (for [{:keys [cards] :as tab} tabs-with-cards]
                           (concat [(tab->part tab)] (dashcards->part cards pulse dashboard))))))
        (dashcards->part (t2/select :model/DashboardCard :dashboard_id dashboard-id) pulse dashboard)))))
(defn- database-id [card]
  (or (:database_id card)
      (get-in card [:dataset_query :database])))
(mu/defn defaulted-timezone :- :string
  "Returns the timezone ID for the given `card`. Either the report timezone (if applicable) or the JVM timezone."
  [card :- (mi/InstanceOf :model/Card)]
  (or (some->> card database-id (t2/select-one Database :id) qp.timezone/results-timezone-id)
      (qp.timezone/system-timezone-id)))
(defn- first-question-name [pulse]
  (-> pulse :cards first :name))
(defn- alert-condition-type->description [condition-type]
  (case (keyword condition-type)
    :meets (trs "reached its goal")
    :below (trs "gone below its goal")
    :rows  (trs "results")))
(def ^:private block-text-length-limit 3000)
(def ^:private attachment-text-length-limit 2000)

If a mrkdwn string is greater than Slack's length limit, truncates it to fit the limit and adds an ellipsis character to the end.

(defn- truncate-mrkdwn
  [mrkdwn limit]
  (if (> (count mrkdwn) limit)
    (-> mrkdwn
        (subs 0 (dec limit))
        (str "…"))
    mrkdwn))
(defn- text->markdown-block
  [text]
  (let [mrkdwn (markdown/process-markdown text :slack)]
    (when (not (str/blank? mrkdwn))
      {:blocks [{:type "section"
                 :text {:type "mrkdwn"
                        :text (truncate-mrkdwn mrkdwn block-text-length-limit)}}]})))
(defn- part->attachment-data
  [part channel-id]
  (case (:type part)
    :card
    (let [{:keys [card dashcard result]}          part
          {card-id :id card-name :name :as card} card]
      {:title           (or (-> dashcard :visualization_settings :card.title)
                            card-name)
       :rendered-info   (render/render-pulse-card :inline (defaulted-timezone card) card dashcard result)
       :title_link      (urls/card-url card-id)
       :attachment-name "image.png"
       :channel-id      channel-id
       :fallback        card-name})
    :text
    (text->markdown-block (:text part))
    :tab-title
    (text->markdown-block (format "# %s" (:text part)))))

Returns a seq of slack attachment data structures, used in create-and-upload-slack-attachments!

(defn- create-slack-attachment-data
  [parts]
  (let [channel-id (slack/files-channel)]
    (for [part  parts
          :let  [attachment (part->attachment-data part channel-id)]
          :when attachment]
      attachment)))
(defn- subject
  [{:keys [name cards dashboard_id]}]
  (if (or dashboard_id
          (some :dashboard_id cards))
    name
    (trs "Pulse: {0}" name)))
(defn- filter-text
  [filter]
  (truncate-mrkdwn
   (format "*%s*\n%s" (:name filter) (pulse-params/value-string filter))
   attachment-text-length-limit))

Returns a block element that includes a dashboard's name, creator, and filters, for inclusion in a Slack dashboard subscription

(defn- slack-dashboard-header
  [pulse dashboard]
  (let [header-section  {:type "header"
                         :text {:type "plain_text"
                                :text (subject pulse)
                                :emoji true}}
        creator-section {:type   "section"
                         :fields [{:type "mrkdwn"
                                   :text (str "Sent by " (-> pulse :creator :common_name))}]}
        filters         (pulse-params/parameters pulse dashboard)
        filter-fields   (for [filter filters]
                          {:type "mrkdwn"
                           :text (filter-text filter)})
        filter-section  (when (seq filter-fields)
                          {:type   "section"
                           :fields filter-fields})]
    (if filter-section
      {:blocks [header-section filter-section creator-section]}
      {:blocks [header-section creator-section]})))

Returns a block element with the footer text and link which should be at the end of a Slack dashboard subscription.

(defn- slack-dashboard-footer
  [pulse dashboard]
  {:blocks
   [{:type "divider"}
    {:type "context"
     :elements [{:type "mrkdwn"
                 :text (str "<" (pulse-params/dashboard-url (u/the-id dashboard) (pulse-params/parameters pulse dashboard)) "|"
                            "*Sent from " (public-settings/site-name) "*>")}]}]})

Maximum width of the rendered PNG of HTML to be sent to Slack. Content that exceeds this width (e.g. a table with many columns) is truncated.

(def slack-width
  1200)

Create an attachment in Slack for a given Card by rendering its content into an image and uploading it. Slack-attachment-uploader is a function which takes image-bytes and an attachment name, uploads the file, and returns an image url, defaulting to slack/upload-file!.

Nested blocks lists containing text cards are passed through unmodified.

(defn create-and-upload-slack-attachments!
  ([attachments] (create-and-upload-slack-attachments! attachments slack/upload-file!))
  ([attachments slack-attachment-uploader]
   (letfn [(f [a] (select-keys a [:title :title_link :fallback]))]
     (reduce (fn [processed {:keys [rendered-info attachment-name channel-id] :as attachment-data}]
               (conj processed (if (:blocks attachment-data)
                                 attachment-data
                                 (if (:render/text rendered-info)
                                   (-> (f attachment-data)
                                       (assoc :text (:render/text rendered-info)))
                                   (let [image-bytes (render/png-from-render-info rendered-info slack-width)
                                         image-url   (slack-attachment-uploader image-bytes attachment-name channel-id)]
                                     (-> (f attachment-data)
                                         (assoc :image_url image-url)))))))
             []
             attachments))))

Do none of the cards have any results?

(defn- are-all-parts-empty?
  [results]
  (every? is-card-empty? results))
(defn- goal-met? [{:keys [alert_above_goal], :as pulse} [first-result]]
  (let [goal-comparison      (if alert_above_goal >= <)
        goal-val             (ui-logic/find-goal-value first-result)
        comparison-col-rowfn (ui-logic/make-goal-comparison-rowfn (:card first-result)
                                                            (get-in first-result [:result :data]))]
    (when-not (and goal-val comparison-col-rowfn)
      (throw (ex-info (tru "Unable to compare results to goal for alert.")
                      {:pulse  pulse
                       :result first-result})))
    (boolean
     (some (fn [row]
             (goal-comparison (comparison-col-rowfn row) goal-val))
           (get-in first-result [:result :data :rows])))))

+----------------------------------------------------------------------------------------------------------------+ | Creating Notifications To Send | +----------------------------------------------------------------------------------------------------------------+

(defn- alert-or-pulse [pulse]
  (if (:alert_condition pulse)
    :alert
    :pulse))

Returns true if given the pulse type and resultset a new notification (pulse or alert) should be sent

(defmulti ^:private should-send-notification?
  (fn [pulse _parts] (alert-or-pulse pulse)))
(defmethod should-send-notification? :alert
  [{:keys [alert_condition] :as alert} parts]
  (cond
    (= "rows" alert_condition)
    (not (are-all-parts-empty? parts))

    (= "goal" alert_condition)
    (goal-met? alert parts)

    :else
    (let [^String error-text (tru "Unrecognized alert with condition ''{0}''" alert_condition)]
      (throw (IllegalArgumentException. error-text)))))
(defmethod should-send-notification? :pulse
  [pulse parts]
  (if (:skip_if_empty pulse)
    (not (are-all-parts-empty? parts))
    true))
(defn- parts->cards-count
  [parts]
  (count (filter #(some? (#{:text :card} (:type %))) parts)))

Polymorphic function for creating notifications. This logic is different for pulse type (i.e. alert vs. pulse) and channel_type (i.e. email vs. slack)

'notification' used below means a map that has information needed to send a Pulse/Alert, including results of running the underlying query

(defmulti ^:private notification
  {:arglists '([alert-or-pulse parts channel])}
  (fn [pulse _ {:keys [channel_type]}]
    [(alert-or-pulse pulse) (keyword channel_type)]))
(defn- construct-pulse-email [subject recipients message]
  {:subject      subject
   :recipients   recipients
   :message-type :attachments
   :message      message})
(defmethod notification [:pulse :email]
  [{pulse-id :id, pulse-name :name, dashboard-id :dashboard_id, :as pulse} parts {:keys [recipients]}]
  (log/debug (u/format-color 'cyan (trs "Sending Pulse ({0}: {1}) with {2} Cards via email"
                                        pulse-id (pr-str pulse-name) (parts->cards-count parts))))
  (let [user-recipients     (filter (fn [recipient] (and (u/email? (:email recipient))
                                                         (some? (:id recipient)))) recipients)
        non-user-recipients (filter (fn [recipient] (and (u/email? (:email recipient))
                                                         (nil? (:id recipient)))) recipients)
        timezone            (->> parts (some :card) defaulted-timezone)
        dashboard           (update (t2/select-one Dashboard :id dashboard-id) :description markdown/process-markdown :html)
        email-to-users      (when (> (count user-recipients) 0)
                              (construct-pulse-email (subject pulse) (mapv :email user-recipients) (messages/render-pulse-email timezone pulse dashboard parts nil)))
        email-to-nonusers   (for [non-user (map :email non-user-recipients)]
                              (construct-pulse-email (subject pulse) [non-user] (messages/render-pulse-email timezone pulse dashboard parts non-user)))]
    (if email-to-users
      (conj email-to-nonusers email-to-users)
      email-to-nonusers)))
(defmethod notification [:pulse :slack]
  [{pulse-id :id, pulse-name :name, dashboard-id :dashboard_id, :as pulse}
   parts
   {{channel-id :channel} :details}]
  (log/debug (u/format-color 'cyan (trs "Sending Pulse ({0}: {1}) with {2} Cards via Slack"
                                        pulse-id (pr-str pulse-name) (parts->cards-count parts))))
  (let [dashboard (t2/select-one Dashboard :id dashboard-id)]
    {:channel-id  channel-id
     :attachments (remove nil?
                          (flatten [(slack-dashboard-header pulse dashboard)
                                    (create-slack-attachment-data parts)
                                    (when dashboard (slack-dashboard-footer pulse dashboard))]))}))
(defmethod notification [:alert :email]
  [{:keys [id] :as pulse} parts channel]
  (log/debug (trs "Sending Alert ({0}: {1}) via email" id name))
  (let [condition-kwd       (messages/pulse->alert-condition-kwd pulse)
        email-subject       (trs "Alert: {0} has {1}"
                                 (first-question-name pulse)
                                 (alert-condition-type->description condition-kwd))
        user-recipients     (filter (fn [recipient] (and (u/email? (:email recipient))
                                                         (some? (:id recipient)))) (:recipients channel))
        non-user-recipients (filter (fn [recipient] (and (u/email? (:email recipient))
                                                         (nil? (:id recipient)))) (:recipients channel))
        first-part          (some :card parts)
        timezone            (defaulted-timezone first-part)
        email-to-users      (when (> (count user-recipients) 0)
                              (construct-pulse-email email-subject (mapv :email user-recipients) (messages/render-alert-email timezone pulse channel parts (ui-logic/find-goal-value first-part) nil)))
        email-to-nonusers   (for [non-user (map :email non-user-recipients)]
                              (construct-pulse-email email-subject [non-user] (messages/render-alert-email timezone pulse channel parts (ui-logic/find-goal-value first-part) non-user)))]
       (if email-to-users
         (conj email-to-nonusers email-to-users)
         email-to-nonusers)))
(defmethod notification [:alert :slack]
  [pulse parts {{channel-id :channel} :details}]
  (log/debug (u/format-color 'cyan (trs "Sending Alert ({0}: {1}) via Slack" (:id pulse) (:name pulse))))
  {:channel-id  channel-id
   :attachments (cons {:blocks [{:type "header"
                                 :text {:type "plain_text"
                                        :text (str "🔔 " (first-question-name pulse))
                                        :emoji true}}]}
                      (create-slack-attachment-data parts))})
(defmethod notification :default
  [_ _ {:keys [channel_type]}]
  (throw (UnsupportedOperationException. (tru "Unrecognized channel type {0}" (pr-str channel_type)))))
(defn- parts->notifications [{:keys [channels channel-ids], pulse-id :id, :as pulse} parts]
  (let [channel-ids (or channel-ids (mapv :id channels))]
    (when (should-send-notification? pulse parts)
      (let [event-type (if (= :pulse (alert-or-pulse pulse))
                         :event/subscription-send
                         :event/alert-send)]
        (events/publish-event! event-type {:id      (:id pulse)
                                           :user-id (:creator_id pulse)
                                           :object  {:recipients (map :recipients (:channels pulse))
                                                     :filters    (:parameters pulse)}}))
      (when (:alert_first_only pulse)
        (t2/delete! Pulse :id pulse-id))
      ;; `channel-ids` is the set of channels to send to now, so only send to those. Note the whole set of channels
      (for [channel channels
            :when   (contains? (set channel-ids) (:id channel))]
        (notification pulse parts channel)))))

Execute the underlying queries for a sequence of Pulses and return the parts as 'notification' maps.

(defn- pulse->notifications
  [{:keys [cards], pulse-id :id, :as pulse} dashboard]
  (parts->notifications pulse
                        (if dashboard
                          ;; send the dashboard
                          (execute-dashboard pulse dashboard)
                          ;; send the cards instead
                          (for [card cards
                                ;; Pulse ID may be `nil` if the Pulse isn't saved yet
                                :let [part (assoc (pu/execute-card pulse (u/the-id card) :pulse-id pulse-id) :type :card)]
                                ;; some cards may return empty part, e.g. if the card has been archived
                                :when part]
                            part))))

+----------------------------------------------------------------------------------------------------------------+ | Sending Notifications | +----------------------------------------------------------------------------------------------------------------+

Invokes the side-effecty function for sending emails/slacks depending on the notification type

(defmulti ^:private send-notification!
  {:arglists '([pulse-or-alert])}
  (fn [{:keys [channel-id]}]
    (if channel-id :slack :email)))
(defmethod send-notification! :slack
  [{:keys [channel-id message attachments]}]
  (let [attachments (create-and-upload-slack-attachments! attachments)]
    (try
      (slack/post-chat-message! channel-id message attachments)
      (catch ExceptionInfo e
        ;; Token errors have already been logged and we should not retry.
        (when-not (contains? (:errors (ex-data e)) :slack-token)
          (throw e))))))
(defmethod send-notification! :email
  [emails]
  (doseq [{:keys [subject recipients message-type message]} emails]
    (try
      (email/send-message-or-throw! {:subject      subject
                                     :recipients   recipients
                                     :message-type message-type
                                     :message      message
                                     :bcc?         (email/bcc-enabled?)})
      (catch ExceptionInfo e
        (when (not= :smtp-host-not-set (:cause (ex-data e)))
          (throw e))))))
(declare ^:private reconfigure-retrying)
(defsetting notification-retry-max-attempts
  (deferred-tru "The maximum number of attempts for delivering a single notification.")
  :type :integer
  :default 7
  :on-change reconfigure-retrying)
(defsetting notification-retry-initial-interval
  (deferred-tru "The initial retry delay in milliseconds when delivering notifications.")
  :type :integer
  :default 500
  :on-change reconfigure-retrying)
(defsetting notification-retry-multiplier
  (deferred-tru "The delay multiplier between attempts to deliver a single notification.")
  :type :double
  :default 2.0
  :on-change reconfigure-retrying)
(defsetting notification-retry-randomization-factor
  (deferred-tru "The randomization factor of the retry delay when delivering notifications.")
  :type :double
  :default 0.1
  :on-change reconfigure-retrying)
(defsetting notification-retry-max-interval-millis
  (deferred-tru "The maximum delay between attempts to deliver a single notification.")
  :type :integer
  :default 30000
  :on-change reconfigure-retrying)
(defn- retry-configuration []
  (cond-> {:max-attempts (notification-retry-max-attempts)
           :initial-interval-millis (notification-retry-initial-interval)
           :multiplier (notification-retry-multiplier)
           :randomization-factor (notification-retry-randomization-factor)
           :max-interval-millis (notification-retry-max-interval-millis)}
    (or config/is-dev? config/is-test?) (assoc :max-attempts 1)))

Returns a notification sender wrapping [[send-notifications!]] retrying according to retry-configuration.

(defn- make-retry-state
  []
  (let [retry (retry/random-exponential-backoff-retry "send-notification-retry"
                                                      (retry-configuration))]
    {:retry retry
     :sender (retry/decorate send-notification! retry)}))

Stores the current retry state. Updated whenever the notification retry settings change. It starts with value nil but is set whenever the settings change or when the first call with retry is made. (See #22790 for more details.)

(defonce
  ^{:private true
    :doc }
  retry-state
  (atom nil))
(defn- reconfigure-retrying [_old-value _new-value]
  (log/info (trs "Reconfiguring notification sender"))
  (reset! retry-state (make-retry-state)))

Like [[send-notification!]] but retries sending on errors according to the retry settings.

(defn- send-notification-retrying!
  [& args]
  (when-not @retry-state
    (compare-and-set! retry-state nil (make-retry-state)))
  (apply (:sender @retry-state) args))
(defn- send-notifications! [notifications]
  (doseq [notification notifications]
    ;; do a try-catch around each notification so if one fails, we'll still send the other ones for example, an Alert
    ;; set up to send over both Slack & email: if Slack fails, we still want to send the email (#7409)
    (try
      (send-notification-retrying! notification)
      (catch Throwable e
        (log/error e (trs "Error sending notification!"))))))

Execute and Send a Pulse, optionally specifying the specific PulseChannels. This includes running each PulseCard, formatting the content, and sending the content to any specified destination.

channel-ids is the set of channel IDs to send to now -- this may be a subset of the full set of channels for the Pulse.

Example: (send-pulse! pulse) Send to all Channels (send-pulse! pulse :channel-ids [312]) Send only to Channel with :id = 312

(defn send-pulse!
  [{:keys [dashboard_id], :as pulse} & {:keys [channel-ids]}]
  {:pre [(map? pulse) (integer? (:creator_id pulse))]}
  (let [dashboard (t2/select-one Dashboard :id dashboard_id)
        pulse     (-> (mi/instance Pulse pulse)
                      ;; This is usually already done by this step, in the `send-pulses` task which uses `retrieve-pulse`
                      ;; to fetch the Pulse.
                      pulse/hydrate-notification
                      (merge (when channel-ids {:channel-ids channel-ids})))]
    (when (not (:archived dashboard))
      (send-notifications! (pulse->notifications pulse dashboard)))))
 
(ns metabase.pulse.markdown
  (:require
   [clojure.edn :as edn]
   [clojure.java.io :as io]
   [clojure.string :as str]
   [clojure.walk :as walk]
   [metabase.public-settings :as public-settings]
   [metabase.util :as u])
  (:import
   (com.vladsch.flexmark.ast AutoLink BlockQuote BulletList BulletListItem Code Emphasis FencedCodeBlock HardLineBreak
                             Heading HtmlBlock HtmlCommentBlock HtmlEntity HtmlInline HtmlInlineBase HtmlInlineComment
                             HtmlInnerBlockComment Image ImageRef IndentedCodeBlock Link LinkRef MailLink OrderedList
                             OrderedListItem Paragraph Reference SoftLineBreak StrongEmphasis Text ThematicBreak)
   (com.vladsch.flexmark.ext.autolink AutolinkExtension)
   (com.vladsch.flexmark.html HtmlRenderer LinkResolver LinkResolverFactory)
   (com.vladsch.flexmark.html.renderer LinkResolverBasicContext LinkStatus)
   (com.vladsch.flexmark.parser Parser)
   (com.vladsch.flexmark.util.ast Document Node)
   (com.vladsch.flexmark.util.data MutableDataSet)
   (java.net URI)))
(set! *warn-on-reflection* true)

+----------------------------------------------------------------------------------------------------------------+ | Markdown parsing | +----------------------------------------------------------------------------------------------------------------+

An instance of a Flexmark parser

(def ^:private parser
  (let [options (.. (MutableDataSet.)
                    (set Parser/EXTENSIONS [(AutolinkExtension/create)]))]
    (.build (Parser/builder options))))

Mappings from Flexmark AST nodes to keyword tags

(def ^:private node-to-tag-mapping
  {Document              :document
   Paragraph             :paragraph
   ThematicBreak         :horizontal-line
   HardLineBreak         :hard-line-break
   SoftLineBreak         :soft-line-break
   Heading               :heading
   StrongEmphasis        :bold
   Emphasis              :italic
   OrderedList           :ordered-list
   BulletList            :unordered-list
   OrderedListItem       :list-item
   BulletListItem        :list-item
   Code                  :code
   FencedCodeBlock       :codeblock
   IndentedCodeBlock     :codeblock
   BlockQuote            :blockquote
   Link                  :link
   Reference             :reference
   LinkRef               :link-ref
   ImageRef              :image-ref
   Image                 :image
   AutoLink              :auto-link
   MailLink              :mail-link
   HtmlEntity            :html-entity
   HtmlBlock             :html-block
   HtmlInline            :html-inline
   HtmlCommentBlock      :html-comment-block
   HtmlInlineBase        :html-inline-base
   HtmlInlineComment     :html-inline-comment
   HtmlInnerBlockComment :html-inner-block-comment})
(defn- node-to-tag
  [node]
  (node-to-tag-mapping (type node)))
(defprotocol ^:private ASTNode
  (to-clojure [this]))
(defn- convert-children [node]
  (map to-clojure (.getChildren ^Node node)))
(extend-protocol ASTNode
  Node
  (to-clojure [this]
    {:tag     (node-to-tag this)
     :attrs   {}
     :content (convert-children this)})

  Text
  (to-clojure [this]
    (str (.getChars this)))

  FencedCodeBlock
  (to-clojure [this]
    {:tag     (node-to-tag this)
     :attrs   {}
     :content (str (.getContentChars this))})

  IndentedCodeBlock
  (to-clojure [this]
    {:tag     (node-to-tag this)
     :attrs   {}
     :content (str (.getContentChars this))})

  Link
  (to-clojure [this]
    {:tag     (node-to-tag this)
     :attrs   {:href (str (.getUrl this))
               :title (not-empty (str (.getTitle this)))}
     :content (convert-children this)})

  Reference
  (to-clojure [this]
    {:tag   (node-to-tag this)
     :attrs {:title (not-empty (str (.getTitle this)))
             :label (str (.getReference this))
             :url (str (.getUrl this))}})

  LinkRef
  (to-clojure [this]
    {:tag     (node-to-tag this)
     :attrs   {:reference (-> (.getDocument this)
                              (.get Parser/REFERENCES)
                              (get (u/lower-case-en (str (.getReference this))))
                              to-clojure)}
     :content (convert-children this)})

  ImageRef
  (to-clojure [this]
    {:tag     (node-to-tag this)
     :attrs   {:reference (-> (.getDocument this)
                              (.get Parser/REFERENCES)
                              (get (u/lower-case-en (str (.getReference this))))
                              to-clojure)}
     :content (convert-children this)})

  Image
  (to-clojure [this]
    {:tag   (node-to-tag this)
     :attrs {:src (str (.getUrl this))
             :alt (str (.getText this))
             :title (not-empty (str (.getTitle this)))}})

  AutoLink
  (to-clojure [this]
    {:tag   (node-to-tag this)
     :attrs {:href (str (.getUrl this))}})

  MailLink
  (to-clojure [this]
    {:tag   (node-to-tag this)
     :attrs {:address (str (.getText this))}})

  HtmlEntity
  (to-clojure [this]
    {:tag (node-to-tag this)
     :content (str (.getChars this))})

  HtmlBlock
  (to-clojure [this]
    (str (.getChars this)))

  HtmlInline
  (to-clojure [this]
    (str (.getChars this)))

  HtmlCommentBlock
  (to-clojure [this]
    (str (.getChars this)))

  HtmlInlineComment
  (to-clojure [this]
    (str (.getChars this)))

  nil
  (to-clojure [_this]
    nil))

+----------------------------------------------------------------------------------------------------------------+ | Slack markup generation | +----------------------------------------------------------------------------------------------------------------+

(def ^:private html-entities
  (delay (edn/read-string (slurp (io/resource "html-entities.edn")))))
(def ^:private escaped-chars-regex
  #"\\[\\/*_`'\[\](){}<>#+-.!$@%^&=|\?~]")

Insert zero-width characters before and after certain characters that are escaped in the Markdown (or are otherwise parsed as plain text) to prevent them from being parsed as formatting in Slack.

(defn- escape-text
  [string]
  (-> string
      ;; First, remove backslashes from escaped formatting characters since they're not removed during Markdown parsing
      (str/replace escaped-chars-regex #(str (second %1)))
      ;; Add a soft hyphen around certain chars to avoid triggering formatting in Slack
      (str/replace "&" "\u00ad&\u00ad")
      (str/replace ">" "\u00ad>\u00ad")
      (str/replace "<" "\u00ad<\u00ad")
      (str/replace "*" "\u00ad*\u00ad")
      (str/replace "_" "\u00ad_\u00ad")
      (str/replace "`" "\u00ad`\u00ad")
      (str/replace "~" "\u00ad~\u00ad")))

If the provided URI is a relative path, resolve it relative to the site URL so that links work correctly in Slack/Email.

(defn- resolve-uri
  [^String uri]
  (letfn [(ensure-slash [s] (when s
                              (cond-> s
                                (not (str/ends-with? s "/")) (str "/"))))]
    (when uri
      (if-let [^String site-url (ensure-slash (public-settings/site-url))]
        (.. (URI. site-url) (resolve uri) toString)
        uri))))

Given the value from the :content field of a Markdown AST node, and a keyword representing a tag type, converts all instances of the tag in the content to :default tags. This is used to suppress rendering of nested bold and italic tags, which Slack doesn't support.

(defn- ^:private strip-tag
  [content tag]
  (walk/postwalk
   (fn [node]
     (if (and (map? node) (= (:tag node) tag))
        (assoc node :tag :default)
        node))
   content))

Takes an AST representing Markdown input, and converts it to a string that will render nicely in Slack.

Some of the differences to Markdown include: * All headers are just rendered as bold text. * Ordered and unordered lists are printed in plain text. * Inline images are rendered as text that links to the image source, e.g. .

(defmulti ast->slack
  :tag)

Given the value from the :content field of a Markdown AST node, recursively resolves subnodes into a nested list of strings.

(defn ^:private resolved-content
  [content]
  (if (string? content)
    (escape-text content)
    (map #(if (string? %)
            (escape-text %)
            (ast->slack %))
         content)))

Given the resolved content of a Markdown AST node, converts it into a single flattened string. This is used for rendering a couple specific types of nodes, such as list items.

(defn ^:private resolved-content-string
  [resolved-content]
  (-> resolved-content
      flatten
      str/join))

Given the value from the :content field of a Markdown AST node, recursively resolves it and returns a list of strings corresponding to individual lines in the result.

(defn ^:private resolved-lines
  [content]
  (-> content
      resolved-content
      resolved-content-string
      str/split-lines))
(defmethod ast->slack :default
  [{content :content}]
  (resolved-content content))
(defmethod ast->slack :document
  [{content :content}]
  (resolved-content content))
(defmethod ast->slack :paragraph
  [{content :content}]
  [(resolved-content content) "\n"])
(defmethod ast->slack :soft-line-break
  [_]
  " ")
(defmethod ast->slack :hard-line-break
  [_]
  "\n")
(defmethod ast->slack :horizontal-line
  [_]
  "\n───────────────────\n")
(defmethod ast->slack :heading
  [{content :content}]
  ["*" (resolved-content content) "*\n"])
(defmethod ast->slack :bold
  [{content :content}]
  ["*" (resolved-content (strip-tag content :bold)) "*"])
(defmethod ast->slack :italic
  [{content :content}]
  ["_" (resolved-content (strip-tag content :italic)) "_"])
(defmethod ast->slack :code
  [{content :content}]
  ["`" (resolved-content content) "`"])
(defmethod ast->slack :codeblock
  [{content :content}]
  ["```\n" (resolved-content content) "```"])
(defmethod ast->slack :blockquote
  [{content :content}]
  (let [lines (resolved-lines content)]
    (interpose "\n" (map (fn [line] [">" line]) lines))))
(defmethod ast->slack :link
  [{:keys [content attrs]}]
  (let [resolved-uri     (resolve-uri (:href attrs))
        resolved-content (resolved-content content)]
    (if (contains? #{:image :image-ref} (:tag (first content)))
      ;; If this is a linked image, add link target on separate line after image placeholder
      [resolved-content "\n(" resolved-uri ")"]
      ["<" resolved-uri "|" resolved-content ">"])))
(defmethod ast->slack :link-ref
  [{:keys [content attrs]}]
  (let [resolved-uri     (resolve-uri (-> attrs :reference :attrs :url))
        resolved-content (resolved-content content)]
    (if resolved-uri
      ["<" resolved-uri "|" resolved-content ">"]
      ;; If this was parsed as a link-ref but has no reference, assume it was just a pair of square brackets and
      ;; restore them. This is a known discrepency between flexmark-java and Markdown rendering on the frontend.
      ["[" resolved-content "]"])))
(defmethod ast->slack :auto-link
  [{{href :href} :attrs}]
  ["<" href ">"])
(defmethod ast->slack :mail-link
  [{{address :address} :attrs}]
  ["<mailto:"  address "|" address ">"])
(defmethod ast->slack :list-item
  [{content :content}]
  (let [resolved-content (resolved-content content)
        ;; list items might have nested lists or other elements, which should have their indentation level increased
        indented-content (->> (rest resolved-content)
                              resolved-content-string
                              str/split-lines
                              (map #(str "    " %))
                              (str/join "\n"))]
    (if-not (str/blank? indented-content)
      [(first resolved-content) indented-content "\n"]
      resolved-content)))
(defmethod ast->slack :unordered-list
  [{content :content}]
  (map (fn [list-item] ["• " list-item])
       (resolved-content content)))
(defmethod ast->slack :ordered-list
  [{content :content}]
  (map-indexed (fn [idx list-item] [(inc idx) ". " list-item])
               (resolved-content content)))
(defmethod ast->slack :image
  [{{:keys [src alt]} :attrs}]
  ;; Replace images with text that links to source, including alt text if available
  (if (str/blank? alt)
    ["<" src "|[Image]>"]
    ["<" src "|[Image: " alt "]>"]))
(defmethod ast->slack :image-ref
  [{:keys [content attrs]}]
  (let [src (-> attrs :reference :attrs :url)
        alt (-> content resolved-content resolved-content-string)]
    (if (str/blank? alt)
      ["<" src "|[Image]>"]
      ["<" src "|[Image: " alt "]>"])))
(defmethod ast->slack :html-entity
  [{content :content}]
  (some->> content
           (get @html-entities)
           (:characters)))

Returns true if this node was parsed as a link ref, but has no references. This probably means the original text was just a pair of square brackets, and not an actual link ref. This is a known discrepency between flexmark-java and Markdown rendering on the frontend.

(defn- empty-link-ref?
  [^Node node]
  (and (instance? LinkRef node)
       (-> (.getDocument node)
           (.get Parser/REFERENCES)
           empty?)))

An instance of a Flexmark HTML renderer

(def ^:private renderer
  (let [options    (.. (MutableDataSet.)
                       (set HtmlRenderer/ESCAPE_HTML true)
                       (toImmutable))
        lr-factory (reify LinkResolverFactory
                     (^LinkResolver apply [_this ^LinkResolverBasicContext _context]
                       (reify LinkResolver
                         (resolveLink [_this node _context link]
                           (if-let [url (cond
                                          (instance? MailLink node) (.getUrl link)
                                          (empty-link-ref? node) nil
                                          :else (resolve-uri (.getUrl link)))]
                             (.. link
                                 (withStatus LinkStatus/VALID)
                                 (withUrl url))
                             link)))))]
    (.build (.linkResolverFactory (HtmlRenderer/builder options) lr-factory))))

Converts a markdown string from a virtual card into a form that can be sent to a channel (Slack's markup language, or HTML for email).

(defmulti process-markdown
  (fn [_markdown channel-type] channel-type))
(defmethod process-markdown :slack
  [markdown _]
  (-> (.parse ^Parser parser ^String markdown)
      to-clojure
      ast->slack
      flatten
      str/join
      str/trim))
(defmethod process-markdown :html
  [markdown _]
  (let [ast (.parse ^Parser parser ^String markdown)]
    (.render ^HtmlRenderer renderer ^Document ast)))
 

Utilities for processing parameters for inclusion in dashboard subscriptions.

(ns metabase.pulse.parameters
  (:require
   [clojure.string :as str]
   [metabase.public-settings :as public-settings]
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.shared.parameters.parameters :as shared.params]
   [metabase.util :as u]
   [metabase.util.urls :as urls]
   [ring.util.codec :as codec]))

OSS way of getting filter parameters for a dashboard subscription

(defenterprise the-parameters
  metabase-enterprise.dashboard-subscription-filters.pulse
  [_pulse dashboard]
  (:parameters dashboard))

Returns the parameter value, such that: * nil value => nil * missing value key => default

(defn- param-val-or-default
  [parameter]
  (get parameter :value (:default parameter)))

Returns the list of parameters applied to a dashboard subscription, filtering out ones without a value

(defn parameters
  [subscription dashboard]
  (filter
   param-val-or-default
   (the-parameters subscription dashboard)))

Returns the value(s) of a dashboard filter, formatted appropriately.

(defn value-string
  [parameter]
  (let [tyype  (:type parameter)
        values (param-val-or-default parameter)]
    (try (shared.params/formatted-value tyype values (public-settings/site-locale))
         (catch Throwable _
           (shared.params/formatted-list (u/one-or-many values))))))

Given a dashboard's ID and parameters, returns a URL for the dashboard with filters included

(defn dashboard-url
  [dashboard-id parameters]
  (let [base-url   (urls/dashboard-url dashboard-id)
        url-params (flatten
                    (for [param parameters]
                      (for [value (u/one-or-many (param-val-or-default param))]
                        (str (codec/url-encode (:slug param))
                             "="
                             (codec/url-encode value)))))]
    (str base-url (when (seq url-params)
                    (str "?" (str/join "&" url-params))))))

Heading cards should not escape characters.

(defn- escape-markdown-chars?
  [dashcard]
  (not= "heading" (get-in dashcard [:visualization_settings :virtual_card :display])))

Given a dashcard and the parameters on a dashboard, returns the dashcard with any parameter values appropriately substituted into connected variables in the text.

(defn process-virtual-dashcard
  [dashcard parameters]
  (let [text               (-> dashcard :visualization_settings :text)
        parameter-mappings (:parameter_mappings dashcard)
        tag-names          (shared.params/tag_names text)
        param-id->param    (into {} (map (juxt :id identity) parameters))
        tag-name->param-id (into {} (map (juxt (comp second :target) :parameter_id) parameter-mappings))
        tag->param         (reduce (fn [m tag-name]
                                     (when-let [param-id (get tag-name->param-id tag-name)]
                                       (assoc m tag-name (get param-id->param param-id))))
                                   {}
                                   tag-names)]
    (update-in dashcard [:visualization_settings :text] shared.params/substitute_tags tag->param (public-settings/site-locale) (escape-markdown-chars? dashcard))))
 

Improve the feedback loop for Dashboard Subscription outputs.

(ns metabase.pulse.preview
  (:require
   [clojure.data.csv :as csv]
   [clojure.string :as str]
   [clojure.zip :as zip]
   [hiccup.core :as hiccup]
   [hickory.core :as hik]
   [hickory.render :as hik.r]
   [hickory.zip :as hik.z]
   [metabase.email.messages :as messages]
   [metabase.pulse :as pulse]
   [metabase.pulse.markdown :as markdown]
   [metabase.pulse.render :as render]
   [metabase.pulse.render.image-bundle :as img]
   [metabase.pulse.render.png :as png]
   [metabase.pulse.render.style :as style]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)
(def ^:private table-style-map
  {:border          "1px solid black"
   :border-collapse "collapse"
   :padding         "5px"})
(def ^:private table-style
  (style/style table-style-map))
(def ^:private csv-row-limit 10)
(defn- csv-to-html-table [csv-string]
  (let [rows (csv/read-csv csv-string)]
    [:table {:style table-style}
     (for [row (take (inc csv-row-limit) rows)] ;; inc row-limit to include the header and the expected # of rows
       [:tr {:style table-style}
        (for [cell row]
          [:td {:style table-style} cell])])]))
(def ^:private result-attachment #'messages/result-attachment)
(defn- render-csv-for-dashcard
  [part]
  (-> part
      (assoc-in [:card :include_csv] true)
      result-attachment
      first
      :content
      slurp
      csv-to-html-table))
(defn- render-one-dashcard
  [{:keys [card dashcard result] :as dashboard-result}]
  (letfn [(cellfn [content]
            [:td {:style (style/style (merge table-style-map {:max-width "400px"}))}
             content])]
    (if card
      (let [base-render (render/render-pulse-card :inline (pulse/defaulted-timezone card) card dashcard result)
            html-src    (-> base-render :content)
            img-src     (-> base-render
                            (png/render-html-to-png 1200)
                            img/render-img-data-uri)
            csv-src (render-csv-for-dashcard dashboard-result)]
        [:tr
         (cellfn (:name card))
         (cellfn [:img {:style (style/style {:max-width "400px"}) :src img-src}])
         (cellfn html-src)
         (cellfn csv-src)])
      [:tr
       (cellfn nil)
       (cellfn
        [:div {:style (style/style {:font-family             "Lato"
                                    :font-size               "13px" #_ "0.875em"
                                    :font-weight             "400"
                                    :font-style              "normal"
                                    :color                   "#4c5773"
                                    :-moz-osx-font-smoothing "grayscale"})}
         (markdown/process-markdown (:text dashboard-result) :html)])
       (cellfn nil)])))
(def ^:private execute-dashboard #'pulse/execute-dashboard)

Given a dashboard ID, renders all of the dashcards to hiccup datastructure.

(defn render-dashboard-to-hiccup
  [dashboard-id]
  (let [user              (t2/select-one :model/User)
        dashboard         (t2/select-one :model/Dashboard :id dashboard-id)
        dashboard-results (execute-dashboard {:creator_id (:id user)} dashboard)
        render            (->> (map render-one-dashcard (map #(assoc % :dashboard-id dashboard-id) dashboard-results))
                               (into [[:tr
                                       [:th {:style (style/style table-style-map)} "Card Name"]
                                       [:th {:style (style/style table-style-map)} "PNG"]
                                       [:th {:style (style/style table-style-map)} "HTML"]
                                       [:th {:style (style/style table-style-map)} "CSV"]]])
                               (into [:table {:style (style/style table-style-map)}]))]
    render))

Given a dashboard ID, renders all of the dashcards into an html document.

(defn render-dashboard-to-html
  [dashboard-id]
  (hiccup/html (render-dashboard-to-hiccup dashboard-id)))
(defn- collect-inline-style
  [style-lines {:keys [attrs] :as node}]
  (let [{:keys [style]} attrs]
    (if style
      (let [{:keys [id] :or {id (str (gensym "inline"))}} attrs]
        (swap! style-lines assoc id style)
        (-> node
            (update :attrs dissoc :style)
            (update :attrs assoc :id id)))
      node)))
(defn- css-str-fragment
  [[id css-str]]
  (format "#%s {%s}" id css-str))
(defn- style-node
  [style-lines-map]
  {:type    :element
   :tag     :style
   :attrs   {:nonce "%NONCE%"}
   :content [(str/join "\n" (map css-str-fragment style-lines-map))]})
(defn- move-inline-styles
  [hickory-tree]
  (let [zipper      (hik.z/hickory-zip hickory-tree)
        style-lines (atom {})
        xf-tree     (loop [loc zipper]
                      (if (zip/end? loc)
                        (zip/root loc)
                        (recur (zip/next (zip/edit loc (partial collect-inline-style style-lines))))))]
    (update xf-tree :content
            (fn [v]
              (vec (conj (seq v) (style-node @style-lines)))))))

Collects styles defined on element 'style' attributes and adds them to a single inline style tag. Each element that does not already have an 'id' attribute will have one generated, and the style will be added under that id, or the element's existing id.

For example, the html string "

This is red text.

" Will result in a CSS map-entry that looks like: #inline12345 {color: red;}.

This approach will capture all inline styles but is naive and will result in lots of style duplications. Since this is a simple preview endpoint not meant for heavy use outside of manual checks, this slower approach seems ok for now (as of 2023-12-18).

(defn style-tag-from-inline-styles
  [html-str]
  (-> html-str
      hik/parse
      hik/as-hickory
      move-inline-styles
      hik.r/hickory-to-html))
(defn- add-style-nonce [request response]
  (update response :body (fn [html-str]
                           (str/replace html-str #"%NONCE%" (:nonce request)))))

Constructs a middleware handler function that adds the generated nonce to an html string. This is only designed to be used with an endpoint that returns an html string response containing a style tag with an attribute 'nonce=%NONCE%'. Specifcally, this was designed to be used with the endpoint api/pulse/preview_dashboard/:id.

(defn style-tag-nonce-middleware
  [only-this-uri handler]
  (fn [request respond raise]
    (let [{:keys [uri]} request]
      (handler
       request
       (if (str/starts-with? uri only-this-uri)
         (comp respond (partial add-style-nonce request))
         respond)
       raise))))
 
(ns metabase.pulse.render
  (:require
   [hiccup.core :refer [h]]
   [metabase.formatter :as formatter]
   [metabase.models.dashboard-card :as dashboard-card]
   [metabase.pulse.markdown :as markdown]
   [metabase.pulse.render.body :as body]
   [metabase.pulse.render.image-bundle :as image-bundle]
   [metabase.pulse.render.png :as png]
   [metabase.pulse.render.style :as style]
   [metabase.shared.models.visualization-settings :as mb.viz]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [metabase.util.urls :as urls]
   [schema.core :as s]))

Should the rendered pulse include buttons? (default: false)

(def ^:dynamic *include-buttons*
  false)

Should the rendered pulse include a title? (default: false)

(def ^:dynamic *include-title*
  false)

Should the rendered pulse include a card description? (default: false)

(def ^:dynamic *include-description*
  false)
(defn- card-href
  [card]
  (h (urls/card-url (:id card))))
(s/defn ^:private make-title-if-needed :- (s/maybe formatter/RenderedPulseCard)
  [render-type card dashcard]
  (when *include-title*
    (let [card-name    (or (-> dashcard :visualization_settings :card.title)
                           (-> card :name))
          image-bundle (when *include-buttons*
                         (image-bundle/external-link-image-bundle render-type))]
      {:attachments (when image-bundle
                      (image-bundle/image-bundle->attachment image-bundle))
       :content     [:table {:style (style/style {:margin-bottom   :2px
                                                  :border-collapse :collapse
                                                  :width           :100%})}
                     [:tbody
                      [:tr
                       [:td {:style (style/style {:padding :0
                                                  :margin  :0})}
                        [:a {:style  (style/style (style/header-style))
                             :href   (card-href card)
                             :target "_blank"
                             :rel    "noopener noreferrer"}
                         (h card-name)]]
                       [:td {:style (style/style {:text-align :right})}
                        (when *include-buttons*
                          [:img {:style (style/style {:width :16px})
                                 :width 16
                                 :src   (:image-src image-bundle)}])]]]]})))
(s/defn ^:private make-description-if-needed :- (s/maybe formatter/RenderedPulseCard)
  [dashcard card]
  (when *include-description*
    (when-let [description (or (get-in dashcard [:visualization_settings :card.description])
                               (:description card))]
      {:attachments {}
       :content [:div {:style (style/style {:color style/color-text-medium
                                            :font-size :12px
                                            :margin-bottom :8px})}
                 (markdown/process-markdown description :html)]})))

Determine the pulse (visualization) type of a card, e.g. :scalar or :bar.

(defn detect-pulse-chart-type
  [{display-type :display, card-name :name, :as card} maybe-dashcard {:keys [cols rows], :as data}]
  (let [col-sample-count          (delay (count (take 3 cols)))
        row-sample-count          (delay (count (take 2 rows)))
        [col-1-rowfn col-2-rowfn] (formatter/graphing-column-row-fns card data)
        col-1                     (delay (col-1-rowfn cols))
        col-2                     (delay (col-2-rowfn cols))]
    (letfn [(chart-type [tyype reason & args]
              (log/tracef "Detected chart type %s for Card %s because %s"
                          tyype (pr-str card-name) (apply format reason args))
              tyype)
            (col-description [{col-name :name, base-type :base_type}]
              (format "%s (%s)" (pr-str col-name) base-type))]
      (cond
        (or (empty? rows)
            ;; Many aggregations result in [[nil]] if there are no rows to aggregate after filters
            (= [[nil]] (-> data :rows)))
        (chart-type :empty "there are no rows in results")
        (#{:pin_map :state :country} display-type)
        (chart-type nil "display-type is %s" display-type)
        (and (some? maybe-dashcard)
             (pos? (count (dashboard-card/dashcard->multi-cards maybe-dashcard)))
             (not (#{:combo} display-type)))
        (chart-type :multiple "result has multiple card semantics, a multiple chart")
        ;; for scalar/smartscalar, the display-type might actually be :line, so we can't have line above
        (and (not (contains? #{:progress :gauge} display-type))
             (= @col-sample-count @row-sample-count 1))
        (chart-type :scalar "result has one row and one column")
        (#{:scalar
           :smartscalar
           :line
           :area
           :bar
           :combo
           :row
           :funnel
           :progress
           :gauge
           :table
           :waterfall} display-type)
        (chart-type display-type "display-type is %s" display-type)
        (= display-type :pie)
        (chart-type :categorical/donut "result has two cols (%s and %s (number))" (col-description @col-1) (col-description @col-2))
        :else
        (chart-type :table "no other chart types match")))))
(defn- is-attached?
  [card]
  ((some-fn :include_csv :include_xls) card))
(s/defn ^:private render-pulse-card-body :- formatter/RenderedPulseCard
  [render-type timezone-id :- (s/maybe s/Str) card dashcard {:keys [data error] :as results}]
  (try
    (when error
      (throw (ex-info (tru "Card has errors: {0}" error) (assoc results :card-error true))))
    (let [chart-type (or (detect-pulse-chart-type card dashcard data)
                         (when (is-attached? card)
                           :attached)
                         :unknown)]
      (log/debug (trs "Rendering pulse card with chart-type {0} and render-type {1}" chart-type render-type))
      (body/render chart-type render-type timezone-id card dashcard data))
    (catch Throwable e
      (if (:card-error (ex-data e))
        (do
          (log/error e (trs "Pulse card query error"))
          (body/render :card-error nil nil nil nil nil))
        (do
          (log/error e (trs "Pulse card render error"))
          (body/render :render-error nil nil nil nil nil))))))
(s/defn render-pulse-card :- formatter/RenderedPulseCard
  "Render a single `card` for a `Pulse` to Hiccup HTML. `result` is the QP results. Returns a map with keys
- attachments
- content (a hiccup form suitable for rendering on rich clients or rendering into an image)
- render/text : raw text suitable for substituting on clients when text is preferable. (Currently slack uses this for
  scalar results where text is preferable to an image of a div of a single result."
  [render-type timezone-id :- (s/maybe s/Str) card dashcard results]
  (let [{title             :content
         title-attachments :attachments} (make-title-if-needed render-type card dashcard)
        {description :content}           (make-description-if-needed dashcard card)
        results                          (update-in results
                                                    [:data :viz-settings]
                                                    (fn [viz-settings]
                                                      (merge viz-settings (mb.viz/db->norm
                                                                           (:visualization_settings dashcard)))))
        {pulse-body       :content
         body-attachments :attachments
         text             :render/text}  (render-pulse-card-body render-type timezone-id card dashcard results)]
    (cond-> {:attachments (merge title-attachments body-attachments)
             :content [:p
                       ;; Provide a horizontal scrollbar for tables that overflow container width.
                       ;; Surrounding <p> element prevents buggy behavior when dragging scrollbar.
                       [:div {:style (style/style {:overflow-x :auto})}
                        [:a {:href        (card-href card)
                             :target      "_blank"
                             :rel         "noopener noreferrer"
                             :style       (style/style
                                           (style/section-style)
                                           {:display         :block
                                            :text-decoration :none})}
                         title
                         description
                         [:div {:class "pulse-body"
                                :style (style/style {:display :block
                                                     :margin  :16px})}
                          (if-let [more-results-message (body/attached-results-text render-type card)]
                            (conj more-results-message (list pulse-body))
                            pulse-body)]]]]}
      text (assoc :render/text text))))

Same as render-pulse-card but isn't intended for an email, rather for previewing so there is no need for attachments

(defn render-pulse-card-for-display
  [timezone-id card results]
  (:content (render-pulse-card :inline timezone-id card nil results)))
(s/defn render-pulse-section :- formatter/RenderedPulseCard
  "Render a single Card section of a Pulse to a Hiccup form (representating HTML)."
  [timezone-id {card :card, dashcard :dashcard, result :result}]
  (let [{:keys [attachments content]} (binding [*include-title*       true
                                                *include-description* true]
                                        (render-pulse-card :attachment timezone-id card dashcard result))]
    {:attachments attachments
     :content     [:div {:style (style/style {:margin-top    :20px
                                              :margin-bottom :20px})}
                   content]}))
(s/defn render-pulse-card-to-png :- bytes
  "Render a `pulse-card` as a PNG. `data` is the `:data` from a QP result."
  [timezone-id :- (s/maybe s/Str) pulse-card result width]
  (png/render-html-to-png (render-pulse-card :inline timezone-id pulse-card nil result) width))
(s/defn png-from-render-info :- bytes
  "Create a PNG file (as a byte array) from rendering info."
  [rendered-info :- formatter/RenderedPulseCard width]
  (png/render-html-to-png rendered-info width))
 
(ns metabase.pulse.render.body
  (:require
   [clojure.string :as str]
   [hiccup.core :refer [h]]
   [medley.core :as m]
   [metabase.formatter :as formatter]
   [metabase.formatter.datetime :as datetime]
   [metabase.public-settings :as public-settings]
   [metabase.pulse.render.color :as color]
   [metabase.pulse.render.image-bundle :as image-bundle]
   [metabase.pulse.render.js-svg :as js-svg]
   [metabase.pulse.render.style :as style]
   [metabase.pulse.render.table :as table]
   [metabase.pulse.util :as pu]
   [metabase.query-processor.streaming :as qp.streaming]
   [metabase.shared.models.visualization-settings :as mb.viz]
   [metabase.types :as types]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.ui-logic :as ui-logic]
   [schema.core :as s])
  (:import
   (java.text DecimalFormat DecimalFormatSymbols)))
(set! *warn-on-reflection* true)

Default rendered-info map when there is an error running a card on the card run. Is a delay due to the call to trs.

(def ^:private card-error-rendered-info
  (delay {:attachments
          nil
          :content
          [:div {:style (style/style
                         (style/font-style)
                         {:color       style/color-error
                          :font-weight 700
                          :padding     :16px})}
           (trs "There was a problem with this question.")]}))

Default rendered-info map when there is an error displaying a card on the static viz side. Is a delay due to the call to trs.

(def ^:private error-rendered-info
  (delay {:attachments
          nil
          :content
          [:div {:style (style/style
                         (style/font-style)
                         {:color       style/color-error
                          :font-weight 700
                          :padding     :16px})}
           (trs "An error occurred while displaying this card.")]}))

NOTE: hiccup does not escape content by default so be sure to use "h" to escape any user-controlled content :-/

+----------------------------------------------------------------------------------------------------------------+ | Helper Fns | +----------------------------------------------------------------------------------------------------------------+

Should this column be shown in a rendered table in a Pulse?

(defn show-in-table?
  [{:keys [semantic_type visibility_type] :as _column}]
  (and (not (isa? semantic_type :type/Description))
       (not (contains? #{:details-only :retired :sensitive} visibility_type))))

--------------------------------------------------- Formatting ---------------------------------------------------

(s/defn ^:private format-cell
  [timezone-id :- (s/maybe s/Str) value col visualization-settings]
  (cond
    (types/temporal-field? col)
    (datetime/format-temporal-str timezone-id value col)
    (number? value)
    (formatter/format-number value col visualization-settings)
    :else
    (str value)))

--------------------------------------------------- Rendering ----------------------------------------------------

Creates a map with from column names to a column index. This is used to figure out what a given column name or value should be replaced with

(defn- create-remapping-lookup
  [cols]
  (into {}
        (for [[col-idx {:keys [remapped_from]}] (map vector (range) cols)
              :when remapped_from]
          [remapped_from col-idx])))

Returns first column name from a hierarchy of possible column names

(defn- column-name
  [card col]
  (let [col-settings (-> (mb.viz/db->norm (:visualization_settings card))
                         ::mb.viz/column-settings
                         ;; field-ref keys can come in with additional stuff like :meta-data or unit maps,
                         ;; so we select only those keys we CAN use to match with by using select-keys
                         (update-keys #(select-keys % [::mb.viz/column-name ::mb.viz/field-id])))]
    (name (or (when-let [[_ id] (:field_ref col)]
                (get-in col-settings [{::mb.viz/field-id id} ::mb.viz/column-title]))
              (get-in col-settings [{::mb.viz/column-name (:name col)} ::mb.viz/column-title])
              (:display_name col)
              (:name col)))))

Returns a row structure with header info from cols. These values are strings that are ready to be rendered as HTML

(defn- query-results->header-row
  [remapping-lookup card cols include-bar?]
  {:row       (for [maybe-remapped-col cols
                    :when              (show-in-table? maybe-remapped-col)
                    :let               [col (if (:remapped_to maybe-remapped-col)
                                              (nth cols (get remapping-lookup (:name maybe-remapped-col)))
                                              maybe-remapped-col)
                                        col-name (column-name card col)]
                    ;; If this column is remapped from another, it's already
                    ;; in the output and should be skipped
                    :when              (not (:remapped_from maybe-remapped-col))]
                (if (isa? ((some-fn :effective_type :base_type) col) :type/Number)
                  (formatter/map->NumericWrapper {:num-str col-name :num-value col-name})
                  col-name))
   :bar-width (when include-bar? 99)})

Normalizes bar-value into a value between 0 and 100, where 0 corresponds to min-value and 100 to max-value

(defn- normalize-bar-value
  [bar-value min-value max-value]
  (float
   (/
    (* (- (double bar-value) min-value)
       100)
    (- max-value min-value))))

Returns a seq of stringified formatted rows that can be rendered into HTML

(s/defn ^:private query-results->row-seq
  [timezone-id :- (s/maybe s/Str)
   remapping-lookup
   cols
   rows
   viz-settings
   {:keys [bar-column min-value max-value]}]
  (let [formatters (into []
                         (map #(formatter/create-formatter timezone-id % viz-settings))
                         cols)]
    (for [row rows]
      {:bar-width (some-> (and bar-column (bar-column row))
                          (normalize-bar-value min-value max-value))
       :row (for [[maybe-remapped-col maybe-remapped-row-cell fmt-fn] (map vector cols row formatters)
                  :when (and (not (:remapped_from maybe-remapped-col))
                             (show-in-table? maybe-remapped-col))
                  :let [[_formatter row-cell] (if (:remapped_to maybe-remapped-col)
                                                (let [remapped-index (get remapping-lookup (:name maybe-remapped-col))]
                                                  [(nth formatters remapped-index)
                                                   (nth row remapped-index)])
                                                [fmt-fn maybe-remapped-row-cell])]]
              (fmt-fn row-cell))})))

Convert the query results (cols and rows) into a formatted seq of rows (list of strings) that can be rendered as HTML

(s/defn ^:private prep-for-html-rendering
  ([timezone-id :- (s/maybe s/Str) card data]
   (prep-for-html-rendering timezone-id card data {}))
  ([timezone-id :- (s/maybe s/Str) card {:keys [cols rows viz-settings]}
    {:keys [bar-column] :as data-attributes}]
   (let [remapping-lookup (create-remapping-lookup cols)]
     (cons
      (query-results->header-row remapping-lookup card cols bar-column)
      (query-results->row-seq
       timezone-id
       remapping-lookup
       cols
       (take (min (public-settings/attachment-table-row-limit) 100) rows)
       viz-settings
       data-attributes)))))
(defn- strong-limit-text [number]
  [:strong {:style (style/style {:color style/color-gray-3})} (h (formatter/format-number number))])
(defn- render-truncation-warning
  [row-limit row-count]
  (let [over-row-limit (> row-count row-limit)]
    (when over-row-limit
      [:div {:style (style/style {:padding-top :16px})}
       [:div {:style (style/style {:color          style/color-gray-2
                                   :padding-bottom :10px})}
        "Showing " (strong-limit-text row-limit)
        " of "     (strong-limit-text row-count)
        " rows."]])))

Returns hiccup structures to indicate truncated results are available as an attachment

(defn attached-results-text
  [render-type {:keys [include_csv include_xls]}]
  (when (and (not= :inline render-type)
             (or include_csv include_xls))
    [:div {:style (style/style {:color         style/color-gray-2
                                :margin-bottom :16px})}
     (trs "Results have been included as a file attachment")]))

+----------------------------------------------------------------------------------------------------------------+ | render | +----------------------------------------------------------------------------------------------------------------+

Render a Pulse as chart-type (e.g. :bar, :scalar, etc.) and render-type (either :inline or :attachment).

(defmulti render
  {:arglists '([chart-type render-type timezone-id card dashcard data])}
  (fn [chart-type _ _ _ _ _] chart-type))
(defn- order-data [data viz-settings]
  (if (some? (::mb.viz/table-columns viz-settings))
    (let [[ordered-cols output-order] (qp.streaming/order-cols (:cols data) viz-settings)
          keep-filtered-idx           (fn [row] (if output-order
                                                  (let [row-v (into [] row)]
                                                    (for [i output-order] (row-v i)))
                                                  row))
          ordered-rows                (map keep-filtered-idx (:rows data))]
      [ordered-cols ordered-rows])
    [(:cols data) (:rows data)]))
(s/defmethod render :table :- formatter/RenderedPulseCard
  [_ _ timezone-id :- (s/maybe s/Str) card _dashcard {:keys [rows viz-settings] :as data}]
  (let [[ordered-cols ordered-rows] (order-data data viz-settings)
        data                        (-> data
                                        (assoc :rows ordered-rows)
                                        (assoc :cols ordered-cols))
        table-body                  [:div
                                     (table/render-table
                                      (color/make-color-selector data viz-settings)
                                      (mapv :name ordered-cols)
                                      (prep-for-html-rendering timezone-id card data))
                                     (render-truncation-warning (public-settings/attachment-table-row-limit) (count rows))]]
    {:attachments
     nil
     :content
     table-body}))
(def ^:private default-date-styles
  {:year "YYYY"
   :quarter "[Q]Q - YYYY"
   :minute-of-hour "m"
   :day-of-week "dddd"
   :day-of-month "d"
   :day-of-year "DDD"
   :week-of-year "wo"
   :month-of-year "MMMM"
   :quarter-of-year "[Q]Q"})
(def ^:private override-date-styles
  {"M/D/YYYY" {:month "M/YYYY"}
   "D/M/YYYY" {:month "M/YYYY"}
   "YYYY/M/D" {:month "YYYY/M"
               :quarter "YYYY - [Q]Q"}
   "MMMM D, YYYY" {:month "MMMM, YYYY"}
   "D MMMM, YYYY" {:month "MMMM, YYYY"}
   "dddd, MMMM D, YYYY" {:day "EEEE, MMMM d, YYYY"
                         :week "MMMM d, YYYY"
                         :month "MMMM, YYYY"}})
(defn- update-date-style
  [date-style unit {::mb.viz/keys [date-abbreviate date-separator]}]
  (let [unit (or unit :default)]
    (cond-> (or (get-in override-date-styles [date-style unit])
                (get default-date-styles unit)
                date-style)
      date-separator
      (str/replace #"/" date-separator)
      date-abbreviate
      (-> (str/replace #"MMMM" "MMM")
          (str/replace #"EEEE" "E")))))
(defn- backfill-currency
  [{:keys [number_style currency] :as settings}]
  (cond-> settings
    (and (= number_style "currency") (nil? currency))
    (assoc :currency "USD")))
(defn- update-col-for-js
  [col-settings col]
  (-> (m/map-keys (fn [k] (-> k name (str/replace #"-" "_") keyword)) col-settings)
      (backfill-currency)
      (u/update-if-exists :date_style update-date-style (:unit col) col-settings)))
(defn- settings-from-column
  [col column-settings]
  (-> (or (get column-settings {::mb.viz/field-id (:id col)})
          (get column-settings {::mb.viz/column-name (:name col)}))
      (update-col-for-js col)))

Include viz settings for js.

  • there are some date overrides done from lib/formatting.js
  • chop off and underscore the nasty keys in our map
  • backfill currency to the default of USD if not present
(defn- ->js-viz
  [x-col y-col {::mb.viz/keys [column-settings] :as viz-settings}]
  (let [x-col-settings (settings-from-column x-col column-settings)
        y-col-settings (settings-from-column y-col column-settings)]
    (cond-> {:colors (public-settings/application-colors)
             :visualization_settings (or viz-settings {})}
      x-col-settings
      (assoc :x x-col-settings)
      y-col-settings
      (assoc :y y-col-settings))))

Include viz settings for the typed settings, initially in XY charts. These are actually completely different than the previous settings format inasmuch: 1. The labels are in the settings 2. Colors are in the series, only the whitelabel colors are here 3. Many fewer things are optional 4. Must explicitly have yAxisPosition in all the series

For further details look at frontend/src/metabase/static-viz/XYChart/types.ts

(defn- ->ts-viz
  [x-col y-col labels {::mb.viz/keys [column-settings] :as viz-settings}]
  (let [default-format {:number_style   "decimal"
                        :currency       "USD"
                        :currency_style "symbol"}
        x-col-settings (or (settings-from-column x-col column-settings) {})
        y-col-settings (or (settings-from-column y-col column-settings) {})
        x-format       (merge
                        (if (isa? (:effective_type x-col) :type/Temporal)
                          {:date_style "MMMM D, YYYY"}
                          default-format)
                        x-col-settings)
        y-format       (merge
                        default-format
                        y-col-settings)
        default-x-type (if (isa? (:effective_type x-col) :type/Temporal)
                         "timeseries"
                         "ordinal")]
    (merge
     {:colors                 (public-settings/application-colors)
      :stacking               (if (:stackable.stack_type viz-settings) "stack" "none")
      :x                      {:type   (or (:graph.x_axis.scale viz-settings) default-x-type)
                               :format x-format}
      :y                      {:type   (or (:graph.y_axis.scale viz-settings) "linear")
                               :format y-format}
      :labels                 labels
      :visualization_settings (or viz-settings {})}
     (when (:graph.show_goal viz-settings)
       {:goal {:value (:graph.goal_value viz-settings)
               :label (or (:graph.goal_label viz-settings) (tru "Goal"))}}))))

Default stack type is stacked for area chart with more than one metric. So, if :stackable.stack_type is not specified, it's stacked. However, if key is explicitly set in :stackable.stack_type and is nil, that indicates not stacked.

(defn- set-default-stacked
  [viz-settings card]
  (let [stacked     (if (contains? viz-settings :stackable.stack_type)
                      (= (:stackable.stack_type viz-settings) "stacked")
                      (and
                       (= (:display card) :area)
                       (or
                        (> (count (:graph.metrics viz-settings)) 1)
                        (> (count (:graph.dimensions viz-settings)) 1))))]
    (if stacked
      (assoc viz-settings :stackable.stack_type "stacked")
      viz-settings)))

Generate the X and Y axis labels passed in as the labels argument to [[metabase.pulse.render.js-svg/waterfall]] and other similar functions for rendering charts with X and Y axes. Respects custom display names in viz-settings; otherwise uses x-col and y-col display names.

(defn- x-and-y-axis-label-info
  [x-col y-col viz-settings]
  {:bottom (or (:graph.x_axis.title_text viz-settings)
               (:display_name x-col))
   :left   (or (:graph.y_axis.title_text viz-settings)
               (:display_name y-col))})

Returns true if :graph.x_axis.labels_enabled (or y_axis) is true, not present, or nil. The only time labels are not enabled is when the key is explicitly set to false.

(defn- labels-enabled?
  [viz-settings axis-key]
  (boolean (get viz-settings axis-key true)))

X and Y axis labels passed into the labels argument needs to be different for combos specifically (as opposed to multiples)

(defn- combo-label-info
  [x-cols y-cols viz-settings]
  {:bottom (when (labels-enabled? viz-settings :graph.x_axis.labels_enabled)
             (or (:graph.x_axis.title_text viz-settings)
                 (:display_name (first x-cols))))
   :left   (when (labels-enabled? viz-settings :graph.y_axis.labels_enabled)
             (or (:graph.y_axis.title_text viz-settings)
                 (:display_name (first y-cols))))
   :right  (when (labels-enabled? viz-settings :graph.y_axis.labels_enabled)
             (or (:graph.y_axis.title_text viz-settings)
                 (:display_name (second y-cols))))})

Colors to cycle through for charts. These are copied from https://stats.metabase.com/_internal/colors

(def ^:private colors
  ["#509EE3" "#88BF4D" "#A989C5" "#EF8C8C" "#F9D45C" "#F2A86F" "#98D9D9" "#7172AD" "#6450e3" "#4dbf5e"
   "#c589b9" "#efce8c" "#b5f95c" "#e35850" "#554dbf" "#bec589" "#8cefc6" "#5cc2f9" "#55e350" "#bf4d4f"
   "#89c3c5" "#be8cef" "#f95cd0" "#50e3ae" "#bf974d" "#899bc5" "#ef8cde" "#f95c67"])

Format a percentage which includes site settings for locale. The first arg is a numeric value to format. The second is an optional string of decimal and grouping symbols to be used, ie ".,". There will soon be a values.clj file that will handle this but this is here in the meantime.

(defn format-percentage
  ([value]
   (format-percentage value (get-in (public-settings/custom-formatting) [:type/Number :number_separators])))
  ([value [decimal grouping]]
   (let [base "#,###.##%"
         fmt (if (or decimal grouping)
               (DecimalFormat. base (doto (DecimalFormatSymbols.)
                                      (cond-> decimal (.setDecimalSeparator decimal))
                                      (cond-> grouping (.setGroupingSeparator grouping))))
               (DecimalFormat. base))]
     (.format fmt value))))

Process rows with a minimum slice threshold. Collapses any segments below the threshold given as a percentage (the value 25 for 25%) into a single category as "Other".

(defn- donut-info
  [threshold-percentage rows]
  (let [total                    (reduce + 0 (map second rows))
        threshold                (* total (/ threshold-percentage 100))
        {as-is true clump false} (group-by (comp #(> % threshold) second) rows)
        rows (cond-> as-is
               (seq clump)
               (conj [(tru "Other") (reduce (fnil + 0) 0 (map second clump))]))]
    {:rows        rows
     :percentages (into {}
                        (for [[label value] rows]
                          [label (if (zero? total)
                                   (tru "N/A")
                                   (format-percentage (/ value total)))]))}))
(defn- donut-legend
  [legend-entries]
  (letfn [(table-fn [entries]
            (into [:table {:style (style/style {:color       "#4C5773"
                                                :font-family "Lato, sans-serif"
                                                :font-size   "24px"
                                                :font-weight "bold"
                                                :box-sizing  "border-box"
                                                :white-space "nowrap"})}]
                  (for [{:keys [label percentage color]} entries]
                    [:tr {:style (style/style {:margin-right "12px"})}
                     [:td {:style (style/style {:color         color
                                                :padding-right "7px"
                                                :line-height   "0"})}
                      [:span {:style (style/style {:font-size   "2.875rem"
                                                   :line-height "0"
                                                   :position    "relative"
                                                   :top         "-4px"})} "•"]]
                     [:td {:style (style/style {:padding-right "30px"})}
                      label]
                     [:td percentage]])))]
    (if (< (count legend-entries) 8)
      (table-fn legend-entries)
      [:table (into [:tr]
                    (map (fn [some-entries]
                           [:td {:style (style/style {:padding-right  "20px"
                                                      :vertical-align "top"})}
                            (table-fn some-entries)])
                         (split-at (/ (count legend-entries) 2) legend-entries)))])))
(defn- replace-nils [rows]
  (mapv (fn [row]
          (if (nil? (first row))
            (assoc row 0 "(empty)")
            row))
        rows))
(s/defmethod render :categorical/donut :- formatter/RenderedPulseCard
  [_ render-type timezone-id :- (s/maybe s/Str) card _dashcard {:keys [rows cols viz-settings] :as data}]
  (let [[x-axis-rowfn y-axis-rowfn] (formatter/graphing-column-row-fns card data)
        rows                        (map (juxt (comp str x-axis-rowfn) y-axis-rowfn)
                                         (formatter/row-preprocess x-axis-rowfn y-axis-rowfn (replace-nils rows)))
        slice-threshold             (or (get viz-settings :pie.slice_threshold)
                                        2.5)
        {:keys [rows percentages]}  (donut-info slice-threshold rows)
        legend-colors               (merge (zipmap (map first rows) (cycle colors))
                                           (update-keys (:pie.colors viz-settings) name))
        settings                    {:percent_visibility (:pie.percent_visibility viz-settings) :show_total (:pie.show_total viz-settings)}
        image-bundle                (image-bundle/make-image-bundle
                                     render-type
                                     (js-svg/categorical-donut rows legend-colors settings))
        {label-viz-settings :x}     (->js-viz (x-axis-rowfn cols) (y-axis-rowfn cols) viz-settings)]
    {:attachments
     (when image-bundle
       (image-bundle/image-bundle->attachment image-bundle))
     :content
     [:div
      [:img {:style (style/style {:display :block :width :100%})
             :src   (:image-src image-bundle)}]
      (donut-legend
       (mapv (fn [row]
               (let [label (first row)]
                 {:percentage (percentages (first row))
                  :color      (legend-colors (first row))
                  :label      (if (and (contains? label-viz-settings :date_style)
                                       (datetime/temporal-string? label))
                                (datetime/format-temporal-str
                                 timezone-id
                                 (first row)
                                 (x-axis-rowfn cols)
                                 viz-settings)
                                label)}))
             rows))]}))
(s/defmethod render :progress :- formatter/RenderedPulseCard
  [_ render-type _timezone-id _card _dashcard {:keys [cols rows viz-settings] :as _data}]
  (let [value        (ffirst rows)
        goal         (:progress.goal viz-settings)
        color        (:progress.color viz-settings)
        settings     (assoc
                      (->js-viz (first cols) (first cols) viz-settings)
                      :color color)
        ;; ->js-viz fills in our :x but we actually want that under :format key
        settings     (assoc settings :format (:x settings))
        image-bundle (image-bundle/make-image-bundle
                      render-type
                      (js-svg/progress value goal settings))]
    {:attachments
     (when image-bundle
       (image-bundle/image-bundle->attachment image-bundle))
     :content
     [:div
      [:img {:style (style/style {:display :block :width :100%})
             :src   (:image-src image-bundle)}]]}))

calculate the overlap, a value between 0 and 1, of the numerical ranges given by vals-a and vals-b. This overlap value can be checked against axis-group-threshold to determine when columns can reasonably share a y-axis. Consider two ranges, with min and max values:

min-a = 0 max-a = 43 ----------------------------------------- min-b = 52 max-b = 75 ---------------------- The overlap above is 0. The mirror case where col-b is entirely less than col-a also has 0 overlap. Otherwise, overlap is calculated as follows:

min-a = 0 max-a = 43 ----------------------------------------- | min-b = 8 | max-b = 59 | ---------------------------------|--------------- | | | | | |- overlap-width = (- 43 8) = 35 -| | | | |--------- max-width = (- 59 0) = 59 ---------------------|

overlap = (/ overlap-width max-width) = (/ 35 59) = 0.59

Another scenario, with a similar result may look as follows:

min-a = 0 max-a = 59 --------------------------------------------------------- | min-b = 8 max-b = 43 | | --------------------------------- | | | | | | |- overlap-width = (- 43 8) = 35 -| | | | |--------- max-width = (- 59 0) = 59 ---------------------|

overlap = (/ overlap-width max-width) = (/ 35 59) = 0.59

(defn- overlap
  [vals-a vals-b]
  (let [[min-a max-a] (-> vals-a sort ((juxt first last)))
        [min-b max-b] (-> vals-b sort ((juxt first last)))
        [a b c d]     (sort [min-a min-b max-a max-b])
        max-width     (- d a)
        overlap-width (- c b)]
    (/ (double overlap-width) (double max-width))))

Calculate the 'nearness' score for ranges specified by vals-a and vals-b.

The nearness score is the percent of the total range that the 'valid range' covers IF, the outer point's distance to the nearest range end covers less of the total range. for visual: * -------------- <---- the 'pt' on the left is close enough.

(defn- nearness
  [vals-a vals-b]
  (let [[min-a max-a]          (-> vals-a sort ((juxt first last)))
        [min-b max-b]          (-> vals-b sort ((juxt first last)))]
    (cond
      (or (= min-a max-a) (= min-b max-b))
      (let [pt                (if (= min-a max-a) min-a min-b)
            [r1 r2]           (if (= min-a max-a) [min-b max-b] [min-a max-a])
            total-range       (- (max pt r2) (min pt r1))
            valid-range-score (/ (- r2 r1) total-range)
            outer-pt-score    (/ (min (abs (- pt r1))
                                      (abs (- pt r2)))
                                 total-range)]
        (if (>= valid-range-score outer-pt-score)
          (double valid-range-score)
          0))
      :else 0)))

Calculate the axis grouping threshold value for the ranges specified by vals-a and vals-b. The threshold is defined as 'percent overlap', when the ranges overlap, or 'nearness' otherwise.

(defn- axis-group-score
  [vals-a vals-b]
  (let [[min-a max-a] (-> vals-a sort ((juxt first last)))
        [min-b max-b] (-> vals-b sort ((juxt first last)))]
    (cond
      ;; any nils in the ranges means we can't compare them.
      (some nil? (concat vals-a vals-b)) 0
      ;; if either range is just a single point, and it's inside the other range,
      ;; we consider it overlapped. Not likely in practice, but could happen.
      (and (= min-a max-a) (<= min-b min-a max-b)) 1
      (and (= min-b max-b) (<= min-a min-b max-a)) 1
      ;; ranges overlap, let's calculate the percent overlap
      (or (<= min-a min-b max-a)
          (<= min-a max-b max-a)) (overlap vals-a vals-b)
      ;; no overlap, let's calculate a nearness value to use instead
      :else (nearness vals-a vals-b))))

Default chart type seq of combo graphs (not multiple graphs).

(def default-combo-chart-types
  (conj (repeat "bar")
        "line"))
(defn- attach-image-bundle
  [image-bundle]
  {:attachments
   (when image-bundle
     (image-bundle/image-bundle->attachment image-bundle))
   :content
   [:div
    [:img {:style (style/style {:display :block
                                :width   :100%})
           :src   (:image-src image-bundle)}]]})
(defn- multiple-scalar-series
  [joined-rows _x-cols _y-cols _viz-settings]
  [(for [[row-val] (map vector joined-rows)]
     {:cardName      (first row-val)
      :type          :bar
      :data          [row-val]
      :yAxisPosition "left"
      :column        nil})])

When multiple scalar cards are combined, they render as a bar chart

(defn- render-multiple-scalars
  [render-type card dashcard {:keys [viz-settings] :as data}]
  (let [multi-res    (pu/execute-multi-card card dashcard)
        cards        (cons card (map :card multi-res))
        multi-data   (cons data (map #(get-in % [:result :data]) multi-res))
        x-rows       (map :name cards) ;; Bar labels
        y-rows       (mapcat :rows multi-data)
        x-cols       [{:base_type :type/Text
                       :effective_type :type/Text}]
        y-cols       (select-keys (first (:cols data)) [:base_type :effective_type])
        series-seqs  (multiple-scalar-series (mapv vector x-rows (flatten y-rows)) x-cols y-cols viz-settings)
        labels       (combo-label-info x-cols y-cols viz-settings)
        settings     (->ts-viz (first x-cols) (first y-cols) labels viz-settings)]
    (attach-image-bundle (image-bundle/make-image-bundle render-type (js-svg/combo-chart series-seqs settings)))))
(defn- series-setting [viz-settings outer-key inner-key]
  (get-in viz-settings [:series_settings (keyword outer-key) inner-key]))
(def ^:private axis-group-threshold 0.33)
(defn- group-axes-at-once
  [joined-rows viz-settings]
  (let [;; a double-x-axis 'joined-row' looks like:
        ;; [["val on x-axis"         "grouping-key"] [series-val]] eg:
        ;; [["2016-01-01T00:00:00Z"  "Doohickey"   ] [9031.5578 ]]
        ;; a single-x-axis 'joined-row' looks like:
        ;; [[grouping-key] [series-val-1 series-val-2 ...]]
        joined-rows-map    (if (= (count (ffirst joined-rows)) 2)
                             ;; double-x-axis
                             (-> (group-by (fn [[[_ x2] _]] x2) joined-rows)
                                 (update-vals #(mapcat last %)))
                             ;; single-x-axis
                             (->> (:graph.metrics viz-settings)
                                  (map-indexed (fn [idx k]
                                                 [k (mapv #(get (second %) idx) joined-rows)]))
                                  (into {})))
        ;; map of group-key -> :left :right or nil
        starting-positions (into {} (for [k (keys joined-rows-map)]
                                      [k (or (keyword (series-setting viz-settings k :axis)) :unassigned)]))
        ;; map of position (:left :right or :unassigned) -> vector of assigned groups
        positions          (-> (group-by second starting-positions)
                               (update-vals #(mapv first %)))
        unassigned?        (contains? positions :unassigned)
        stacked?           (boolean (:stackable.stack_type viz-settings))]
    (cond
      ;; if the chart is stacked, splitting the axes doesn't make sense, so we always put every series :left
      stacked? (into {} (map (fn [k] [k :left]) (keys joined-rows-map)))
      ;; chart is not stacked, and there are some :unassigned series, so we try to group them
      unassigned?
      (let [lefts         (or (:left positions) [(first (:unassigned positions))])
            rights        (or (:right positions) [])
            to-group      (remove (set (concat lefts rights)) (:unassigned positions))
            score-fn      (fn [series-vals]
                            (into {} (map (fn [k]
                                            [k (axis-group-score (get joined-rows-map k) series-vals)])
                                          (keys joined-rows-map))))
            ;; with the first series assigned :left, calculate scores between that series and all other series
            scores        (score-fn (get joined-rows-map (first lefts)))
            ;; group the series by comparing the score for that series against the group threshold
            all-positions (apply (partial merge-with concat)
                                 (conj
                                  (for [k to-group]
                                    (if (> (get scores k) axis-group-threshold)
                                      {:left [k]}
                                      {:right [k]}))
                                  (-> positions (dissoc :unassigned) (assoc :left lefts))))]
        (into {} (apply concat (for [[pos ks] all-positions]
                                 (map (fn [k] [k pos]) ks)))))
      ;; all series already have positions assigned
      ;; This comes from the user explicitly setting left or right on the series in the UI.
      :else positions)))

This munges rows and columns into series in the format that we want for combo staticviz for literal combo displaytype, for a single x-axis with multiple y-axis.

(defn- single-x-axis-combo-series
  [chart-type joined-rows _x-cols y-cols {:keys [viz-settings] :as _data} card-name]
  (let [positions (group-axes-at-once joined-rows viz-settings)]
    (for [[idx y-col] (map-indexed vector y-cols)]
      (let [y-col-key      (:name y-col)
            card-type      (or (series-setting viz-settings y-col-key :display)
                               chart-type
                               (nth default-combo-chart-types idx))
            selected-rows  (mapv #(vector (ffirst %) (nth (second %) idx)) joined-rows)
            y-axis-pos     (get positions y-col-key "left")]
        {:cardName      card-name
         :type          card-type
         :data          selected-rows
         :yAxisPosition y-axis-pos
         :column        y-col}))))

This munges rows and columns into series in the format that we want for combo staticviz for literal combo displaytype, for a double x-axis, which has pretty materially different semantics for that second dimension, with single y-axis only.

This mimics default behavior in JS viz, which is to group by the second dimension and make every group-by-value a series. This can have really high cardinality of series but the JS viz will complain about more than 100 already

(defn- double-x-axis-combo-series
  [chart-type joined-rows x-cols _y-cols {:keys [viz-settings] :as _data} card-name]
  (let [grouped-rows (group-by #(second (first %)) joined-rows)
        groups       (keys grouped-rows)
        positions    (group-axes-at-once joined-rows viz-settings)]
    (for [[idx group-key] (map-indexed vector groups)]
      (let [row-group          (get grouped-rows group-key)
            selected-row-group (mapv #(vector (ffirst %) (first (second %))) row-group)
            card-type          (or (series-setting viz-settings group-key :display)
                                   chart-type
                                   (nth default-combo-chart-types idx))
            y-axis-pos         (get positions group-key)]
        {:cardName      card-name
         :type          card-type
         :data          selected-row-group
         :yAxisPosition y-axis-pos
         :column        (second x-cols)
         :breakoutValue group-key}))))
(defn- axis-row-fns
  [card data]
  [(or (ui-logic/mult-x-axis-rowfn card data) #(vector (first %)))
   (or (ui-logic/mult-y-axis-rowfn card data) #(vector (second %)))])

Helper function for render-multiple-lab-chart that turns a card query result into a series-settings map in the shape expected by js-svg/combo chart (and the combo-chart js code).

(defn- card-result->series
  [result]
  (let [card            (:card result)
        data            (get-in result [:result :data])
        display         (:display card)
        [x-fn y-fn]     (axis-row-fns card data)
        enforced-type   (if (= display :scalar) :bar display)
        card-name       (:name card)
        viz-settings    (:visualization_settings card)
        joined-rows     (map (juxt x-fn y-fn)
                             (formatter/row-preprocess x-fn y-fn (:rows data)))
        [x-cols y-cols] ((juxt x-fn y-fn) (get-in result [:result :data :cols]))
        combo-series-fn (if (= (count x-cols) 1) single-x-axis-combo-series double-x-axis-combo-series)]
    (combo-series-fn enforced-type joined-rows x-cols y-cols viz-settings card-name)))

When multiple non-scalar cards are combined, render them as a line, area, or bar chart

(defn- render-multiple-lab-chart
  [render-type card dashcard {:keys [viz-settings] :as data}]
  (let [multi-res         (pu/execute-multi-card card dashcard)
        ;; multi-res gets the other results from the set of multis.
        ;; we shove cards and data here all together below for uniformity's sake
        viz-settings      (set-default-stacked viz-settings card)
        multi-data        (cons data (map #(get-in % [:result :data]) multi-res))
        col-seqs          (map :cols multi-data)
        [x-fn y-fn]       (axis-row-fns card data)
        [[x-col] [y-col]] ((juxt x-fn y-fn) (first col-seqs))
        labels            (x-and-y-axis-label-info x-col y-col viz-settings)
        settings          (->ts-viz x-col y-col labels viz-settings)
        series-seqs       (map card-result->series (cons {:card card :result {:data data}} multi-res))]
    (attach-image-bundle (image-bundle/make-image-bundle render-type (js-svg/combo-chart series-seqs settings)))))

Generate an image-bundle for a Line Area Bar chart (LAB)

Use the combo charts for every chart-type in line area bar because we get multiple chart series for cheaper this way.

(defn- lab-image-bundle
  [chart-type render-type _timezone-id card {:keys [cols rows viz-settings] :as data}]
  (let [rows            (replace-nils rows)
        x-axis-rowfn    (or (ui-logic/mult-x-axis-rowfn card data) #(vector (first %)))
        y-axis-rowfn    (or (ui-logic/mult-y-axis-rowfn card data) #(vector (second %)))
        x-rows          (filter some? (map x-axis-rowfn rows))
        y-rows          (filter some? (map y-axis-rowfn rows))
        joined-rows     (mapv vector x-rows y-rows)
        viz-settings    (set-default-stacked viz-settings card)
        [x-cols y-cols] ((juxt x-axis-rowfn y-axis-rowfn) (vec cols))
        enforced-type   (if (= chart-type :combo)
                          nil
                          chart-type)
        card-name       (:name card)
        ;; NB: There's a hardcoded limit of arity 2 on x-axis, so there's only the 1-axis or 2-axis case
        series-seqs     [(if (= (count x-cols) 1)
                           (single-x-axis-combo-series enforced-type joined-rows x-cols y-cols data card-name)
                           (double-x-axis-combo-series enforced-type joined-rows x-cols y-cols data card-name))]
        labels          (combo-label-info x-cols y-cols viz-settings)
        settings        (->ts-viz (first x-cols) (first y-cols) labels viz-settings)]
    (image-bundle/make-image-bundle
     render-type
     (js-svg/combo-chart series-seqs settings))))
(s/defmethod render :multiple
  [_ render-type _timezone-id card dashcard data]
  ((if (= :scalar (:display card))
     render-multiple-scalars
     render-multiple-lab-chart)
   render-type card dashcard data))
(s/defmethod render :line :- formatter/RenderedPulseCard
  [_ render-type timezone-id card _dashcard data]
  (attach-image-bundle (lab-image-bundle :line render-type timezone-id card data)))
(s/defmethod render :area :- formatter/RenderedPulseCard
  [_ render-type timezone-id card _dashcard data]
  (attach-image-bundle (lab-image-bundle :area render-type timezone-id card data)))
(s/defmethod render :bar :- formatter/RenderedPulseCard
  [_chart-type render-type timezone-id :- (s/maybe s/Str) card _dashcard data]
  (attach-image-bundle (lab-image-bundle :bar render-type timezone-id card data)))
(s/defmethod render :combo :- formatter/RenderedPulseCard
  [_chart-type render-type timezone-id :- (s/maybe s/Str) card _dashcard data]
  (attach-image-bundle (lab-image-bundle :combo render-type timezone-id card data)))
(s/defmethod render :gauge :- formatter/RenderedPulseCard
  [_chart-type render-type _timezone-id :- (s/maybe s/Str) card _dashcard data]
  (let [image-bundle (image-bundle/make-image-bundle
                      render-type
                      (js-svg/gauge card data))]
    {:attachments
     (when image-bundle
       (image-bundle/image-bundle->attachment image-bundle))
     :content
     [:div
      [:img {:style (style/style {:display :block :width :100%})
             :src   (:image-src image-bundle)}]]}))
(s/defmethod render :row :- formatter/RenderedPulseCard
  [_ render-type _timezone-id card _dashcard {:keys [rows cols] :as _data}]
  (let [viz-settings (get card :visualization_settings)
        data {:rows rows
              :cols cols}
        image-bundle   (image-bundle/make-image-bundle
                        render-type
                        (js-svg/row-chart viz-settings data))]
    {:attachments
     (when image-bundle
       (image-bundle/image-bundle->attachment image-bundle))
     :content
     [:div
      [:img {:style (style/style {:display :block :width :100%})
             :src   (:image-src image-bundle)}]]}))
(defn- get-col-by-name
    [cols col-name]
    (->> (map-indexed (fn [idx m] [idx m]) cols)
         (some (fn [[idx col]]
                 (when (= col-name (:name col))
                   [idx col])))))
(s/defmethod render :scalar :- formatter/RenderedPulseCard
  [_chart-type _render-type timezone-id _card _dashcard {:keys [cols rows viz-settings]}]
  (let [field-name    (:scalar.field viz-settings)
        [row-idx col] (or (when field-name
                            (get-col-by-name cols field-name))
                          [0 (first cols)])
        row           (first rows)
        raw-value     (get row row-idx)
        value         (format-cell timezone-id raw-value col viz-settings)]
    {:attachments
     nil
     :content
     [:div {:style (style/style (style/scalar-style))}
      (h value)]
     :render/text (str value)}))
(s/defmethod render :smartscalar :- formatter/RenderedPulseCard
  [_chart-type _render-type timezone-id _card _dashcard {:keys [cols insights viz-settings]}]
  (letfn [(col-of-type [t c] (or (isa? (:effective_type c) t)
                                 ;; computed and agg columns don't have an effective type
                                 (isa? (:base_type c) t)))
          (where [f coll] (some #(when (f %) %) coll))
          (percentage [arg] (if (number? arg)
                              (format-percentage arg)
                              " - "))
          (format-unit [unit] (str/replace (name unit) "-" " "))]
    (let [[_time-col metric-col] (if (col-of-type :type/Temporal (first cols)) cols (reverse cols))
          {:keys [last-value previous-value unit last-change] :as _insight}
          (where (comp #{(:name metric-col)} :col) insights)]
      (if (and last-value previous-value unit last-change)
        (let [value           (format-cell timezone-id last-value metric-col viz-settings)
              previous        (format-cell timezone-id previous-value metric-col viz-settings)
              adj             (if (pos? last-change) (tru "Up") (tru "Down"))
              delta-statement (if (= last-value previous-value)
                                "No change"
                                (str adj " " (percentage last-change)))
              comparison-statement (str " vs. previous " (format-unit unit) ": " previous)]
          {:attachments nil
           :content     [:div
                         [:div {:style (style/style (style/scalar-style))}
                          (h value)]
                         [:p {:style (style/style {:color         style/color-text-medium
                                                   :font-size     :16px
                                                   :font-weight   700
                                                   :padding-right :16px})}
                          delta-statement
                          comparison-statement]]
           :render/text (str value "\n"
                             delta-statement
                             comparison-statement)})
        ;; In other words, defaults to plain scalar if we don't have actual changes
        {:attachments nil
         :content     [:div
                       [:div {:style (style/style (style/scalar-style))}
                        (h last-value)]
                       [:p {:style (style/style {:color         style/color-text-medium
                                                 :font-size     :16px
                                                 :font-weight   700
                                                 :padding-right :16px})}
                        (trs "Nothing to compare to.")]]
         :render/text (str (format-cell timezone-id last-value metric-col viz-settings)
                           "\n" (trs "Nothing to compare to."))}))))
(s/defmethod render :waterfall :- formatter/RenderedPulseCard
  [_ render-type _timezone-id card _dashcard {:keys [rows cols viz-settings] :as data}]
  (let [[x-axis-rowfn
         y-axis-rowfn] (formatter/graphing-column-row-fns card data)
        [x-col y-col]  ((juxt x-axis-rowfn y-axis-rowfn) cols)
        rows           (map (juxt x-axis-rowfn y-axis-rowfn)
                            (formatter/row-preprocess x-axis-rowfn y-axis-rowfn rows))
        labels         (x-and-y-axis-label-info x-col y-col viz-settings)
        waterfall-type (if (isa? (-> cols x-axis-rowfn :effective_type) :type/Temporal)
                         :timeseries
                         :categorical)
        show-total     (if (nil? (:waterfall.show_total viz-settings))
                         true
                         (:waterfall.show_total viz-settings))
        settings       (-> (->js-viz x-col y-col viz-settings)
                           (update :colors assoc
                                   :waterfallTotal (:waterfall.total_color viz-settings)
                                   :waterfallPositive (:waterfall.increase_color viz-settings)
                                   :waterfallNegative (:waterfall.decrease_color viz-settings))
                           (assoc :showTotal show-total)
                           (assoc :show_values (boolean (:graph.show_values viz-settings))))
        image-bundle   (image-bundle/make-image-bundle
                        render-type
                        (js-svg/waterfall rows
                                          labels
                                          settings
                                          waterfall-type))]
    {:attachments
     (when image-bundle
       (image-bundle/image-bundle->attachment image-bundle))
     :content
     [:div
      [:img {:style (style/style {:display :block :width :100%})
             :src   (:image-src image-bundle)}]]}))
(s/defmethod render :funnel :- formatter/RenderedPulseCard
  [_ render-type _timezone-id card _dashcard {:keys [rows cols viz-settings] :as data}]
  (let [[x-axis-rowfn
         y-axis-rowfn] (formatter/graphing-column-row-fns card data)
        rows           (map (juxt x-axis-rowfn y-axis-rowfn)
                            (formatter/row-preprocess x-axis-rowfn y-axis-rowfn rows))
        [x-col y-col]  cols
        settings       (as-> (->js-viz x-col y-col viz-settings) jsviz-settings
                         (assoc jsviz-settings :step    {:name   (:display_name x-col)
                                                         :format (:x jsviz-settings)}
                                :measure {:format (:y jsviz-settings)}))
        svg            (js-svg/funnel rows settings)
        image-bundle   (image-bundle/make-image-bundle render-type svg)]
    {:attachments
     (image-bundle/image-bundle->attachment image-bundle)
     :content
     [:div
      [:img {:style (style/style {:display :block :width :100%})
             :src   (:image-src image-bundle)}]]}))
(s/defmethod render :empty :- formatter/RenderedPulseCard
  [_ render-type _ _ _ _]
  (let [image-bundle (image-bundle/no-results-image-bundle render-type)]
    {:attachments
     (image-bundle/image-bundle->attachment image-bundle)
     :content
     [:div {:style (style/style {:text-align :center})}
      [:img {:style (style/style {:width :104px})
             :src   (:image-src image-bundle)}]
      [:div {:style (style/style
                     (style/font-style)
                     {:margin-top :8px
                      :color      style/color-gray-4})}
       (trs "No results")]]
     :render/text (trs "No results")}))
(s/defmethod render :attached :- formatter/RenderedPulseCard
  [_ render-type _ _ _ _]
  (let [image-bundle (image-bundle/attached-image-bundle render-type)]
    {:attachments
     (image-bundle/image-bundle->attachment image-bundle)
     :content
     [:div {:style (style/style {:text-align :center})}
      [:img {:style (style/style {:width :30px})
             :src   (:image-src image-bundle)}]
      [:div {:style (style/style
                     (style/font-style)
                     {:margin-top :8px
                      :color      style/color-gray-4})}
       (trs "This question has been included as a file attachment")]]}))
(s/defmethod render :unknown :- formatter/RenderedPulseCard
  [_ _ _ _ _ _]
  {:attachments
   nil
   :content
   [:div {:style (style/style
                  (style/font-style)
                  {:color       style/color-gold
                   :font-weight 700})}
    (trs "We were unable to display this Pulse.")
    [:br]
    (trs "Please view this card in Metabase.")]})
(s/defmethod render :card-error :- formatter/RenderedPulseCard
  [_ _ _ _ _ _]
  @card-error-rendered-info)
(s/defmethod render :render-error :- formatter/RenderedPulseCard
  [_ _ _ _ _ _]
  @error-rendered-info)
 

Namespaces that uses the Nashorn javascript engine to invoke some shared javascript code that we use to determine the background color of pulse table cells

(ns metabase.pulse.render.color
  (:require
   [cheshire.core :as json]
   [clojure.java.io :as io]
   [metabase.formatter]
   [metabase.pulse.render.js-engine :as js]
   [metabase.util.i18n :refer [trs]]
   [schema.core :as s])
  (:import
    (metabase.formatter NumericWrapper)))
(set! *warn-on-reflection* true)
(def ^:private js-file-path "frontend_shared/color_selector.js")
(def ^:private ^{:arglists '([])} js-engine
  ;; The code that loads the JS engine is behind a delay so that we don't incur that cost on startup. The below
  ;; assertion till look for the javascript file at startup and fail if it doesn't find it. This is to avoid a big
  ;; delay in finding out that the system is broken
  (let [file-url (io/resource js-file-path)]
    (assert file-url (trs "Can''t find JS color selector at ''{0}''" js-file-path))
    (let [dlay (delay
                 (doto (js/context)
                   (js/load-resource js-file-path)))]
      (fn []
        @dlay))))

This is a pretty loose schema, more as a safety net as we have a long feedback loop for this being broken as it's being handed to the JS color picking code. Currently it just needs column names from :cols, and the query results from :rows

(def ^:private QueryResults
  {:cols [{:name s/Str
           s/Any s/Any}]
   :rows [[s/Any]]
   s/Any s/Any})

Returns a curried javascript function (object) that can be used with get-background-color for delegating to JS code to pick out the correct color for a given cell in a pulse table. The logic for picking a color is somewhat complex, but defined in a set of rules in viz-settings. There are some colors that are picked based on a particular cell value, others affect the row, so it's necessary to call this once for the resultset and then get-background-color on each cell.

Get the correct color for a cell in a pulse table. Returns color as string suitable for use CSS, e.g. a hex string or rgba() string. This is intended to be invoked on each cell of every row in the table. See make-color-selector for more info.

(s/defn make-color-selector
  [{:keys [cols rows]} :- QueryResults viz-settings]
  ;; Ideally we'd convert everything to JS data before invoking the function below, but converting rows would be
  ;; expensive. The JS code is written to deal with `rows` in it's native Nashorn format but since `cols` and
  ;; `viz-settings` are small, pass those as JSON so that they can be deserialized to pure JS objects once in JS
  ;; code
  (js/execute-fn-name (js-engine) "makeCellBackgroundGetter"
                      rows
                      (json/generate-string cols)
                      (json/generate-string viz-settings)))
(defn get-background-color
  ^String [color-selector cell-value column-name row-index]
  (let [cell-value (if (instance? NumericWrapper cell-value)
                     (:num-value cell-value)
                     cell-value)]
    (.asString (js/execute-fn color-selector cell-value row-index column-name))))
 

Logic related to creating image bundles, and some predefined ones. An image bundle contains the data needed to either encode the image inline in a URL (when render-type is :inline), or create the hashes/references needed for an attached image (render-type of :attachment)

(ns metabase.pulse.render.image-bundle
  (:require
   [clojure.java.io :as io])
  (:import
   (java.util Arrays)
   (org.apache.commons.io IOUtils)
   (org.fit.cssbox.misc Base64Coder)))
(set! *warn-on-reflection* true)

Generate a hash to be used in a Content-ID

(defn- hash-bytes
  [^bytes img-bytes]
  (Math/abs ^Integer (Arrays/hashCode img-bytes)))

Generate a hash to be used in a Content-ID

(defn- hash-image-url
  [^java.net.URL url]
  (-> url io/input-stream IOUtils/toByteArray hash-bytes))
(defn- content-id-reference [content-id]
  (str "cid:" content-id))
(defn- mb-hash-str [image-hash]
  (str image-hash "@metabase"))
(defn- write-byte-array-to-temp-file
  [^bytes img-bytes]
  (let [f (doto (java.io.File/createTempFile "metabase_pulse_image_" ".png")
            .deleteOnExit)]
    (with-open [fos (java.io.FileOutputStream. f)]
      (.write fos img-bytes))
    f))
(defn- byte-array->url [^bytes img-bytes]
  (-> img-bytes write-byte-array-to-temp-file io/as-url))

Takes a PNG byte array and returns a Base64 encoded URI

(defn render-img-data-uri
  [img-bytes]
  (str "data:image/png;base64," (String. (Base64Coder/encode img-bytes))))

Create an image bundle. An image bundle contains the data needed to either encode the image inline (when render-type is :inline), or create the hashes/references needed for an attached image (render-type of :attachment)

(defmulti make-image-bundle
  (fn [render-type url-or-bytes]
    [render-type (class url-or-bytes)]))
(defmethod make-image-bundle [:attachment java.net.URL]
  [render-type, ^java.net.URL url]
  (let [content-id (mb-hash-str (hash-image-url url))]
    {:content-id  content-id
     :image-url   url
     :image-src   (content-id-reference content-id)
     :render-type render-type}))
(defmethod make-image-bundle [:attachment (class (byte-array 0))]
  [render-type image-bytes]
  (let [image-url (byte-array->url image-bytes)
        content-id (mb-hash-str (hash-bytes image-bytes))]
    {:content-id  content-id
     :image-url   image-url
     :image-src   (content-id-reference content-id)
     :render-type render-type}))
(defmethod make-image-bundle [:inline java.net.URL]
  [render-type, ^java.net.URL url]
  {:image-src   (-> url io/input-stream IOUtils/toByteArray render-img-data-uri)
   :image-url   url
   :render-type render-type})
(defmethod make-image-bundle [:inline (Class/forName "[B")]
  [render-type image-bytes]
  {:image-src   (render-img-data-uri image-bytes)
   :render-type render-type})
(def ^:private external-link-url (io/resource "frontend_client/app/assets/img/external_link.png"))
(def ^:private no-results-url    (io/resource "frontend_client/app/assets/img/pulse_no_results@2x.png"))
(def ^:private attached-url      (io/resource "frontend_client/app/assets/img/attachment@2x.png"))
(def ^:private external-link-image
  (delay
   (make-image-bundle :attachment external-link-url)))
(def ^:private no-results-image
  (delay
   (make-image-bundle :attachment no-results-url)))
(def ^:private attached-image
  (delay
    (make-image-bundle :attachment attached-url)))

Image bundle for an external link icon.

(defn external-link-image-bundle
  [render-type]
  (case render-type
    :attachment @external-link-image
    :inline     (make-image-bundle render-type external-link-url)))

Image bundle for the 'No results' image.

(defn no-results-image-bundle
  [render-type]
  (case render-type
    :attachment @no-results-image
    :inline     (make-image-bundle render-type no-results-url)))

Image bundle for paperclip 'attachment' image.

(defn attached-image-bundle
  [render-type]
  (case render-type
    :attachment @attached-image
    :inline     (make-image-bundle render-type attached-url)))

Convert an image bundle into an email attachment.

(defn image-bundle->attachment
  [{:keys [render-type content-id image-url]}]
  (case render-type
    :attachment {content-id image-url}
    :inline     nil))
 

Graal polyglot context suitable for executing javascript code.

We run the js in interpreted mode and turn off the warning with the `(option "engine.WarnInterpreterOnly" "false")`. Ideally we would compile the javascript but this is difficult when using the graal ecosystem in a non graal jdk. See https://github.com/oracle/graaljs/blob/master/docs/user/RunOnJDK.md for more information.

Javadocs: https://www.graalvm.org/truffle/javadoc/overview-summary.html

(ns metabase.pulse.render.js-engine
  (:require
   [clojure.java.io :as io]
   [metabase.util.i18n :refer [trs]])
  (:import
   (org.graalvm.polyglot Context HostAccess Source Value)))
(set! *warn-on-reflection* true)

Create a new org.graalvm.polyglot.Context suitable to evaluate javascript

(defn context
  ^Context []
  (.. (Context/newBuilder (into-array String ["js"]))
      ;; https://github.com/oracle/graaljs/blob/master/docs/user/RunOnJDK.md
      (option "engine.WarnInterpreterOnly" "false")
      (option "js.intl-402" "true")
      (allowHostAccess HostAccess/ALL)
      (allowHostClassLookup (reify java.util.function.Predicate
                              (test [_ _] true)))
      (out System/out)
      (err System/err)
      (allowIO true)
      (build)))

Load a string literal source into the js context.

(defn load-js-string
  [^Context context ^String string-src ^String src-name]
  (.eval context (.buildLiteral (Source/newBuilder "js" string-src src-name))))

Load a resource into the js context

(defn load-resource
  [^Context context source]
  (let [resource (io/resource source)]
    (when (nil? resource)
      (throw (ex-info (trs "Javascript resource not found: {0}" source)
                      {:source source})))
    (.eval context (.build (Source/newBuilder "js" resource)))))

Executes js-fn-name in js context with args

(defn execute-fn-name
  ^Value [^Context context js-fn-name & args]
  (let [fn-ref (.eval context "js" js-fn-name)
        args   (into-array Object args)]
    (assert (.canExecute fn-ref) (str "cannot execute " js-fn-name))
    (.execute fn-ref args)))

fn-ref should be an executable org.graalvm.polyglot.Value return from a js engine. Invoke this function with args.

(defn execute-fn
  ^Value [^Value fn-ref & args]
  (assert (.canExecute fn-ref) "cannot execute function reference")
  (.execute fn-ref (object-array args)))
 

Functions to render charts as svg strings by using graal's js engine. A bundle is built by yarn build-static-viz which has charting library. This namespace has some wrapper functions to invoke those functions. Interop is very strange, as the jvm datastructures, not just serialized versions are used. This is why we have the toJSArray and toJSMap functions to turn Clojure's normal datastructures into js native structures.

(ns metabase.pulse.render.js-svg
  (:require
   [cheshire.core :as json]
   [clojure.string :as str]
   [metabase.config :as config]
   [metabase.public-settings :as public-settings]
   [metabase.pulse.render.js-engine :as js]
   [metabase.pulse.render.style :as style])
  (:import
   (java.io ByteArrayInputStream ByteArrayOutputStream)
   (java.nio.charset StandardCharsets)
   (org.apache.batik.anim.dom SAXSVGDocumentFactory SVGOMDocument)
   (org.apache.batik.transcoder TranscoderInput TranscoderOutput)
   (org.apache.batik.transcoder.image PNGTranscoder)
   (org.graalvm.polyglot Context)
   (org.w3c.dom Element Node)))
(set! *warn-on-reflection* true)

the bundle path goes through webpack. Changes require a yarn build-static-viz

(def ^:private bundle-path
  "frontend_client/app/dist/lib-static-viz.bundle.js")

the interface file does not go through webpack. Feel free to quickly change as needed and then re-require this namespace to redef the context.

(def ^:private interface-path
  "frontend_shared/static_viz_interface.js")
(defn- load-viz-bundle [^Context context]
  (doto context
    (js/load-resource bundle-path)
    (js/load-resource interface-path)))

Delay containing a graal js context. It has the chart bundle and the above src-api in its environment suitable for creating charts.

(def ^:private static-viz-context-delay
  ;; todo is this thread safe? Should we have a resource pool on top of this? Or create them fresh for each invocation
  (delay (load-viz-bundle (js/context))))

Returns a static viz context. In dev mode, this will be a new context each time. In prod or test modes, it will return the derefed contents of static-viz-context-delay.

(defn- context
  ^Context []
  (if config/is-dev?
    (load-viz-bundle (js/context))
    @static-viz-context-delay))

Mutate in place the elements of the svg document. Remove the fill=transparent attribute in favor of fill-opacity=0.0. Our svg image renderer only understands the latter. Mutation is unfortunately necessary as the underlying tree of nodes is inherently mutable

(defn- post-process
  [^SVGOMDocument svg-document & post-fns]
  (loop [s [(.getDocumentElement svg-document)]]
    (when-let [^Node node (peek s)]
      (let [s' (let [nodelist (.getChildNodes node)
                     length   (.getLength nodelist)]
                 (apply conj (pop s)
                        ;; reverse the nodes for the stack so it goes down first child first
                        (map #(.item nodelist %) (reverse (range length)))))]
        (reduce (fn [node f] (f node)) node post-fns)
        (recur s'))))
  svg-document)

The batik svg renderer does not understand fill="transparent" so we must change that to fill-opacity="0.0". Previously was just doing a string replacement but now is a proper tree walk fix.

(defn- fix-fill
  [^Node node]
  (letfn [(element? [x] (instance? Element x))]
    (if (and (element? node)
             (.hasAttribute ^Element node "fill")
             (= (.getAttribute ^Element node "fill") "transparent"))
      (doto ^Element node
        (.removeAttribute "fill")
        (.setAttribute "fill-opacity" "0.0"))
      node)))
(defn- parse-svg-string [^String s]
  (let [s       (str/replace s #"<svg" "<svg xmlns=\"http://www.w3.org/2000/svg\)
        factory (SAXSVGDocumentFactory. "org.apache.xerces.parsers.SAXParser")]
    (with-open [is (ByteArrayInputStream. (.getBytes s StandardCharsets/UTF_8))]
      (.createDocument factory "file:///fake.svg" is))))

Width to render svg images. Intentionally large to improve quality. Consumers should be aware and resize as needed. Email should include width tags; slack automatically resizes inline and provides a nice detail view when clicked.

(def ^:dynamic ^:private *svg-render-width*
  (float 1200))

Height to render svg images. If not bound, will preserve aspect ratio of original image.

(def ^:dynamic ^:private *svg-render-height*
  nil)
(defn- render-svg
  ^bytes [^SVGOMDocument svg-document]
  (style/register-fonts-if-needed!)
  (with-open [os (ByteArrayOutputStream.)]
    (let [^SVGOMDocument fixed-svg-doc (post-process svg-document fix-fill)
          in                           (TranscoderInput. fixed-svg-doc)
          out                          (TranscoderOutput. os)
          transcoder                   (PNGTranscoder.)]
      (.addTranscodingHint transcoder PNGTranscoder/KEY_WIDTH *svg-render-width*)
      (when *svg-render-height*
        (.addTranscodingHint transcoder PNGTranscoder/KEY_HEIGHT *svg-render-height*))
      (.transcode transcoder in out))
    (.toByteArray os)))
(defn- svg-string->bytes [s]
  (-> s parse-svg-string render-svg))

Clojure entrypoint to render a timeseries or categorical waterfall chart. Rows should be tuples of [datetime numeric-value]. Labels is a map of {:left "left-label" :botton "bottom-label". Returns a byte array of a png file.

(defn waterfall
  [rows labels settings waterfall-type]
  (let [svg-string (.asString (js/execute-fn-name (context) "waterfall" rows
                                                  (map (fn [[k v]] [(name k) v]) labels)
                                                  (json/generate-string settings)
                                                  (name waterfall-type)
                                                  (json/generate-string (public-settings/application-colors))))]
    (svg-string->bytes svg-string)))

Clojure entrypoint to render a funnel chart. Data should be vec of [[Step Measure]] where Step is {:name name :format format-options} and Measure is {:format format-options} and you go and look to frontend/src/metabase/static-viz/components/FunnelChart/types.ts for the actual format options. Returns a byte array of a png file.

(defn funnel
  [data settings]
  (let [svg-string (.asString (js/execute-fn-name (context) "funnel" (json/generate-string data)
                                                  (json/generate-string settings)))]
    (svg-string->bytes svg-string)))

Clojure entrypoint to render a combo or multiple chart. These are different conceptions in the BE but being smushed together because they're supposed to display similarly. Series should be list of dicts of {rows: rows, cols: cols, type: type}, where types is 'line' or 'bar' or 'area'. Rows should be tuples of [datetime numeric-value]. Labels is a map of {:left "left-label" :botton "bottom-label"}. Returns a byte array of a png file.

(defn combo-chart
  [series-seqs settings]
  (svg-string->bytes
   (.asString (js/execute-fn-name (context)
                                  "combo_chart"
                                  (json/generate-string series-seqs)
                                  (json/generate-string settings)
                                  (json/generate-string (public-settings/application-colors))))))

Clojure entrypoint to render a row chart.

(defn row-chart
  [settings data]
  (let [svg-string (.asString (js/execute-fn-name (context) "row_chart"
                                                  (json/generate-string settings)
                                                  (json/generate-string data)
                                                  (json/generate-string (public-settings/application-colors))))]
    (svg-string->bytes svg-string)))

Clojure entrypoint to render a categorical donut chart. Rows should be tuples of [category numeric-value]. Returns a byte array of a png file

(defn categorical-donut
  [rows legend-colors settings]
  (let [svg-string (.asString (js/execute-fn-name (context) "categorical_donut" rows (seq legend-colors) (json/generate-string settings)))]
    (svg-string->bytes svg-string)))

Clojure entrypoint to render a gauge chart. Returns a byte array of a png file

(defn gauge
  [card data]
  (let [js-res (js/execute-fn-name (context) "gauge"
                                   (json/generate-string card)
                                   (json/generate-string data))
        svg-string (.asString js-res)]
    (svg-string->bytes svg-string)))

Clojure entrypoint to render a progress bar. Returns a byte array of a png file

(defn progress
  [value goal settings]
  (let [js-res (js/execute-fn-name (context) "progress"
                                   (json/generate-string {:value value :goal goal})
                                   (json/generate-string settings)
                                   (json/generate-string (public-settings/application-colors)))
        svg-string (.asString js-res)]
    (svg-string->bytes svg-string)))
(def ^:private icon-paths
  {:dashboard "M32 28a4 4 0 0 1-4 4H4a4.002 4.002 0 0 1-3.874-3H0V4a4 4 0 0 1 4-4h25a3 3 0 0 1 3 3v25zm-4 0V8H4v20h24zM7.273 18.91h10.182v4.363H7.273v-4.364zm0-6.82h17.454v4.365H7.273V12.09zm13.09 6.82h4.364v4.363h-4.363v-4.364z"
   :bell      "M14.254 5.105c-7.422.874-8.136 7.388-8.136 11.12 0 4.007 0 5.61-.824 6.411-.549.535-1.647.802-3.294.802v4.006h28v-4.006c-1.647 0-2.47 0-3.294-.802-.55-.534-.824-3.205-.824-8.013-.493-5.763-3.205-8.936-8.136-9.518a2.365 2.365 0 0 0 .725-1.701C18.47 2.076 17.364 1 16 1s-2.47 1.076-2.47 2.404c0 .664.276 1.266.724 1.7zM11.849 29c.383 1.556 1.793 2.333 4.229 2.333s3.845-.777 4.229-2.333h-8.458z"})
(defn- icon-svg-string
  [icon-name color]
  (str "<svg><path d=\ (get icon-paths icon-name) "\" fill=\ color "\"/></svg>"))

Entrypoint for rendering an SVG icon as a PNG, with a specific color

(defn icon
  [icon-name color]
  (let [svg-string (icon-svg-string icon-name color)]
    (binding [*svg-render-width*  (float 33)
              *svg-render-height* (float 33)]
      (svg-string->bytes svg-string))))
 

Logic for rendering HTML to a PNG.

Ported by @tlrobinson from https://github.com/radkovo/CSSBox/blob/cssbox-4.10/src/main/java/org/fit/cssbox/demo/ImageRenderer.java with subsequent code simplification and cleanup by @camsaul

CSSBox JavaDoc is here: http://cssbox.sourceforge.net/api/index.html

(ns metabase.pulse.render.png
  (:require
   [hiccup.core :refer [html]]
   [metabase.formatter :as formatter]
   [metabase.pulse.render.style :as style]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [schema.core :as s])
  (:import
   (cz.vutbr.web.css MediaSpec)
   (java.awt Graphics2D RenderingHints)
   (java.awt.image BufferedImage)
   (java.io ByteArrayInputStream ByteArrayOutputStream)
   (java.nio.charset StandardCharsets)
   (javax.imageio ImageIO)
   (org.fit.cssbox.awt GraphicsEngine)
   (org.fit.cssbox.css CSSNorm DOMAnalyzer DOMAnalyzer$Origin)
   (org.fit.cssbox.io DefaultDOMSource StreamDocumentSource)
   (org.fit.cssbox.layout Dimension)
   (org.w3c.dom Document)))
(set! *warn-on-reflection* true)
(defn- write-image!
  [^BufferedImage image, ^String format-name, ^ByteArrayOutputStream output-stream]
  (ImageIO/write image format-name output-stream))
(defn- dom-analyzer
  ^DOMAnalyzer [^Document doc, ^StreamDocumentSource doc-source, ^Dimension window-size]
  (doto (DOMAnalyzer. doc (.getURL doc-source))
    (.setMediaSpec (doto (MediaSpec. "screen")
                     (.setDimensions       (.width window-size) (.height window-size))
                     (.setDeviceDimensions (.width window-size) (.height window-size))))
    .attributesToStyles
    (.addStyleSheet nil (CSSNorm/stdStyleSheet)   DOMAnalyzer$Origin/AGENT)
    (.addStyleSheet nil (CSSNorm/userStyleSheet)  DOMAnalyzer$Origin/AGENT)
    (.addStyleSheet nil (CSSNorm/formsStyleSheet) DOMAnalyzer$Origin/AGENT)
    .getStyleSheets))
(defn- render-to-png
  ^java.awt.image.BufferedImage [^String html width]
  (style/register-fonts-if-needed!)
  (with-open [is         (ByteArrayInputStream. (.getBytes html StandardCharsets/UTF_8))
              doc-source (StreamDocumentSource. is nil "text/html; charset=utf-8")]
    (let [dimension       (Dimension. width 1)
          doc             (.parse (DefaultDOMSource. doc-source))
          da              (dom-analyzer doc doc-source dimension)
          graphics-engine (proxy [GraphicsEngine] [(.getRoot da) da (.getURL doc-source)]
                            (setupGraphics [^Graphics2D g]
                              (doto g
                                (.setRenderingHint RenderingHints/KEY_RENDERING
                                                   RenderingHints/VALUE_RENDER_QUALITY)
                                (.setRenderingHint RenderingHints/KEY_ALPHA_INTERPOLATION
                                                   RenderingHints/VALUE_ALPHA_INTERPOLATION_QUALITY)
                                (.setRenderingHint RenderingHints/KEY_TEXT_ANTIALIASING
                                                   RenderingHints/VALUE_TEXT_ANTIALIAS_GASP)
                                (.setRenderingHint RenderingHints/KEY_FRACTIONALMETRICS
                                                   RenderingHints/VALUE_FRACTIONALMETRICS_ON))))]
      (.createLayout graphics-engine dimension)
      (let [image         (.getImage graphics-engine)
            viewport      (.getViewport graphics-engine)
            ;; CSSBox voodoo -- sometimes maximal width < minimal width, no idea why
            content-width (max (int (.getMinimalWidth viewport))
                               (int (.getMaximalWidth viewport)))]
        ;; Crop the image to the actual size of the rendered content so that tables don't have a ton of whitespace.
        (if (< content-width (.getWidth image))
          (.getSubimage image 0 0 content-width (.getHeight image))
          image)))))
(s/defn render-html-to-png :- bytes
  "Render the Hiccup HTML `content` of a Pulse to a PNG image, returning a byte array."
  [{:keys [content]} :- formatter/RenderedPulseCard
   width]
  (try
    (let [html (html [:html [:body {:style (style/style
                                            {:margin           0
                                             :padding          0
                                             :background-color :white})}
                             content]])]
      (with-open [os (ByteArrayOutputStream.)]
        (-> (render-to-png html width)
            (write-image! "png" os))
        (.toByteArray os)))
    (catch Throwable e
      (log/error e (trs "Error rendering Pulse"))
      (throw e))))
 

CSS styles and related helper code for Pulse rendering.

(ns metabase.pulse.render.style
  (:require
   [clojure.java.io :as io]
   [clojure.string :as str]
   [metabase.public-settings :as public-settings]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]))
(set! *warn-on-reflection* true)

TODO - we should move other CSS definitions from metabase.pulse.render namespaces into this one, so they're all in one place.

Compile one or more CSS style maps into a string.

(style {:font-weight 400, :color "white"}) -> "font-weight: 400; color: white;"

(defn style
  [& style-maps]
  (str/join " " (for [[k v] (into {} style-maps)
                      :let  [v (if (keyword? v) (name v) (str v))]
                      :when (seq v)]
                  (str (name k) ": " v ";"))))

Used as color for 'We were unable to display this Pulse' messages.

(def ^:const color-gold
  "#F9D45C")

Color for error messages.

(def ^:const color-error
  "#EF8C8C")

~75% gray.

(def ^:const color-gray-2
  "#BDC1BF")

~50% gray.

(def ^:const color-gray-3
  "#7C8381")

~25% gray.

(def ^:const color-gray-4
  "#394340")

Color for light text.

(def ^:const color-text-light
  "#B8BBC3")

Color for medium text.

(def ^:const color-text-medium
  "#949AAB")

Color for dark text.

(def ^:const color-text-dark
  "#4C5773")

Used as color for the border of table, table header, and table body rows for charts with :table vizualization.

(def ^:const color-border
  "#F0F0F0")

Primary color to use in Pulses; normally 'classic' MB blue, but customizable when whitelabeling is enabled.

don't try to improve the code and make this a plain variable, in EE it's customizable which is why it's a function. Too much of a hassle to have it be a fn in one version of the code an a constant in another

(defn primary-color
  []
  (public-settings/application-color))

Secondary color to use in Pulse charts; normally red, but customizable when whitelabeling is enabled.

(defn secondary-color
  []
  (public-settings/secondary-chart-color))

Font family to use in rendered Pulses.

(defn font-style
  []
  {:font-family "Lato, \"Helvetica Neue\", Helvetica, Arial, sans-serif"})

CSS style for a Pulse section.

(defn section-style
  []
  (font-style))

Style for a header of a pulse section.

(defn header-style
  []
  (merge
   (font-style)
   {:font-size       :18px
    :font-weight     700
    :color           (primary-color)
    :text-decoration :none}))

Style for a scalar display-type 'chart' in a Pulse.

(defn scalar-style
  []
  (merge
   (font-style)
   {:font-size   :24px
    :font-weight 700
    :color       color-text-dark}))
(defn- register-font! [filename]
  (with-open [is (io/input-stream (io/resource filename))]
    (.registerFont (java.awt.GraphicsEnvironment/getLocalGraphicsEnvironment)
                   (java.awt.Font/createFont java.awt.Font/TRUETYPE_FONT is))))
(defn- register-fonts! []
  (try
    (doseq [weight ["regular" "700" "900"]]
      (register-font! (format "frontend_client/app/fonts/Lato/lato-v16-latin-%s.ttf" weight)))
    (catch Throwable e
      (let [message (str (trs "Error registering fonts: Metabase will not be able to send Pulses.")
                         " "
                         (trs "This is a known issue with certain JVMs. See {0} and for more details."
                              "https://github.com/metabase/metabase/issues/7986"))]
        (log/error e message)
        (throw (ex-info message {} e))))))

Makes custom fonts available to Java so that CSSBox can render them.

(defonce ^{:doc      
           :arglists '([])} register-fonts-if-needed!
  (let [register!* (delay (register-fonts!))]
    (fn []
      @register!*)))
 
(ns metabase.pulse.render.table
  (:require
   [clojure.string :as str]
   [hiccup.core :refer [h]]
   [medley.core :as m]
   [metabase.formatter]
   [metabase.pulse.render.color :as color]
   [metabase.pulse.render.style :as style])
  (:import
   (metabase.formatter NumericWrapper)))
(comment metabase.formatter/keep-me)
(defn- bar-th-style []
  (merge
   (style/font-style)
   {:font-size :12px
    :font-weight     700
    :color           style/color-text-dark
    :border-bottom   (str "2px solid " style/color-border)
    :border-right    0}))
(def ^:private max-bar-width 106)
(defn- bar-td-style []
  (merge
   (style/font-style)
   {:font-size      :12px
    :font-weight    400
    :text-align     :left
    :color          style/color-text-dark
    :border-bottom  (str "1px solid " style/color-border)
    :border-right   (str "1px solid " style/color-border)
    :padding        "0.75em 1em"}))
(defn- bar-th-style-numeric []
  (merge (style/font-style) (bar-th-style) {:text-align :right}))
(defn- bar-td-style-numeric []
  (merge (style/font-style) (bar-td-style) {:text-align :right}))
(defn- render-bar-component
  ([color positive? width-in-pixels]
   (render-bar-component color positive? width-in-pixels 0))
  ([color positive? width-in-pixels _offset]
   [:div
    {:style (style/style
             (merge
              {:width            (format "%spx" width-in-pixels)
               :background-color color
               :max-height       :10px
               :height           :10px
               :margin-top       :3px}
              (if positive?
                {:border-radius "0px 2px 2px 0px"}
                {:border-radius "2px 0px 0px 2px"
                 ;; `float: right` would be nice instead of the `margin-left` hack, but CSSBox puts in an erroneous 2px gap with it
                 :margin-left (format "%spx" (- max-bar-width width-in-pixels))})))}
    "&#160;"]))
(defn- heading-style-for-type
  [cell]
  (if (instance? NumericWrapper cell)
    (bar-th-style-numeric)
    (bar-th-style)))
(defn- row-style-for-type
  [cell]
  (if (instance? NumericWrapper cell)
    (bar-td-style-numeric)
    (bar-td-style)))
(defn- normalized-score->pixels
  [score]
  (int (* (/ score 100.0) max-bar-width)))
(def ^:private max-column-character-length 16)
(defn- truncate-text [text]
  (if (> (count text) max-column-character-length)
    (str (str/trim (subs text 0 max-column-character-length)) "...")
    text))
(defn- render-table-head [{:keys [bar-width row]}]
  [:thead
   (conj (into [:tr]
               (for [header-cell row]
                 [:th {:style (style/style (row-style-for-type header-cell) (heading-style-for-type header-cell) {:min-width :42px}) :title header-cell}
                  (truncate-text (h header-cell))]))
         (when bar-width
           [:th {:style (style/style (bar-td-style) (bar-th-style) {:width (str bar-width "%")})}]))])
(defn- render-bar
  [bar-width normalized-zero]
  (if (< bar-width normalized-zero)
    (list
     [:td {:style (style/style (bar-td-style) {:width :99%, :border-right "1px solid black", :padding-right 0})}
      (render-bar-component (style/secondary-color)
                            false
                            (normalized-score->pixels (- normalized-zero bar-width))
                            (normalized-score->pixels bar-width))]
     [:td {:style (style/style (bar-td-style) {:width :99%})}])
    (list
     (when-not (zero? normalized-zero)
       [:td {:style (style/style (bar-td-style) {:width :99%, :border-right "1px solid black"})}])
     [:td {:style (style/style (bar-td-style) {:width :99%, :padding-left 0})}
      (render-bar-component (style/primary-color)
                            true
                            (normalized-score->pixels (- bar-width normalized-zero)))])))

Render Hiccup <tbody> of a <table>.

get-background-color is a function that returned the background color for the current cell; it is invoked like

(get-background-color cell-value column-name row-index)

(defn- render-table-body
  [get-background-color normalized-zero column-names rows]
  [:tbody
   (for [[row-idx {:keys [row bar-width]}] (m/indexed rows)]
     [:tr {:style (style/style {:color style/color-gray-3})}
      (for [[col-idx cell] (m/indexed row)]
        [:td {:style (style/style
                      (row-style-for-type cell)
                      {:background-color (get-background-color cell (get column-names col-idx) row-idx)}
                      (when (and bar-width (= col-idx 1))
                        {:font-weight 700})
                      (when (= row-idx (dec (count rows)))
                        {:border-bottom 0})
                      (when (= col-idx (dec (count row)))
                        {:border-right 0}))}
         (h cell)])
      (some-> bar-width (render-bar normalized-zero))])])

This function returns the HTML data structure for the pulse table. color-selector is a function that returns the background color for a given cell. column-names is different from the header in header+rows as the header is the display_name (i.e. human friendly. header+rows includes the text contents of the table we're about ready to create. If normalized-zero is set (defaults to 0), render values less than it as negative

(defn render-table
  ([color-selector column-names contents]
   (render-table color-selector 0 column-names contents))
  ([color-selector normalized-zero column-names [header & rows]]
   [:table {:style (style/style {:max-width "100%"
                                 :white-space :nowrap
                                 :border  (str "1px solid " style/color-border)
                                 :border-radius :6px
                                 :width "1%"})
            :cellpadding "0"
            :cellspacing "0"}
    (render-table-head header)
    (render-table-body (partial color/get-background-color color-selector) normalized-zero column-names rows)]))
 

Utils for pulses.

(ns metabase.pulse.util
  (:require
   [metabase.models.dashboard-card :as dashboard-card]
   [metabase.query-processor :as qp]
   [metabase.query-processor.middleware.permissions :as qp.perms]
   [metabase.server.middleware.session :as mw.session]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [toucan2.core :as t2]))

Execute the query for a single Card. options are passed along to the Query Processor.

TODO - this should be done async

(defn execute-card
  [{pulse-creator-id :creator_id} card-or-id & {:as options}]
  ;; The Card must either be executed in the context of a User
  {:pre [(integer? pulse-creator-id)]}
  (let [card-id (u/the-id card-or-id)]
    (try
      (when-let [{query :dataset_query
                  :keys [dataset result_metadata]
                  :as card} (t2/select-one :model/Card :id card-id, :archived false)]
        (let [query         (assoc query :async? false)
              process-query (fn []
                              (binding [qp.perms/*card-id* card-id]
                                (qp/process-query-and-save-with-max-results-constraints!
                                 (assoc query :middleware {:process-viz-settings? true
                                                           :js-int-to-string?     false})
                                 (merge (cond->
                                          {:executed-by               pulse-creator-id
                                           :context                   :pulse
                                           :card-id                   card-id}
                                          dataset
                                          (assoc :metadata/dataset-metadata result_metadata))
                                        options))))
              result        (if pulse-creator-id
                              (mw.session/with-current-user pulse-creator-id
                                (process-query))
                              (process-query))]
          {:card   card
           :result result}))
      (catch Throwable e
        (log/warn e (trs "Error running query for Card {0}" card-id))))))

Multi series card is composed of multiple cards, all of which need to be executed.

This is as opposed to combo cards and cards with visualizations with multiple series, which are viz settings.

(defn execute-multi-card
  [card-or-id dashcard-or-id]
  (let [card-id      (u/the-id card-or-id)
        dashcard-id  (u/the-id dashcard-or-id)
        card         (t2/select-one :model/Card :id card-id, :archived false)
        dashcard     (t2/select-one :model/DashboardCard :id dashcard-id)
        multi-cards  (dashboard-card/dashcard->multi-cards dashcard)]
    (for [multi-card multi-cards]
      (execute-card {:creator_id (:creator_id card)} (:id multi-card)))))
 

Primary entrypoints to running Metabase (MBQL) queries.

(metabase.query-processor/process-query {:type :query, :database 1, :query {:source-table 2}})

Various REST API endpoints, such as POST /api/dataset, return the results of queries; calling one variations of process-userland-query (see documentation below).

(ns metabase.query-processor
  (:refer-clojure :exclude [compile])
  (:require
   [metabase.config :as config]
   [metabase.driver :as driver]
   [metabase.driver.util :as driver.u]
   [metabase.mbql.util :as mbql.u]
   [metabase.plugins.classloader :as classloader]
   [metabase.query-processor.context.default :as qp.context.default]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.middleware.add-default-temporal-unit
    :as qp.add-default-temporal-unit]
   [metabase.query-processor.middleware.add-dimension-projections
    :as qp.add-dimension-projections]
   [metabase.query-processor.middleware.add-implicit-clauses
    :as qp.add-implicit-clauses]
   [metabase.query-processor.middleware.add-implicit-joins
    :as qp.add-implicit-joins]
   [metabase.query-processor.middleware.add-rows-truncated
    :as qp.add-rows-truncated]
   [metabase.query-processor.middleware.add-source-metadata
    :as qp.add-source-metadata]
   [metabase.query-processor.middleware.add-timezone-info
    :as qp.add-timezone-info]
   [metabase.query-processor.middleware.annotate :as annotate]
   [metabase.query-processor.middleware.auto-bucket-datetimes
    :as qp.auto-bucket-datetimes]
   [metabase.query-processor.middleware.auto-parse-filter-values
    :as auto-parse-filter-values]
   [metabase.query-processor.middleware.binning :as binning]
   [metabase.query-processor.middleware.cache :as cache]
   [metabase.query-processor.middleware.catch-exceptions
    :as catch-exceptions]
   [metabase.query-processor.middleware.check-features :as check-features]
   [metabase.query-processor.middleware.constraints :as qp.constraints]
   [metabase.query-processor.middleware.cumulative-aggregations
    :as qp.cumulative-aggregations]
   [metabase.query-processor.middleware.desugar :as desugar]
   [metabase.query-processor.middleware.enterprise
    :as qp.middleware.enterprise]
   [metabase.query-processor.middleware.escape-join-aliases
    :as escape-join-aliases]
   [metabase.query-processor.middleware.expand-macros :as expand-macros]
   [metabase.query-processor.middleware.fetch-source-query
    :as fetch-source-query]
   [metabase.query-processor.middleware.fix-bad-references
    :as fix-bad-refs]
   [metabase.query-processor.middleware.format-rows :as format-rows]
   [metabase.query-processor.middleware.large-int-id :as large-int-id]
   [metabase.query-processor.middleware.limit :as limit]
   [metabase.query-processor.middleware.mbql-to-native :as mbql-to-native]
   [metabase.query-processor.middleware.normalize-query :as normalize]
   [metabase.query-processor.middleware.optimize-temporal-filters
    :as optimize-temporal-filters]
   [metabase.query-processor.middleware.parameters :as parameters]
   [metabase.query-processor.middleware.permissions :as qp.perms]
   [metabase.query-processor.middleware.persistence :as qp.persistence]
   [metabase.query-processor.middleware.pre-alias-aggregations
    :as qp.pre-alias-aggregations]
   [metabase.query-processor.middleware.prevent-infinite-recursive-preprocesses
    :as prevent-infinite-recursive-preprocesses]
   [metabase.query-processor.middleware.process-userland-query
    :as process-userland-query]
   [metabase.query-processor.middleware.reconcile-breakout-and-order-by-bucketing
    :as reconcile-bucketing]
   [metabase.query-processor.middleware.resolve-database-and-driver
    :as qp.resolve-database-and-driver]
   [metabase.query-processor.middleware.resolve-fields
    :as qp.resolve-fields]
   [metabase.query-processor.middleware.resolve-joined-fields
    :as resolve-joined-fields]
   [metabase.query-processor.middleware.resolve-joins :as resolve-joins]
   [metabase.query-processor.middleware.resolve-referenced
    :as qp.resolve-referenced]
   [metabase.query-processor.middleware.resolve-source-table
    :as qp.resolve-source-table]
   [metabase.query-processor.middleware.results-metadata
    :as results-metadata]
   [metabase.query-processor.middleware.splice-params-in-response
    :as splice-params-in-response]
   [metabase.query-processor.middleware.store :as store]
   [metabase.query-processor.middleware.upgrade-field-literals
    :as upgrade-field-literals]
   [metabase.query-processor.middleware.validate :as validate]
   [metabase.query-processor.middleware.validate-temporal-bucketing
    :as validate-temporal-bucketing]
   [metabase.query-processor.middleware.visualization-settings
    :as viz-settings]
   [metabase.query-processor.middleware.wrap-value-literals
    :as qp.wrap-value-literals]
   [metabase.query-processor.reducible :as qp.reducible]
   [metabase.query-processor.store :as qp.store]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu]))

+----------------------------------------------------------------------------------------------------------------+ | QUERY PROCESSOR | +----------------------------------------------------------------------------------------------------------------+

This is a namespace that adds middleware to test MLv2 stuff every time we run a query. It lives in a ./test namespace, so it's only around when running with :dev or the like.

Why not just do classloader/require in a try-catch and ignore exceptions? Because we want to know if this errors for some reason. If we accidentally break the namespace and just ignore exceptions, we could be skipping our tests without even knowing about it. So it's better to have this actually error if in cases where it SHOULD be working.

(when config/tests-available?
  (classloader/require 'metabase.query-processor-test.test-mlv2))

Pre-processing middleware. Has the form

(f query) -> query

(def ^:private pre-processing-middleware
  ;; ↓↓↓ PRE-PROCESSING ↓↓↓ happens from TOP TO BOTTOM
  [#'qp.perms/remove-permissions-key
   #'validate/validate-query
   #'expand-macros/expand-macros
   #'qp.resolve-referenced/resolve-referenced-card-resources
   #'parameters/substitute-parameters
   #'qp.resolve-source-table/resolve-source-tables
   #'qp.auto-bucket-datetimes/auto-bucket-datetimes
   #'reconcile-bucketing/reconcile-breakout-and-order-by-bucketing
   #'qp.add-source-metadata/add-source-metadata-for-source-queries
   #'upgrade-field-literals/upgrade-field-literals
   #'qp.middleware.enterprise/apply-sandboxing
   #'qp.persistence/substitute-persisted-query
   #'qp.add-implicit-clauses/add-implicit-clauses
   #'qp.add-dimension-projections/add-remapped-columns
   #'qp.resolve-fields/resolve-fields
   #'binning/update-binning-strategy
   #'desugar/desugar
   #'qp.add-default-temporal-unit/add-default-temporal-unit
   #'qp.add-implicit-joins/add-implicit-joins
   #'resolve-joins/resolve-joins
   #'resolve-joined-fields/resolve-joined-fields
   #'fix-bad-refs/fix-bad-references
   #'escape-join-aliases/escape-join-aliases
   ;; yes, this is called a second time, because we need to handle any joins that got added
   #'qp.middleware.enterprise/apply-sandboxing
   #'qp.cumulative-aggregations/rewrite-cumulative-aggregations
   #'qp.pre-alias-aggregations/pre-alias-aggregations
   #'qp.wrap-value-literals/wrap-value-literals
   #'auto-parse-filter-values/auto-parse-filter-values
   #'validate-temporal-bucketing/validate-temporal-bucketing
   #'optimize-temporal-filters/optimize-temporal-filters
   #'limit/add-default-limit
   #'qp.middleware.enterprise/apply-download-limit
   #'check-features/check-features])

All [[pre-processing-middleware]] combined into a single function. This still needs to be ran in the context of [[around-middleware]]. If you want to preprocess a query in isolation use [[preprocess]] below which combines this with the [[around-middleware]].

(defn- preprocess*
  [query]
  (reduce
   (fn [query middleware]
     (u/prog1 (cond-> query
                middleware middleware)
       (assert (map? <>) (format "%s did not return a valid query" (pr-str middleware)))))
   query
   pre-processing-middleware))

Middleware for query compilation. Happens after pre-processing. Has the form

(f (f query rff context)) -> (f query rff context)

(def ^:private compile-middleware
  [#'mbql-to-native/mbql->native])

Middleware that happens after compilation, AROUND query execution itself. Has the form

(f qp) -> qp

e.g.

(f (f query rff context)) -> (f query rff context)

(def ^:private execution-middleware
  [#'cache/maybe-return-cached-results
   #'qp.perms/check-query-permissions
   #'qp.middleware.enterprise/check-download-permissions-middleware
   #'qp.middleware.enterprise/maybe-apply-column-level-perms-check-middleware])

Post-processing middleware that transforms results. Has the form

(f preprocessed-query rff) -> rff

Where rff has the form

(f metadata) -> rf

(def ^:private post-processing-middleware
  [#'results-metadata/record-and-return-metadata!
   (resolve 'metabase.query-processor-test.test-mlv2/post-processing-middleware)
   #'limit/limit-result-rows
   #'qp.middleware.enterprise/limit-download-result-rows
   #'qp.add-rows-truncated/add-rows-truncated
   #'splice-params-in-response/splice-params-in-response
   #'qp.add-timezone-info/add-timezone-info
   #'qp.middleware.enterprise/merge-sandboxing-metadata
   #'qp.add-dimension-projections/remap-results
   #'format-rows/format-rows
   #'large-int-id/convert-id-to-string
   #'viz-settings/update-viz-settings
   #'qp.cumulative-aggregations/sum-cumulative-aggregation-columns
   #'annotate/add-column-info])

↑↑↑ POST-PROCESSING ↑↑↑ happens from BOTTOM TO TOP

Apply post-processing middleware to rff. Returns an rff.

(defn apply-post-processing-middleware
  [query rff]
  (reduce
   (fn [rff middleware]
     (u/prog1 (cond->> rff
                middleware (middleware query))
       (assert (fn? <>) (format "%s did not return a valid function" (pr-str middleware)))))
   rff
   post-processing-middleware))

Middleware that goes AROUND all the other middleware (even for pre-processing only or compilation only). Has the form

(f qp) -> qp

Where qp has the form

(f query rff context)

(def around-middleware
  ;; think of the direction stuff happens in as if you were throwing a ball up in the air; as the query-ball goes up the
  ;; around middleware pre-processing stuff happens; then the query is executed, as the "ball of results" comes back
  ;; down any post-processing these around middlewares might do happens in reversed order.
  ;;
  ;; ↓↓↓ POST-PROCESSING ↓↓↓ happens from TOP TO BOTTOM
  [#'fetch-source-query/resolve-card-id-source-tables
   #'qp.resolve-database-and-driver/resolve-driver-and-database-local-values
   #'store/initialize-store
   #'qp.resolve-database-and-driver/resolve-database
   ;; `normalize` has to be done at the very beginning or `resolve-card-id-source-tables` and the like might not work.
   ;; It doesn't really need to be 'around' middleware tho.
   (resolve 'metabase.query-processor-test.test-mlv2/around-middleware)
   #'normalize/normalize
   #'qp.middleware.enterprise/handle-audit-app-internal-queries-middleware])

↑↑↑ PRE-PROCESSING ↑↑↑ happens from BOTTOM TO TOP

query -> preprocessed = around + pre-process query -> native = around + pre-process + compile query -> results = around + pre-process + compile + execute + post-process = default-middleware

The default set of middleware applied to queries ran via [[process-query]]. NOTE: if you add any new middleware groups, you may need to modify [[dev.debug-qp/default-debug-middleware]] as well, so that [[dev.debug-qp/process-query-debug]] still works as expected.

(def default-middleware
  (letfn [(combined-pre-process [qp]
            (fn combined-pre-process* [query rff context]
              (qp (preprocess* query) rff context)))
          (combined-post-process [qp]
            (fn combined-post-process* [query rff context]
              (qp query (apply-post-processing-middleware query rff) context)))]
    (into
     []
     (comp cat (keep identity))
     [execution-middleware      ; → → execute → → ↓
      compile-middleware        ; ↑ compile       ↓
      [combined-post-process]   ; ↑               ↓ post-process
      [combined-pre-process]    ; ↑ pre-process   ↓
      around-middleware])))     ; ↑ query         ↓ results

In REPL-based dev rebuild the QP every time it is called; this way we don't need to reload this namespace when middleware is changed. Outside of dev only build the QP once for performance/locality

(defn- base-qp [middleware]
  (letfn [(qp []
            (qp.reducible/async-qp (qp.reducible/combine-middleware middleware)))]
    (if config/is-dev?
      (fn [& args]
        (apply (qp) args))
      (qp))))

Process a query asynchronously, returning a core.async channel that is called with the final result (or Throwable).

(def ^{:arglists '([query] [query context] [query rff context])} process-query-async
  (base-qp default-middleware))

Process a query synchronously, blocking until results are returned. Throws raised Exceptions directly.

(def ^{:arglists '([query] [query context] [query rff context])} process-query-sync
  (qp.reducible/sync-qp process-query-async))

Process an MBQL query. This is the main entrypoint to the magical realm of the Query Processor. Returns a single core.async channel if option :async? is true; otherwise returns results in the usual format. For async queries, if the core.async channel is closed, the query will be canceled.

(mu/defn process-query
  ([query]
   (process-query query nil))
  ([query context]
   (process-query query nil context))
  ([{:keys [async?], :as query} :- :map
    rff                         :- [:maybe fn?]
    context                     :- [:maybe
                                    [:and
                                     :map
                                     [:fn
                                      {:error/message ":rff should no longer be included in context, pass it as a separate argument."}
                                      (complement :rff)]]]]
   (let [rff     (or rff qp.reducible/default-rff)
         context (or context (qp.context.default/default-context))]
     ((if async? process-query-async process-query-sync) query rff context))))

Return the fully preprocessed form for query, the way it would look immediately before [[mbql-to-native/mbql->native]] is called.

(defn preprocess
  [query]
  (let [qp (qp.reducible/combine-middleware
            (conj (vec around-middleware)
                  prevent-infinite-recursive-preprocesses/prevent-infinite-recursive-preprocesses)
            (fn [query _rff _context]
              (preprocess* query)))]
    (qp query nil nil)))
(defn- restore-join-aliases [preprocessed-query]
  (let [replacement (-> preprocessed-query :info :alias/escaped->original)]
    (escape-join-aliases/restore-aliases preprocessed-query replacement)))

Return the :cols you would normally see in MBQL query results by preprocessing the query and calling annotate on it. This only works for pure MBQL queries, since it does not actually run the queries. Native queries or MBQL queries with native source queries won't work, since we don't need the results.

(defn query->expected-cols
  [{query-type :type, :as query}]
  (when-not (= (mbql.u/normalize-token query-type) :query)
    (throw (ex-info (tru "Can only determine expected columns for MBQL queries.")
                    {:type qp.error-type/qp})))
  ;; TODO - we should throw an Exception if the query has a native source query or at least warn about it. Need to
  ;; check where this is used.
  (qp.store/with-metadata-provider (qp.resolve-database-and-driver/resolve-database-id query)
    (let [preprocessed (-> query preprocess restore-join-aliases)]
      (driver/with-driver (driver.u/database->driver (:database preprocessed))
        (->> (annotate/merged-column-info preprocessed nil)
             ;; remove MLv2 columns so we don't break a million tests. Once the whole QP is updated to use MLv2 metadata
             ;; directly we can stop stripping these out
             (mapv (fn [col]
                     (dissoc col :lib/external_remap :lib/internal_remap)))
             not-empty)))))

Return the native form for query (e.g. for a MBQL query on Postgres this would return a map containing the compiled SQL form). Like preprocess, this function will throw an Exception if preprocessing was not successful.

(defn compile
  [query]
  (let [qp (qp.reducible/combine-middleware
            (conj (vec around-middleware)
                  prevent-infinite-recursive-preprocesses/prevent-infinite-recursive-preprocesses)
            (fn [query _rff _context]
              (mbql-to-native/query->native-form (preprocess* query))))]
    (qp query nil nil)))

Return the native form for a query, with any prepared statement (or equivalent) parameters spliced into the query itself as literals. This is used to power features such as 'Convert this Question to SQL'. (Currently, this function is mostly used by tests and in the REPL; [[splice-params-in-response/splice-params-in-response]] middleware handles similar functionality for queries that are actually executed.)

(defn compile-and-splice-parameters
  [query]
  ;; We need to preprocess the query first to get a valid database in case we're dealing with a nested query whose DB
  ;; ID is the virtual DB identifier
  (let [driver (driver.u/database->driver (:database (preprocess query)))]
    (driver/splice-parameters-into-native-query driver (compile query))))

+----------------------------------------------------------------------------------------------------------------+ | Userland Queries (Public Interface) | +----------------------------------------------------------------------------------------------------------------+

The default set of middleware applied to 'userland' queries ran via [[process-query-and-save-execution!]] (i.e., via the REST API). This middleware has the pattern

(f (f query rff context)) -> (f query rff context)

The difference between process-query and the versions below is that the ones below are meant to power various things like API endpoints and pulses, while process-query is more of a low-level internal function.

(def userland-middleware
  (concat
   default-middleware
   [#'qp.constraints/add-default-userland-constraints
    #'process-userland-query/process-userland-query
    #'catch-exceptions/catch-exceptions]))

Like [[process-query-async]], but for 'userland' queries (e.g., queries ran via the REST API). Adds extra middleware.

(def ^{:arglists '([query] [query context] [query rff context])} ^:private process-userland-query-async
  (base-qp userland-middleware))

Like [[process-query-sync]], but for 'userland' queries (e.g., queries ran via the REST API). Adds extra middleware.

(def ^{:arglists '([query] [query context] [query rff context])} process-userland-query-sync
  (qp.reducible/sync-qp process-userland-query-async))

Like [[process-query]], but for 'userland' queries (e.g., queries ran via the REST API). Adds extra middleware.

(defn process-userland-query
  {:arglists '([query] [query context] [query rff context])}
  [{:keys [async?], :as query} & args]
  (apply (if async? process-userland-query-async process-userland-query-sync)
         query
         args))

Process and run a 'userland' MBQL query (e.g. one ran as the result of an API call, scheduled Pulse, etc). Returns results in a format appropriate for consumption by FE client. Saves QueryExecution row in application DB.

(defn process-query-and-save-execution!
  ([query info]
   (process-userland-query (assoc query :info info)))
  ([query info context]
   (process-userland-query (assoc query :info info) context))
  ([query info rff context]
   (process-userland-query (assoc query :info info) rff context)))
(defn- add-default-constraints [query]
  (assoc-in query [:middleware :add-default-userland-constraints?] true))

Same as [[process-query-and-save-execution!]] but will include the default max rows returned as a constraint. (This function is ulitmately what powers most API endpoints that run queries, including POST /api/dataset.)

(defn process-query-and-save-with-max-results-constraints!
  ([query info]
   (process-query-and-save-execution! (add-default-constraints query) info))
  ([query info context]
   (process-query-and-save-execution! (add-default-constraints query) info context))
  ([query info rff context]
   (process-query-and-save-execution! (add-default-constraints query) info rff context)))
 

Mostly legacy namespace that these days is reduced to a single util function, result-metadata-for-query-async. TODO -- Consider whether there's a place to put this to consolidate things.

(ns metabase.query-processor.async
  (:require
   [clojure.core.async :as a]
   [metabase.api.common :as api]
   [metabase.query-processor :as qp]
   [metabase.query-processor.context :as qp.context]
   [metabase.query-processor.interface :as qp.i]
   [metabase.query-processor.util :as qp.util]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [schema.core :as s])
  (:import
   (clojure.core.async.impl.channels ManyToManyChannel)))
(defn- query-for-result-metadata [query]
  ;; for purposes of calculating the actual Fields & types returned by this query we really only need the first
  ;; row in the results
  (let [query (-> query
                  (assoc-in [:constraints :max-results] 1)
                  (assoc-in [:constraints :max-results-bare-rows] 1)
                  (assoc-in [:info :executed-by] api/*current-user-id*))]
    ;; need add the constraints above before calculating hash because those affect the hash
    ;;
    ;; (normally middleware takes care of calculating query hashes for 'userland' queries but this is not
    ;; technically a userland query -- we don't want to save a QueryExecution -- so we need to add `executed-by`
    ;; and `query-hash` ourselves so the remark gets added)
    (assoc-in query [:info :query-hash] (qp.util/query-hash query))))
(defn- async-result-metadata-reducedf [result context]
  (let [results-metdata (or (get-in result [:data :results_metadata :columns])
                            [])]
    (qp.context/resultf results-metdata context)))
(defn- async-result-metdata-raisef [e context]
  (log/error e (trs "Error running query to determine Card result metadata:"))
  (qp.context/resultf [] context))
(s/defn result-metadata-for-query-async :- ManyToManyChannel
  "Fetch the results metadata for a `query` by running the query and seeing what the QP gives us in return.
   This is obviously a bit wasteful so hopefully we can avoid having to do this. Returns a channel to get the
   results."
  [query]
  (binding [qp.i/*disable-qp-logging* true]
    ;; for MBQL queries we can infer the columns just by preprocessing the query.
    (if-let [inferred-columns (not-empty (u/ignore-exceptions (qp/query->expected-cols query)))]
      (let [chan (a/promise-chan)]
        (a/>!! chan inferred-columns)
        (a/close! chan)
        chan)
      ;; for *native* queries we actually have to run it.
      (let [query (query-for-result-metadata query)]
        (qp/process-query-async query {:reducedf async-result-metadata-reducedf
                                       :raisef   async-result-metdata-raisef})))))
 

Code for running a query in the context of a specific Card.

(ns metabase.query-processor.card
  (:require
   [clojure.string :as str]
   [medley.core :as m]
   [metabase.api.common :as api]
   [metabase.lib.schema.template-tag :as lib.schema.template-tag]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.card :as card :refer [Card]]
   [metabase.models.dashboard :refer [Dashboard]]
   [metabase.models.database :refer [Database]]
   [metabase.models.query :as query]
   [metabase.public-settings :as public-settings]
   [metabase.public-settings.premium-features
    :as premium-features
    :refer [defenterprise]]
   [metabase.query-processor :as qp]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.middleware.constraints :as qp.constraints]
   [metabase.query-processor.middleware.permissions :as qp.perms]
   [metabase.query-processor.streaming :as qp.streaming]
   [metabase.query-processor.util :as qp.util]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   #_{:clj-kondo/ignore [:discouraged-namespace]}
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

Compute a 'magic' cache TTL time (in seconds) for query by multipling its historic average execution times by the query-caching-ttl-ratio. If the TTL is less than a second, this returns nil (i.e., the cache should not be utilized.)

(defn- query-magic-ttl
  [query]
  (when-let [average-duration (query/average-execution-time-ms (qp.util/query-hash query))]
    (let [ttl-seconds (Math/round (float (/ (* average-duration (public-settings/query-caching-ttl-ratio))
                                            1000.0)))]
      (when-not (zero? ttl-seconds)
        (log/info (trs "Question''s average execution duration is {0}; using ''magic'' TTL of {1}"
                       (u/format-milliseconds average-duration) (u/format-seconds ttl-seconds))
                  (u/emoji "💾"))
        ttl-seconds))))

Returns the granular cache ttl (in seconds) for a card. On EE, this first checking whether there is a stored value for the card, dashboard, or database (in that order of decreasing preference). Returns nil on OSS.

(defenterprise granular-ttl
  metabase-enterprise.advanced-config.caching
  [_card _dashboard _database])

Returns the cache ttl (in seconds), by first checking whether there is a stored value for the database, dashboard, or card (in that order of increasing preference), and if all of those don't exist, then the query-magic-ttl, which is based on average execution time.

(defn- ttl-hierarchy
  [card dashboard database query]
  (when (public-settings/enable-query-caching)
    (or (granular-ttl card dashboard database)
        (query-magic-ttl query))))

Generate a query for a saved Card

(defn query-for-card
  [{query :dataset_query
    :as   card} parameters constraints middleware & [ids]]
  (let [query     (-> query
                      ;; don't want default constraints overridding anything that's already there
                      (m/dissoc-in [:middleware :add-default-userland-constraints?])
                      (assoc :constraints constraints
                             :parameters  parameters
                             :middleware  middleware))
        dashboard (t2/select-one [Dashboard :cache_ttl] :id (:dashboard-id ids))
        database  (t2/select-one [Database :cache_ttl] :id (:database_id card))
        ttl-secs  (ttl-hierarchy card dashboard database query)]
    (assoc query :cache-ttl ttl-secs)))

In 0.41.0+ you can no longer add arbitrary :parameters to a query for a saved question -- only parameters for template tags that are part of a /native/ query may be supplied (only native queries can have template tags); the type of the parameter has to agree with the type of the template tag as well. This variable controls whether or not this constraint is enforced.

Normally, when running a query in the context of a /Card/, this is false, and the constraint is enforced. By binding this to a truthy value you can disable the checks. Currently this is only done by [[metabase.query-processor.dashboard]], which does its own parameter validation before handing off to the code here.

(def ^:dynamic *allow-arbitrary-mbql-parameters*
  false)

Template tag parameters that have been specified for the query for Card with card-id, if any, returned as a map in the format

{"templatetagparameter_name" :parameter-type, ...}

Template tag parameter name is the name of the parameter as it appears in the query, e.g. {{id}} has the :name "id".

Parameter type in this case is something like :string or :number or :date/month-year; parameters passed in as parameters to the API request must be allowed for this type (i.e. :string/= is allowed for a :string parameter, but :number/= is not).

(defn- card-template-tag-parameters
  [card-id]
  (let [query (api/check-404 (t2/select-one-fn :dataset_query Card :id card-id))]
    (into
     {}
     (comp
      (map (fn [[param-name {widget-type :widget-type, tag-type :type}]]
             ;; Field Filter parameters have a `:type` of `:dimension` and the widget type that should be used is
             ;; specified by `:widget-type`. Non-Field-filter parameters just have `:type`. So prefer
             ;; `:widget-type` if available but fall back to `:type` if not.
             (cond
               (and (= tag-type :dimension)
                    (not= widget-type :none))
               [param-name widget-type]
               (contains? mbql.s/raw-value-template-tag-types tag-type)
               [param-name tag-type])))
      (filter some?))
     (get-in query [:native :template-tags]))))
(defn- allowed-parameter-type-for-template-tag-widget-type? [parameter-type widget-type]
  (when-let [allowed-template-tag-types (get-in mbql.s/parameter-types [parameter-type :allowed-for])]
    (contains? allowed-template-tag-types widget-type)))
(defn- allowed-parameter-types-for-template-tag-widget-type [widget-type]
  (into #{} (for [[parameter-type {:keys [allowed-for]}] mbql.s/parameter-types
                  :when                                  (contains? allowed-for widget-type)]
              parameter-type)))

If a parameter (i.e., a template tag or Dashboard parameter) is specified with widget-type (e.g. :date/all-options), make sure a user is allowed to pass in parameters with value type parameter-value-type (e.g. :date/range) for it when running the query, otherwise throw an Exception.

parameter-name is used only for the Exception message and data and can be a name or parameter ID (whichever is more appropriate; Dashboard stuff uses ID while Card stuff tends to use :name at this point).

Background: some more-specific parameter types aren't allowed for certain types of parameters. See [[metabase.mbql.schema/parameter-types]] for details.

(mu/defn check-allowed-parameter-value-type
  [parameter-name
   widget-type          :- ::lib.schema.template-tag/widget-type
   parameter-value-type :- ::mbql.s/ParameterType]
  (when-not (allowed-parameter-type-for-template-tag-widget-type? parameter-value-type widget-type)
    (let [allowed-types (allowed-parameter-types-for-template-tag-widget-type widget-type)]
      (throw (ex-info (tru "Invalid parameter type {0} for parameter {1}. Parameter type must be one of: {2}"
                           parameter-value-type
                           (pr-str parameter-name)
                           (str/join ", " (sort allowed-types)))
                      {:type              qp.error-type/invalid-parameter
                       :invalid-parameter parameter-name
                       :template-tag-type widget-type
                       :allowed-types     allowed-types})))))

Attempt to infer the name of a parameter. Uses :name if explicitly specified, otherwise attempts to infer this by parsing :target. Parameters are matched up by name for validation purposes.

(defn- infer-parameter-name
  [{parameter-name :name, :keys [target]}]
  (or
   parameter-name
   (mbql.u/match-one target
     [:template-tag tag-name]
     (name tag-name))))

Unless [[allow-arbitrary-mbql-parameters]] is truthy, check to make all supplied parameters actually match up with template tags in the query for Card with card-id.

(mu/defn ^:private validate-card-parameters
  [card-id    :- ms/PositiveInt
   parameters :- mbql.s/ParameterList]
  (when-not *allow-arbitrary-mbql-parameters*
    (let [template-tags (card-template-tag-parameters card-id)]
      (doseq [request-parameter parameters
              :let              [parameter-name (infer-parameter-name request-parameter)]]
        (let [matching-widget-type (or (get template-tags parameter-name)
                                       (throw (ex-info (tru "Invalid parameter: Card {0} does not have a template tag named {1}."
                                                            card-id
                                                            (pr-str parameter-name))
                                                       {:type               qp.error-type/invalid-parameter
                                                        :invalid-parameter  request-parameter
                                                        :allowed-parameters (keys template-tags)})))]
          ;; now make sure the type agrees as well
          (check-allowed-parameter-value-type parameter-name matching-widget-type (:type request-parameter)))))))

Run the query for Card with parameters and constraints, and return results in a metabase.async.streaming_response.StreamingResponse (see [[metabase.async.streaming-response]]) that should be returned as the result of an API endpoint fn. Will throw an Exception if preconditions (such as read perms) are not met before returning the StreamingResponse.

context is a keyword describing the situation in which this query is being ran, e.g. :question (from a Saved Question) or :dashboard (from a Saved Question in a Dashboard). See [[metabase.mbql.schema/Context]] for all valid options.

(defn run-query-for-card-async
  [card-id export-format
   & {:keys [parameters constraints context dashboard-id dashcard-id middleware qp-runner run ignore_cache]
      :or   {constraints (qp.constraints/default-query-constraints)
             context     :question
             qp-runner   qp/process-query-and-save-execution!}}]
  {:pre [(int? card-id) (u/maybe? sequential? parameters)]}
  (let [run       (or run
                      ;; param `run` can be used to control how the query is ran, e.g. if you need to
                      ;; customize the `context` passed to the QP
                      (^:once fn* [query info]
                       (qp.streaming/streaming-response [{:keys [rff context]} export-format (u/slugify (:card-name info))]
                         (qp-runner query info rff context))))
        dash-viz  (when (not= context :question)
                    (t2/select-one-fn :visualization_settings :model/DashboardCard :id dashcard-id))
        card      (api/read-check (t2/select-one [Card :id :name :dataset_query :database_id :cache_ttl :collection_id
                                                  :dataset :result_metadata :visualization_settings]
                                                 :id card-id))
        query     (-> (query-for-card card parameters constraints middleware {:dashboard-id dashboard-id})
                      (update :viz-settings (fn [viz] (merge viz dash-viz)))
                      (assoc :async? true)
                      (update :middleware (fn [middleware]
                                            (merge
                                             {:js-int-to-string? true :ignore-cached-results? ignore_cache}
                                             middleware))))
        info      (cond-> {:executed-by            api/*current-user-id*
                           :context                context
                           :card-id                card-id
                           :card-name              (:name card)
                           :dashboard-id           dashboard-id
                           :visualization-settings (:visualization_settings card)}
                    (and (:dataset card) (seq (:result_metadata card)))
                    (assoc :metadata/dataset-metadata (:result_metadata card)))]
    (api/check-not-archived card)
    (when (seq parameters)
      (validate-card-parameters card-id (mbql.normalize/normalize-fragment [:parameters] parameters)))
    (log/tracef "Running query for Card %d:\n%s" card-id
                (u/pprint-to-str query))
    (binding [qp.perms/*card-id* card-id]
      (run query info))))
 

Interface for the QP context/utility functions for using the things in the context correctly.

The default implementations of all these functions live in [[metabase.query-processor.context.default]]; refer to those when overriding individual functions. Some wiring for the [[clojure.core.async]] channels takes place in [[metabase.query-processor.reducible]].

(ns metabase.query-processor.context
  (:require
   [metabase.async.util :as async.u]))

Raise an Exception.

(defn raisef
  {:arglists '([e context])}
  [e {raisef* :raisef, :as context}]
  {:pre [(fn? raisef*)]}
  (raisef* e context))

Called by the [[metabase.query-processor.reducible/identity-qp]] fn to run preprocessed query. Normally, this simply calls [[executef]], but you can override this for test purposes. The result of this function is ignored.

Normal flow is something like:

[middleware] → runf → executef → reducef → reducedf -\ ↓ ↦ resultf → out-chan [Exception] → raisef -------------------------------/ ↑ ↑ | timeoutf | ↑ | [time out] [out-chan closed early] | ↓ [closes] | canceled-chan --------------------------/ ↑ [message sent to canceled chan]

  1. Query normally runs thru middleware and then a series of context functions as described above; result is sent thru [[resultf]] and finally to [[out-chan]]

  2. If an Exception is thrown, it is sent thru [[raisef]], [[resultf]] and finally to [[out-chan]]

  3. If the query times out, timeoutf throws an Exception

  4. If the query is canceled (either by closing [[out-chan]] before it gets a result, or by sending [[canceled-chan]] a message), the execution is canceled and [[out-chan]] is closed (if not already closed).

(defn runf
  {:arglists '([query rff context])}
  [query rff {runf* :runf, :as context}]
  {:pre [(fn? runf*)]}
  (runf* query rff context)
  nil)

Called by [[runf]] to have driver run query. By default, [[metabase.driver/execute-reducible-query]]. respond is a callback with the signature:

(respond results-metadata reducible-rows)

The implementation of [[executef]] should call respond with this information once it is available. The result of this function is ignored.

(defn executef
  {:arglists '([driver query context respond])}
  [driver query {executef* :executef, :as context} respond]
  {:pre [(ifn? executef*)]}
  (executef* driver query context respond)
  nil)

Called by [[runf]] (inside the respond callback provided by it) to reduce results of query. [[reducedf]] is called with the reduced results. The actual output of this function is ignored, but the entire result set must be reduced and passed to [[reducedf]] before this function completes.

(defn reducef
  {:arglists '([rff context metadata reducible-rows])}
  [rff {reducef* :reducef, :as context} metadata reducible-rows]
  {:pre [(fn? reducef*)]}
  (reducef* rff context metadata reducible-rows)
  nil)

Called in [[reducedf]] with fully reduced results. This result is passed to [[resultf]].

(defn reducedf
  {:arglists '([reduced-rows context])}
  [reduced-rows {reducedf* :reducedf, :as context}]
  {:pre [(fn? reducedf*)]}
  (reducedf* reduced-rows context))

Call this function when a query times out.

(defn timeoutf
  {:arglists '([context])}
  [{timeoutf* :timeoutf, :as context}]
  {:pre [(fn? timeoutf*)]}
  (timeoutf* context))

Called exactly once with the final result, which is the result of either [[reducedf]] or [[raisef]].

(defn resultf
  {:arglists '([result context])}
  [result {resultf* :resultf, :as context}]
  {:pre [(fn? resultf*)]}
  (resultf* result context))

Maximum amount of time query is allowed to run, in ms.

(defn timeout
  {:arglists '([context])}
  [{timeout* :timeout}]
  {:pre [(int? timeout*)]}
  timeout*)

Gets a message if query is canceled.

(defn canceled-chan
  {:arglists '([context])}
  [{canceled-chan* :canceled-chan}]
  {:pre [(async.u/promise-chan? canceled-chan*)]}
  canceled-chan*)

Gets a message with the final result.

(defn out-chan
  {:arglists '([context])}
  [{out-chan* :out-chan}]
  {:pre [(async.u/promise-chan? out-chan*)]}
  out-chan*)
 
(ns metabase.query-processor.context.default
  (:require
   [clojure.core.async :as a]
   [metabase.config :as config]
   [metabase.driver :as driver]
   [metabase.query-processor.context :as qp.context]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]))

Maximum amount of time to wait for a running query to complete before throwing an Exception.

(def query-timeout-ms
  ;; I don't know if these numbers make sense, but my thinking is we want to enable (somewhat) long-running queries on
  ;; prod but for test and dev purposes we want to fail faster because it usually means I broke something in the QP
  ;; code
  (u/minutes->ms
   (if config/is-prod?
     20
     3)))
(defn- default-reducedf [reduced-result context]
  (qp.context/resultf reduced-result context))

Default implementation of reducef. When using a custom implementation of reducef it's easiest to call this function inside the custom impl instead of attempting to duplicate the logic. See [[metabase.query-processor.reducible-test/write-rows-to-file-test]] for an example of a custom implementation.

(defn default-reducef
  [rff context metadata reducible-rows]
  {:pre [(fn? rff)]}
  (let [rf (rff metadata)]
    (assert (fn? rf))
    (when-let [reduced-rows (try
                              (transduce identity rf reducible-rows)
                              (catch Throwable e
                                (qp.context/raisef (ex-info (tru "Error reducing result rows: {0}" (ex-message e))
                                                            {:type qp.error-type/qp}
                                                            e)
                                                   context)))]
      (qp.context/reducedf reduced-rows context))))
(defn- default-runf [query rff context]
  (try
    (qp.context/executef driver/*driver* query context (fn respond* [metadata reducible-rows]
                                                         (qp.context/reducef rff context metadata reducible-rows)))
    (catch Throwable e
      (qp.context/raisef e context))))
(defn- default-raisef [e context]
  {:pre [(instance? Throwable e)]}
  (qp.context/resultf e context))
(defn- default-resultf [result context]
  (if (nil? result)
    (do
      (log/error (ex-info (trs "Unexpected nil result") {}))
      (recur false context))
    (let [out-chan (qp.context/out-chan context)]
      (a/>!! out-chan result)
      (a/close! out-chan))))
(defn- default-timeoutf
  [context]
  (let [timeout (qp.context/timeout context)]
    (log/debug (trs "Query timed out after {0}, raising timeout exception." (u/format-milliseconds timeout)))
    (qp.context/raisef (ex-info (tru "Timed out after {0}." (u/format-milliseconds timeout))
                                {:status :timed-out
                                 :type   qp.error-type/timed-out})
                       context)))

Return a new context for executing queries using the default values. These can be overrided as needed.

(defn default-context
  []
  {::complete?    true
   :timeout       query-timeout-ms
   :raisef        default-raisef
   :runf          default-runf
   :executef      driver/execute-reducible-query
   :reducef       default-reducef
   :reducedf      default-reducedf
   :timeoutf      default-timeoutf
   :resultf       default-resultf
   :canceled-chan (a/promise-chan)
   :out-chan      (a/promise-chan)})
 

Code for running a query in the context of a specific DashboardCard.

(ns metabase.query-processor.dashboard
  (:require
   [clojure.string :as str]
   [medley.core :as m]
   [metabase.api.common :as api]
   [metabase.driver.common.parameters.operators :as params.ops]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.models.dashboard :as dashboard :refer [Dashboard]]
   [metabase.models.dashboard-card :refer [DashboardCard]]
   [metabase.models.dashboard-card-series :refer [DashboardCardSeries]]
   [metabase.query-processor.card :as qp.card]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.middleware.constraints :as qp.constraints]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [steffan-westcott.clj-otel.api.trace.span :as span]
   #_{:clj-kondo/ignore [:discouraged-namespace]}
   [toucan2.core :as t2]))

Check that the Card with card-id is in Dashboard with dashboard-id, either in the DashboardCard with dashcard-id at the top level or as a series. If not such relationship exists this will throw a 404 Exception.

(defn- check-card-and-dashcard-are-in-dashboard
  [dashboard-id card-id dashcard-id]
  (api/check-404
   (or (t2/exists? DashboardCard
         :id           dashcard-id
         :dashboard_id dashboard-id
         :card_id      card-id)
       (and
        (t2/exists? DashboardCard
          :id           dashcard-id
          :dashboard_id dashboard-id)
        (t2/exists? DashboardCardSeries
          :card_id          card-id
          :dashboardcard_id dashcard-id)))))
(defn- resolve-param-for-card
  [card-id dashcard-id param-id->param {param-id :id, :as request-param}]
  (when-not param-id
    (throw (ex-info (tru "Unable to resolve invalid query parameter: parameter is missing :id")
                    {:type              qp.error-type/invalid-parameter
                     :invalid-parameter request-param})))
  (log/tracef "Resolving parameter %s\n%s" (pr-str param-id) (u/pprint-to-str request-param))
  ;; find information about this dashboard parameter by its parameter `:id`. If no parameter with this ID
  ;; exists, it is an error.
  (let [matching-param (or (get param-id->param param-id)
                           (throw (ex-info (tru "Dashboard does not have a parameter with ID {0}." (pr-str param-id))
                                           {:type        qp.error-type/invalid-parameter
                                            :status-code 400})))]
    (log/tracef "Found matching Dashboard parameter\n%s" (u/pprint-to-str (update matching-param :mappings (fn [mappings]
                                                                                                             (into #{} (map #(dissoc % :dashcard)) mappings)))))
    ;; now find the mapping for this specific card. If there is no mapping, we can just ignore this parameter.
    (when-let [matching-mapping (or (some (fn [mapping]
                                            (when (and (= (:card_id mapping) card-id)
                                                       (= (get-in mapping [:dashcard :id]) dashcard-id))
                                              mapping))
                                          (:mappings matching-param))
                                    (log/tracef "Parameter has no mapping for Card %d; skipping" card-id))]
      (log/tracef "Found matching mapping for Card %d, Dashcard %d:\n%s"
                  card-id dashcard-id
                  (u/pprint-to-str (update matching-mapping :dashcard #(select-keys % [:id :parameter_mappings]))))
      ;; if `request-param` specifies type, then validate that the type is allowed
      (when (:type request-param)
        (qp.card/check-allowed-parameter-value-type
         param-id
         (or (when (and (= (:type matching-param) :dimension)
                        (not= (:widget-type matching-param) :none))
               (:widget-type matching-param))
             (:type matching-param))
         (:type request-param)))
      ;; ok, now return the merged parameter info map.
      (merge
       {:type (:type matching-param)}
       request-param
       ;; if value comes in as a lone value for an operator filter type (as will be the case for embedding) wrap it in a
       ;; vector so the parameter handling code doesn't explode.
       (let [value (:value request-param)]
         (when (and (params.ops/operator? (:type matching-param))
                    (if (string? value)
                      (not (str/blank? value))
                      (some? value))
                    (not (sequential? value)))
           {:value [value]}))
       {:id     param-id
        :target (:target matching-mapping)}))))

DashboardCard parameter mappings can specify default values, and we need to make sure the parameters map returned by [[resolve-params-for-query]] includes entries for any default values. So we'll do this by creating a entries for all the parameters with defaults, and then merge together a map of param-id->default-entry with a map of param-id->request-entry (so the value from the request takes precedence over the default value)

Construct parameter entries for any parameters with default values in dashboard-param-id->param as returned by [[dashboard/dashboard->resolved-params]].

(defn- dashboard-param-defaults
  [dashboard-param-id->param card-id]
  (into
   {}
   (comp (filter (fn [[_ {:keys [default]}]]
                   default))
         (map (fn [[param-id {:keys [default mappings]}]]
                [param-id {:id      param-id
                           :default default
                           ;; make sure we include target info so we can actually map this back to a template
                           ;; tag/param declaration
                           :target (some (fn [{mapping-card-id :card_id, :keys [target]}]
                                            (when (= mapping-card-id card-id)
                                              target))
                                         mappings)}]))
         (filter (fn [[_ {:keys [target]}]]
                   target)))
   dashboard-param-id->param))
(mu/defn ^:private resolve-params-for-query :- [:maybe [:sequential :map]]
  "Given a sequence of parameters included in a query-processing request to run the query for a Dashboard/Card, validate
  that those parameters exist and have allowed types, and merge in default values and other info from the parameter
  mappings."
  [dashboard-id   :- ms/PositiveInt
   card-id        :- ms/PositiveInt
   dashcard-id    :- ms/PositiveInt
   request-params :- [:maybe [:sequential :map]]]
  (log/tracef "Resolving Dashboard %d Card %d query request parameters" dashboard-id card-id)
  (let [request-params            (mbql.normalize/normalize-fragment [:parameters] request-params)
        ;; ignore default values in request params as well. (#20516)
        request-params            (for [param request-params]
                                    (dissoc param :default))
        dashboard                 (api/check-404 (t2/select-one Dashboard :id dashboard-id))
        dashboard-param-id->param (into {}
                                        ;; remove the `:default` values from Dashboard params. We don't ACTUALLY want to
                                        ;; use these values ourselves -- the expectation is that the frontend will pass
                                        ;; them in as an actual `:value` if it wants to use them. If we leave them
                                        ;; around things get confused and it prevents us from actually doing the
                                        ;; expected `1 = 1` substitution for Field filters. See comments in #20503 for
                                        ;; more information.
                                        (map (fn [[param-id param]]
                                               [param-id (dissoc param :default)]))
                                        (dashboard/dashboard->resolved-params dashboard))
        request-param-id->param   (into {} (map (juxt :id identity)) request-params)
        merged-parameters         (vals (merge (dashboard-param-defaults dashboard-param-id->param card-id)
                                               request-param-id->param))]
    (log/tracef "Dashboard parameters:\n%s\nRequest parameters:\n%s\nMerged:\n%s"
                (u/pprint-to-str (->> dashboard-param-id->param
                                      (m/map-vals (fn [param]
                                                    (update param :mappings (fn [mappings]
                                                                              (into #{} (map #(dissoc % :dashcard)) mappings)))))))
                (u/pprint-to-str request-param-id->param)
                (u/pprint-to-str merged-parameters))
    (u/prog1
      (into [] (comp (map (partial resolve-param-for-card card-id dashcard-id dashboard-param-id->param))
                     (filter some?))
            merged-parameters)
      (log/tracef "Resolved =>\n%s" (u/pprint-to-str <>)))))

Like [[metabase.query-processor.card/run-query-for-card-async]], but runs the query for a DashboardCard with parameters and constraints. Returns a metabase.async.streaming_response.StreamingResponse (see [[metabase.async.streaming-response]]). Will throw an Exception if preconditions such as proper permissions are not met before returning the StreamingResponse.

See [[metabase.query-processor.card/run-query-for-card-async]] for more information about the various parameters.

(defn run-query-for-dashcard-async
  {:arglists '([& {:keys [dashboard-id card-id dashcard-id export-format parameters ignore_cache constraints parameters middleware]}])}
  [& {:keys [dashboard-id card-id dashcard-id parameters export-format]
      :or   {export-format :api}
      :as   options}]
  (span/with-span! {:name       "run-query-for-dashcard-async"
                    :attributes {:dashboard/id dashboard-id
                                 :dashcard/id  dashcard-id
                                 :card/id      card-id}}
    ;; make sure we can read this Dashboard. Card will get read-checked later on inside
    ;; [[qp.card/run-query-for-card-async]]
    (api/read-check Dashboard dashboard-id)
    (check-card-and-dashcard-are-in-dashboard dashboard-id card-id dashcard-id)
    (let [resolved-params (resolve-params-for-query dashboard-id card-id dashcard-id parameters)
          options         (merge
                            {:ignore_cache false
                             :constraints  (qp.constraints/default-query-constraints)
                             :context      :dashboard}
                            options
                            {:parameters   resolved-params
                             :dashboard-id dashboard-id})]
      (log/tracef "Running Query for Dashboard %d, Card %d, Dashcard %d with options\n%s"
                  dashboard-id card-id dashcard-id
                  (u/pprint-to-str options))
      ;; we've already validated our parameters, so we don't need the [[qp.card]] namespace to do it again
      (binding [qp.card/*allow-arbitrary-mbql-parameters* true]
        (m/mapply qp.card/run-query-for-card-async card-id export-format options)))))
 

A hierarchy of all QP error types. Ideally all QP exceptions should be ex-data maps with an :type key whose value is one of the types here. If you see an Exception in QP code that doesn't return an :type, add it!

(throw (ex-info (tru "Don''t know how to parse {0} {1}" (class x) x) {:type qp.error-type/invalid-parameter}))

(ns metabase.query-processor.error-type)
(def ^:private hierarchy
  (make-hierarchy))

Is error-type a known QP error type (i.e., one defined with deferror above)?

(defn known-error-type?
  [error-type]
  (isa? hierarchy error-type :error))

Should errors of this type be shown to users of Metabase in embedded Cards or Dashboards? Normally, we return a generic 'Query Failed' error message for embedded queries, so as not to leak information. Some errors (like missing parameter errors), however, should be shown even in these situations.

(defn show-in-embeds?
  [error-type]
  (isa? hierarchy error-type :show-in-embeds?))
(defmacro ^:private deferror
  {:style/indent 1}
  [error-name docstring & {:keys [parent show-in-embeds?]}]
  {:pre [(some? parent)]}
  `(do
     (def ~error-name ~docstring ~(keyword error-name))
     (alter-var-root #'hierarchy derive ~(keyword error-name) ~(keyword parent))
     ~(when show-in-embeds?
        `(alter-var-root #'hierarchy derive ~(keyword error-name) :show-in-embeds?))))

Client Errors

Generic ancestor type for all errors with the query map itself. Equivalent of a HTTP 4xx status code.

(deferror client
  :parent :error)

Is error-type a client error type, the equivalent of an HTTP 4xx status code?

(defn client-error?
  [error-type]
  (isa? hierarchy error-type :client))

The current user does not have required permissions to run the current query.

(deferror missing-required-permissions
  :parent client)

Something related to configuration (e.g. of a sandbox/GTAP) is preventing us from being able to run the query.

(deferror bad-configuration
  :parent client)

Generic ancestor type for errors with the query map itself.

(deferror invalid-query
  :parent client)

The query is parameterized, and a required parameter was not supplied.

(deferror missing-required-parameter
  :parent invalid-query
  :show-in-embeds? true)

The query is parameterized, and a supplied parameter has an invalid value.

(deferror invalid-parameter
  :parent invalid-query
  :show-in-embeds? true)

The query is using a feature that is not supported by the database/driver.

(deferror unsupported-feature
  :parent invalid-query
  :show-in-embeds? true)

Server-Side Errors

Generic ancestor type for all unexpected server-side errors. Equivalent of a HTTP 5xx status code.

(deferror server
  :parent :error)

Error type if query fails to return the first row of results after some timeout.

(deferror timed-out
  :parent server
  :show-in-embeds? true)

QP Errors

Generic ancestor type for all unexpected errors (e.g., uncaught Exceptions) in Query Processor code.

(deferror qp
  :parent server)

Generic ancestor type for all unexpected errors related to bad drivers and uncaught Exceptions in driver code.

(deferror driver
  :parent qp)

Data Warehouse (DB) Errors

Generic ancestor type for all unexpected errors returned or thrown by a data warehouse when running a query.

(deferror db
  :parent server)
 

Dynamic variables, constants, and other things used across the query builder namespaces.

(ns metabase.query-processor.interface)

TODO - Not 100% sure we really need this namespace since it's almost completely empty these days. Seems like the things here could be moved elsewhere

Maximum number of rows the QP should ever return.

This is coming directly from the max rows allowed by Excel for now ... https://support.office.com/en-nz/article/Excel-specifications-and-limits-1672b34d-7043-467e-8e27-269d656771c3

This is actually one less than the number of rows allowed by Excel, since we have a header row. See #13585 for more details.

TODO - I think this could go in the limit namespace

(def absolute-max-results
  1048575)

Should we disable logging for the QP? (e.g., during sync we probably want to turn it off to keep logs less cluttered).

TODO - maybe we should do this more generally with the help of a macro like do-with-suppressed-output from the test utils, perhaps implemented as separate middleware (and using a :middleware option). Or perhaps even make QP log level an option so you could do debug individual queries

TODO - I think we should just remove this entirely, it's not used consistently and it's more trouble than it's worth. Just dial down the log level a bit where we're currently using this

(def ^:dynamic ^Boolean *disable-qp-logging*
  false)
 
(ns metabase.query-processor.middleware.add-default-temporal-unit
  (:require
   [metabase.lib.metadata :as lib.metadata]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.store :as qp.store]))

Add :temporal-unit :default to any temporal :field clauses that don't already have a :temporal-unit. This makes things more consistent because code downstream can rely on the key being present.

(defn add-default-temporal-unit
  [query]
  (mbql.u/replace-in query [:query]
    [:field (_ :guard string?) (_ :guard (every-pred
                                          :base-type
                                          #(isa? (:base-type %) :type/Temporal)
                                          (complement :temporal-unit)))]
    (mbql.u/with-temporal-unit &match :default)
    [:field (id :guard integer?) (_ :guard (complement :temporal-unit))]
    (let [{:keys [base-type effective-type]} (lib.metadata/field (qp.store/metadata-provider) id)]
      (cond-> &match
        (isa? (or effective-type base-type) :type/Temporal) (mbql.u/with-temporal-unit :default)))))
 

Middleware for adding remapping and other dimension related projections. This remaps Fields that have a corresponding Dimension object (which defines a remapping) in two different ways, depending on the :type attribute of the Dimension:

external type Dimensions mean the Field's values will be replaced with corresponding values from a column on a different table, joined via a foreign key. A common use-case would be to replace FK IDs with the name of whatever it references, for example replacing a values of venue.category_id with values of category.name. Actual replacement of values happens on the frontend, so this middleware simply adds the column to be used for replacement (e.g. category.name) to the :fields clause in pre-processing, so the Field will be fetched. Recall that Fields referenced via with :fk-> clauses imply that JOINs will take place, which are automatically handled later in the Query Processor pipeline. Additionally, this middleware will swap out :breakout and :order-by clauses referencing the original Field with ones referencing the remapped Field (for example, so we would sort by category.name instead of category_id).

internal type Dimensions mean the Field's values are replaced by a user-defined map of values, stored in the human_readable_values column of a corresponding FieldValues object. A common use-case for this scenario would be to replace integer enum values with something more descriptive, for example replacing values of an enum can_type -- 0 becomes Toucan, 1 becomes Pelican, and so forth. This is handled exclusively in post-processing by adding extra columns and values to the results.

In both cases, to accomplish values replacement on the frontend, the post-processing part of this middleware adds appropriate :remapped_from and :remapped_to attributes in the result :cols in post-processing. :remapped_from and :remapped_to are the names of the columns, e.g. category_id is :remapped_to name, and name is :remapped_from :category_id.

See also [[metabase.models.params.chain-filter]] for another explanation of remapping.

(ns metabase.query-processor.middleware.add-dimension-projections
  (:require
   [clojure.data :as data]
   [clojure.walk :as walk]
   [medley.core :as m]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.jvm :as lib.metadata.jvm]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.schema.helpers :as helpers]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.store :as qp.store]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]))

Schema for the info we fetch about external type Dimensions that will be used for remappings in this Query. Fetched by the pre-processing portion of the middleware, and passed along to the post-processing portion.

(def ^:private ExternalRemappingDimension
  [:map
   [:id                        ms/PositiveInt]      ; unique ID for the remapping
   [:name                      ms/NonBlankString]   ; display name for the remapping
   [:field-id                  ms/PositiveInt]      ; ID of the Field being remapped
   [:field-name                ms/NonBlankString]   ; Name of the Field being remapped
   [:human-readable-field-id   ms/PositiveInt]      ; ID of the FK Field to remap values to
   [:human-readable-field-name ms/NonBlankString]]) ; Name of the FK Field to remap values to

Pre-processing

(mu/defn ^:private fields->field-id->remapping-dimension :- [:maybe [:map-of ::lib.schema.id/field ExternalRemappingDimension]]
  "Given a sequence of field clauses (from the `:fields` clause), return a map of `:field-id` clause (other clauses
  are ineligable) to a remapping dimension information for any Fields that have an `external` type dimension remapping."
  [fields :- [:maybe [:sequential mbql.s/Field]]]
  (when-let [field-ids (not-empty (set (mbql.u/match fields [:field (id :guard integer?) _] id)))]
    (let [field-metadatas (qp.store/bulk-metadata :metadata/column field-ids)]
      (when-let [remap-field-ids (not-empty (into #{}
                                                  (keep (comp :field-id :lib/external-remap))
                                                  field-metadatas))]
        ;; do a bulk fetch of the remaps.
        (qp.store/bulk-metadata :metadata/column remap-field-ids)
        (into {}
              (comp (filter :lib/external-remap)
                    (keep (fn [field]
                            (let [{remap-id :id, remap-name :name, remap-field-id :field-id} (:lib/external-remap field)
                                  remap-field                                                (lib.metadata.protocols/field
                                                                                              (qp.store/metadata-provider)
                                                                                              remap-field-id)]
                              (when remap-field
                                [(:id field) {:id                        remap-id
                                              :name                      remap-name
                                              :field-id                  (:id field)
                                              :field-name                (:name field)
                                              :human-readable-field-id   remap-field-id
                                              :human-readable-field-name (:name remap-field)}])))))
              field-metadatas)))))
(def ^:private RemapColumnInfo
  [:map
   [:original-field-clause mbql.s/field]
   [:new-field-clause      mbql.s/field]
   [:dimension             ExternalRemappingDimension]])
(mu/defn ^:private remap-column-infos :- [:maybe [:sequential RemapColumnInfo]]
  "Return tuples of `:field-id` clauses, the new remapped column `:fk->` clauses that the Field should be remapped to
  and the Dimension that suggested the remapping, which is used later in this middleware for post-processing. Order is
  important here, because the results are added to the `:fields` column in order. (TODO - why is it important, if they
  get hidden when displayed anyway?)"
  [fields :- [:maybe [:sequential mbql.s/Field]]]
  (when-let [field-id->remapping-dimension (fields->field-id->remapping-dimension fields)]
    ;; Reconstruct how we uniquify names in [[metabase.query-processor.middleware.annotate]]
    ;;
    ;; Not sure this isn't broken. Probably better to have [[metabase.query-processor.util.add-alias-info]] do the name
    ;; deduplication instead.
    (let [name-generator (mbql.u/unique-name-generator)
          unique-name    (fn [field-id]
                           (assert (pos-int? field-id) (str "Invalid Field ID: " (pr-str field-id)))
                           (let [field (lib.metadata/field (qp.store/metadata-provider) field-id)]
                             (name-generator (:name field))))]
      (vec
       (mbql.u/match fields
         ;; don't match Fields that have been joined from another Table
         [:field
          (id :guard (every-pred integer? field-id->remapping-dimension))
          (_ :guard (complement (some-fn :join-alias :source-field)))]
         (let [dimension (field-id->remapping-dimension id)]
           {:original-field-clause &match
            :new-field-clause      [:field
                                    (u/the-id (:human-readable-field-id dimension))
                                    {:source-field            id
                                     ::new-field-dimension-id (u/the-id dimension)}]
            :dimension             (assoc dimension
                                          :field-name                (-> dimension :field-id unique-name)
                                          :human-readable-field-name (-> dimension :human-readable-field-id unique-name))}))))))
(mu/defn ^:private add-fk-remaps-rewrite-existing-fields-add-original-field-dimension-id :- [:maybe [:sequential mbql.s/Field]]
  "Rewrite existing `:fields` in a query. Add `::original-field-dimension-id` to any Field clauses that are
  remapped-from."
  [infos  :- [:maybe [:sequential RemapColumnInfo]]
   fields :- [:maybe [:sequential mbql.s/Field]]]
  (let [field->remapped-col (into {} (map (juxt :original-field-clause :new-field-clause)) infos)]
    (mapv
     (fn [field]
       (let [[_ _ {::keys [new-field-dimension-id]}] (get field->remapped-col field)]
         (cond-> field
           new-field-dimension-id (mbql.u/update-field-options assoc ::original-field-dimension-id new-field-dimension-id))))
     fields)))
(mu/defn ^:private add-fk-remaps-rewrite-existing-fields-add-new-field-dimension-id :- [:maybe [:sequential mbql.s/Field]]
  "Rewrite existing `:fields` in a query. Add `::new-field-dimension-id` to any existing remap-to Fields that *would*
  have been added if they did not already exist."
  [infos  :- [:maybe [:sequential RemapColumnInfo]]
   fields :- [:maybe [:sequential mbql.s/Field]]]
  (let [normalized-clause->new-options (into {}
                                             (map (juxt (fn [{clause :new-field-clause}]
                                                          (mbql.u/remove-namespaced-options clause))
                                                        (fn [{[_ _ options] :new-field-clause}]
                                                          options)))
                                             infos)]
    (mapv (fn [field]
            (let [options (normalized-clause->new-options (mbql.u/remove-namespaced-options field))]
              (cond-> field
                options (mbql.u/update-field-options merge options))))
          fields)))
(mu/defn ^:private add-fk-remaps-rewrite-existing-fields :- [:maybe [:sequential mbql.s/Field]]
  "Rewrite existing `:fields` in a query. Add `::original-field-dimension-id` and ::new-field-dimension-id` where
  appropriate."
  [infos  :- [:maybe [:sequential RemapColumnInfo]]
   fields :- [:maybe [:sequential mbql.s/Field]]]
  (->> fields
       (add-fk-remaps-rewrite-existing-fields-add-original-field-dimension-id infos)
       (add-fk-remaps-rewrite-existing-fields-add-new-field-dimension-id infos)))
(mu/defn ^:private add-fk-remaps-rewrite-order-by :- [:maybe [:sequential mbql.s/OrderBy]]
  "Order by clauses that include an external remapped column should be replace that original column in the order by with
  the newly remapped column. This should order by the text of the remapped column vs. the id of the source column
  before the remapping"
  [field->remapped-col :- [:map-of mbql.s/field mbql.s/field]
   order-by-clauses    :- [:maybe [:sequential mbql.s/OrderBy]]]
  (into []
        (comp (map (fn [[direction field, :as order-by-clause]]
                     (if-let [remapped-col (get field->remapped-col field)]
                       [direction remapped-col]
                       order-by-clause)))
              (distinct))
        order-by-clauses))
(defn- add-fk-remaps-rewrite-breakout
  [field->remapped-col breakout-clause]
  (into []
        (comp (mapcat (fn [field]
                        (if-let [[_ _ {::keys [new-field-dimension-id]} :as remapped-col] (get field->remapped-col field)]
                          [remapped-col (mbql.u/update-field-options field assoc ::original-field-dimension-id new-field-dimension-id)]
                          [field])))
              (distinct))
        breakout-clause))
(def ^:private QueryAndRemaps
  [:map
   [:remaps [:maybe (helpers/distinct [:sequential ExternalRemappingDimension])]]
   [:query  mbql.s/Query]])
(defn- add-fk-remaps-one-level
  [{:keys [fields order-by breakout], {source-query-remaps ::remaps} :source-query, :as query}]
  (let [query (m/dissoc-in query [:source-query ::remaps])]
    ;; fetch remapping column pairs if any exist...
    (if-let [infos (not-empty (remap-column-infos (concat fields breakout)))]
      ;; if they do, update `:fields`, `:order-by` and `:breakout` clauses accordingly and add to the query
      (let [ ;; make a map of field-id-clause -> fk-clause from the tuples
            original->remapped             (into {} (map (juxt :original-field-clause :new-field-clause)) infos)
            existing-fields                (add-fk-remaps-rewrite-existing-fields infos fields)
            ;; don't add any new entries for fields that already exist. Use [[mbql.u/remove-namespaced-options]] here so
            ;; we don't add new entries even if the existing Field has some extra info e.g. extra unknown namespaced
            ;; keys.
            existing-normalized-fields-set (into #{} (map mbql.u/remove-namespaced-options) existing-fields)
            new-fields                     (into
                                            existing-fields
                                            (comp (map :new-field-clause)
                                                  (remove (comp existing-normalized-fields-set mbql.u/remove-namespaced-options)))
                                            infos)
            new-breakout                   (add-fk-remaps-rewrite-breakout original->remapped breakout)
            new-order-by                   (add-fk-remaps-rewrite-order-by original->remapped order-by)
            remaps                         (into [] (comp cat (distinct)) [source-query-remaps (map :dimension infos)])]
        ;; return the Dimensions we are using and the query
        (cond-> query
          (seq fields)   (assoc :fields new-fields)
          (seq order-by) (assoc :order-by new-order-by)
          (seq breakout) (assoc :breakout new-breakout)
          (seq remaps)   (assoc ::remaps remaps)))
      ;; otherwise return query as-is
      (cond-> query
        (seq source-query-remaps) (assoc ::remaps source-query-remaps)))))
(mu/defn ^:private add-fk-remaps :- QueryAndRemaps
  "Add any Fields needed for `:external` remappings to the `:fields` clause of the query, and update `:order-by` and
  `breakout` clauses as needed. Returns a map with `:query` (the updated query) and `:remaps` (a sequence
  of [[:sequential ExternalRemappingDimension]] information maps)."
  [query]
  (let [query (walk/postwalk
               (fn [form]
                 (if (and (map? form)
                          ((some-fn :source-table :source-query) form)
                          (not (:condition form)))
                   (add-fk-remaps-one-level form)
                   form))
               query)]
    {:query (m/dissoc-in query [:query ::remaps]), :remaps (get-in query [:query ::remaps])}))

Pre-processing middleware. For columns that have remappings to other columns (FK remaps), rewrite the query to include the extra column. Add ::external-remaps information about which columns were remapped so [[remap-results]] can do appropriate results transformations in post-processing.

(defn add-remapped-columns
  [{{:keys [disable-remaps?]} :middleware, query-type :type, :as query}]
  (if (or disable-remaps?
          (= query-type :native))
    query
    (let [{:keys [remaps query]} (add-fk-remaps query)]
      (cond-> query
        ;; convert the remappings to plain maps so we don't have to look at record type nonsense everywhere
        (seq remaps) (assoc ::external-remaps (mapv (partial into {}) remaps))))))

Post-processing

(def ^:private InternalDimensionInfo
  [:map
   ;; index of original column
   [:col-index      :int]
   ;; names
   [:from            ms/NonBlankString]
   ;; I'm not convinced this works if there's already a column with the same name in the results.
   [:to              ms/NonBlankString]
   ;; map of original value -> human readable value
   [:value->readable :map]
   ;; Info about the new column we will tack on to end of `:cols`
   [:new-column      :map]])
(def ^:private InternalColumnsInfo
  [:map
   [:internal-only-dims [:maybe [:sequential InternalDimensionInfo]]]
   ;; this is just (map :new-column internal-only-dims)
   [:internal-only-cols [:maybe [:sequential :map]]]])

Metadata

(mu/defn ^:private merge-metadata-for-internally-remapped-column :- [:maybe [:sequential :map]]
  "If one of the internal remapped columns says it's remapped from this column, merge in the `:remapped_to` info."
  [columns                :- [:maybe [:sequential :map]]
   {:keys [col-index to]} :- InternalDimensionInfo]
  (update (vec columns) col-index assoc :remapped_to to))
(mu/defn ^:private merge-metadata-for-internal-remaps :- [:maybe [:sequential :map]]
  [columns                      :- [:maybe [:sequential :map]]
   {:keys [internal-only-dims]} :- [:maybe InternalColumnsInfo]]
  (reduce
   merge-metadata-for-internally-remapped-column
   columns
   internal-only-dims))

Example external dimension:

{:name "Sender ID" :id 1000 :fieldid %messages.senderid :fieldname "SENDERID" :human-readable-field-id %users.name :human-readable-field-name "NAME"}

Example remap-from column (need to add info about column it is :remapped_to):

{:id %messages.sender_id :name "SENDER_ID" :options {::original-field-dimension-id 1000} :display_name "Sender ID"}

Example remap-to column (need to add info about column it is :remapped_from):

{:fkfieldid %messages.sender_id :id %users.name :options {::new-field-dimension-id 1000} :name "NAME" :display_name "Sender ID"}

(mu/defn ^:private merge-metadata-for-externally-remapped-column* :- :map
  [columns
   {{::keys [original-field-dimension-id new-field-dimension-id]} :options
    :as                                          column} :- :map
   {dimension-id      :id
    from-name         :field_name
    from-display-name :name
    to-name           :human-readable-field-name} :- ExternalRemappingDimension]
  (log/trace "Considering column\n"
             (u/pprint-to-str 'cyan (select-keys column [:id :name :fk_field_id :display_name :options]))
             (u/colorize :magenta "\nAdd :remapped_to metadata?")
             "\n=>" '(= dimension-id original-field-dimension-id)
             "\n=>" (list '= dimension-id original-field-dimension-id)
             "\n=>" (if (= dimension-id original-field-dimension-id)
                      (u/colorize :green true)
                      (u/colorize :red false))
             (u/colorize :magenta "\nAdd :remapped_from metadata?")
             "\n=>" '(= dimension-id new-field-dimension-id)
             "\n=>" (list '= dimension-id new-field-dimension-id)
             "\n=>" (if (= dimension-id new-field-dimension-id)
                      (u/colorize :green true)
                      (u/colorize :red false)))
  (u/prog1 (merge
            column
            ;; if this is a column we're remapping FROM, we need to add information about which column we're remapping
            ;; TO
            (when (= dimension-id original-field-dimension-id)
              {:remapped_to (or (some (fn [{{::keys [new-field-dimension-id]} :options, target-name :name}]
                                        (when (= new-field-dimension-id dimension-id)
                                          target-name))
                                      columns)
                                to-name)})
            ;; if this is a column we're remapping TO, we need to add information about which column we're remapping
            ;; FROM
            (when (= dimension-id new-field-dimension-id)
              {:remapped_from (or (some (fn [{{::keys [original-field-dimension-id]} :options, source-name :name}]
                                          (when (= original-field-dimension-id dimension-id)
                                            source-name))
                                        columns)
                                  from-name)
               :display_name  from-display-name}))
    (when (not= column <>)
      (log/tracef "Added metadata:\n%s" (u/pprint-to-str 'green (second (data/diff column <>)))))))
(mu/defn ^:private merge-metadata-for-externally-remapped-column :- [:maybe [:sequential :map]]
  [columns :- [:maybe [:sequential :map]] dimension :- ExternalRemappingDimension]
  (log/tracef "Merging metadata for external dimension\n%s" (u/pprint-to-str 'yellow (into {} dimension)))
  (mapv #(merge-metadata-for-externally-remapped-column* columns % dimension)
        columns))
(mu/defn ^:private merge-metadata-for-external-remaps :- [:maybe [:sequential :map]]
  [columns :- [:maybe [:sequential :map]] remapping-dimensions :- [:maybe [:sequential ExternalRemappingDimension]]]
  (reduce
   merge-metadata-for-externally-remapped-column
   columns
   remapping-dimensions))
(mu/defn ^:private add-remapping-info :- [:maybe [:sequential :map]]
  "Add `:display_name`, `:remapped_to`, and `:remapped_from` keys to columns for the results, needed by the frontend.
  To get this critical information, this uses the `remapping-dimensions` info saved by the pre-processing portion of
  this middleware for external remappings, and the internal-only remapped columns handled by post-processing
  middleware below for internal columns."
  [columns              :- [:maybe [:sequential :map]]
   remapping-dimensions :- [:maybe [:sequential ExternalRemappingDimension]]
   internal-cols-info   :- [:maybe InternalColumnsInfo]]
  (-> columns
      (merge-metadata-for-internal-remaps internal-cols-info)
      (merge-metadata-for-external-remaps remapping-dimensions)))

Transform to add additional cols to results

(defn- create-remapped-col [col-name remapped-from base-type]
  {:description   nil
   :id            nil
   :table_id      nil
   :name          col-name
   :display_name  col-name
   :target        nil
   :remapped_from remapped-from
   :remapped_to   nil
   :base_type     base-type
   :semantic_type nil})

Converts values to a type compatible with the base-type found for col. These values should be directly comparable with the values returned from the database for the given col.

(defn- transform-values-for-col
  [{:keys [base-type], :as _column-metadata} values]
  (let [transform (condp #(isa? %2 %1) base-type
                    :type/Decimal    bigdec
                    :type/Float      double
                    :type/BigInteger bigint
                    :type/Integer    int
                    :type/Text       str
                    identity)]
    (map #(some-> % transform) values)))
(defn- infer-human-readable-values-type
  [values]
  (let [types (keys (group-by (fn [v]
                                (cond
                                  (string? v) :type/Text
                                  (number? v) :type/Number
                                  :else       :type/*))
                              values))]
    (if (= (count types) 1)
      (first types)
      :type/*)))

ColumnMetadata, but :base-type is optional, because we may not have that information if this is this is the initial metadata we get back when running a native query against a DB that doesn't return type metadata for query results (such as MongoDB, since it isn't strongly typed).

(def ^:private ColumnMetadataWithOptionalBaseType
  [:merge
   lib.metadata/ColumnMetadata
   [:map
    [:base-type {:optional true} ::lib.schema.common/base-type]]])
(mu/defn ^:private col->dim-map :- [:maybe InternalDimensionInfo]
  "Given a `:col` map from the results, return a map of information about the `internal` dimension used for remapping
  it."
  [idx :- ::lib.schema.common/int-greater-than-or-equal-to-zero
   {{:keys [values human-readable-values], remap-to :name} :lib/internal-remap
    :as                                                    col} :- ColumnMetadataWithOptionalBaseType]
  (when (seq values)
    (let [remap-from (:name col)]
      {:col-index       idx
       :from            remap-from
       :to              remap-to
       :value->readable (zipmap (transform-values-for-col col values)
                                human-readable-values)
       :new-column      (create-remapped-col remap-to
                                             remap-from
                                             (infer-human-readable-values-type human-readable-values))})))
(mu/defn ^:private make-row-map-fn :- [:maybe fn?]
  "Return a function that will add internally-remapped values to each row in the results. (If there is no remapping to
  be done, this function returns `nil`.)"
  [dims :- [:maybe [:sequential InternalDimensionInfo]]]
  (when (seq dims)
    (let [f (apply juxt (for [{:keys [col-index value->readable]} dims]
                          (fn [row]
                            (value->readable (nth row col-index)))))]
      (fn [row]
        (into (vec row) (f row))))))
(mu/defn ^:private internal-columns-info :- InternalColumnsInfo
  "Info about the internal-only columns we add to the query."
  [cols :- [:maybe [:sequential ColumnMetadataWithOptionalBaseType]]]
  ;; hydrate Dimensions and FieldValues for all of the columns in the results, then make a map of dimension info for
  ;; each one that is `internal` type
  (let [internal-only-dims (keep-indexed col->dim-map cols)]
    {:internal-only-dims internal-only-dims
     ;; Get the entries we're going to add to `:cols` for each of the remapped values we add
     :internal-only-cols (map :new-column internal-only-dims)}))

Add remapping info :remapped_from and :remapped_to to each existing column in the results metadata, and add entries for each newly added column to the end of :cols.

(mu/defn ^:private add-remapped-to-and-from-metadata
  [metadata                                             :- [:map
                                                            [:cols [:maybe [:sequential :map]]]]
   remapping-dimensions                                 :- [:maybe [:sequential ExternalRemappingDimension]]
   {:keys [internal-only-cols], :as internal-cols-info} :- [:maybe InternalColumnsInfo]]
  (update metadata :cols (fn [cols]
                           (-> cols
                               (add-remapping-info remapping-dimensions internal-cols-info)
                               (concat internal-only-cols)))))

Munges results for remapping after the query has been executed. For internal remappings, a new column needs to be added and each row flowing through needs to include the remapped data for the new column. For external remappings the column information needs to be updated with what it's being remapped from and the user specified name for the remapped column.

(mu/defn ^:private remap-results-xform
  [{:keys [internal-only-dims]} :- InternalColumnsInfo rf]
  (if-let [remap-fn (make-row-map-fn internal-only-dims)]
    ((map remap-fn) rf)
    rf))

Post-processing middleware. Handles ::external-remaps added by [[add-remapped-columns-middleware]]; transforms results and adds additional metadata based on these remaps, as well as internal (human-readable values) remaps.

(defn remap-results
  [{::keys [external-remaps], {:keys [disable-remaps?]} :middleware} rff]
  (if disable-remaps?
    rff
    (fn remap-results-rff* [metadata]
      (let [mlv2-cols          (map
                                #(lib.metadata.jvm/instance->metadata % :metadata/column)
                                (:cols metadata))
            internal-cols-info (internal-columns-info mlv2-cols)
            metadata           (add-remapped-to-and-from-metadata metadata external-remaps internal-cols-info)]
        (remap-results-xform internal-cols-info (rff metadata))))))
 

Middlware for adding an implicit :fields and :order-by clauses to certain queries.

(ns metabase.query-processor.middleware.add-implicit-clauses
  (:require
   [clojure.walk :as walk]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.types.isa :as lib.types.isa]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.store :as qp.store]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]))

+----------------------------------------------------------------------------------------------------------------+ | Add Implicit Fields | +----------------------------------------------------------------------------------------------------------------+

Return a sequence of all Fields for table that we'd normally include in the equivalent of a SELECT *.

(defn- table->sorted-fields
  [table-id]
  (->> (lib.metadata/fields (qp.store/metadata-provider) table-id)
       (remove :parent-id)
       (remove #(#{:sensitive :retired} (:visibility-type %)))
       (sort-by (juxt :position (comp u/lower-case-en :name)))))
(mu/defn sorted-implicit-fields-for-table :- mbql.s/Fields
  "For use when adding implicit Field IDs to a query. Return a sequence of field clauses, sorted by the rules listed
  in [[metabase.query-processor.sort]], for all the Fields in a given Table."
  [table-id :- ms/PositiveInt]
  (let [fields (table->sorted-fields table-id)]
    (when (empty? fields)
      (throw (ex-info (tru "No fields found for table {0}." (pr-str (:name (lib.metadata/table (qp.store/metadata-provider) table-id))))
                      {:table-id table-id
                       :type     qp.error-type/invalid-query})))
    (mapv
     (fn [field]
       ;; implicit datetime Fields get bucketing of `:default`. This is so other middleware doesn't try to give it
       ;; default bucketing of `:day`
       [:field (u/the-id field) (when (lib.types.isa/temporal? field)
                                  {:temporal-unit :default})])
     fields)))
(mu/defn ^:private source-metadata->fields :- mbql.s/Fields
  "Get implicit Fields for a query with a `:source-query` that has `source-metadata`."
  [source-metadata :- [:sequential {:min 1} mbql.s/SourceQueryMetadata]]
  (distinct
   (for [{field-name :name, base-type :base_type, field-id :id, [ref-type :as field-ref] :field_ref} source-metadata]
     ;; return field-ref directly if it's a `:field` clause already. It might include important info such as
     ;; `:join-alias` or `:source-field`. Remove binning/temporal bucketing info. The Field should already be getting
     ;; bucketed in the source query; don't need to apply bucketing again in the parent query.
     (or (some-> (mbql.u/match-one field-ref :field)
                 (mbql.u/update-field-options dissoc :binning :temporal-unit))
         ;; otherwise construct a field reference that can be used to refer to this Field.
         ;; Force string id field if expression contains just field. See issue #28451.
         (if (and (not= ref-type :expression)
                  field-id)
           ;; If we have a Field ID, return a `:field` (id) clause
           [:field field-id nil]
           ;; otherwise return a `:field` (name) clause, e.g. for a Field that's the result of an aggregation or
           ;; expression
           [:field field-name {:base-type base-type}])))))

Whether we should add implicit Fields to this query. True if all of the following are true:

  • The query has either a :source-table, or a :source-query with :source-metadata for it
  • The query has no breakouts
  • The query has no aggregations
(mu/defn ^:private should-add-implicit-fields?
  [{:keys        [fields source-table source-query source-metadata]
    breakouts    :breakout
    aggregations :aggregation} :- mbql.s/MBQLQuery]
  ;; if someone is trying to include an explicit `source-query` but isn't specifiying `source-metadata` warn that
  ;; there's nothing we can do to help them
  (when (and source-query
             (empty? source-metadata)
             (qp.store/initialized?))
    ;; by 'caching' this result, this log message will only be shown once for a given QP run.
    (qp.store/cached [::should-add-implicit-fields-warning]
      (log/warn (str (trs "Warning: cannot determine fields for an explicit `source-query` unless you also include `source-metadata`.")
                     \newline
                     (trs "Query: {0}" (u/pprint-to-str source-query))))))
  ;; Determine whether we can add the implicit `:fields`
  (and (or source-table
           (and source-query (seq source-metadata)))
       (every? empty? [aggregations breakouts fields])))

For MBQL queries with no aggregation, add a :fields key containing all Fields in the source Table as well as any expressions definied in the query.

(mu/defn ^:private add-implicit-fields
  [{source-table-id :source-table, :keys [expressions source-metadata], :as inner-query}]
  (if-not (should-add-implicit-fields? inner-query)
    inner-query
    (let [fields      (if source-table-id
                        (sorted-implicit-fields-for-table source-table-id)
                        (source-metadata->fields source-metadata))
          ;; generate a new expression ref clause for each expression defined in the query.
          expressions (for [[expression-name] expressions]
                        ;; TODO - we need to wrap this in `u/qualified-name` because `:expressions` uses
                        ;; keywords as keys. We can remove this call once we fix that.
                        [:expression (u/qualified-name expression-name)])]
      ;; if the Table has no Fields, throw an Exception, because there is no way for us to proceed
      (when-not (seq fields)
        (throw (ex-info (tru "Table ''{0}'' has no Fields associated with it."
                             (:name (lib.metadata/table (qp.store/metadata-provider) source-table-id)))
                        {:type qp.error-type/invalid-query})))
      ;; add the fields & expressions under the `:fields` clause
      (assoc inner-query :fields (vec (concat fields expressions))))))

+----------------------------------------------------------------------------------------------------------------+ | Add Implicit Breakout Order Bys | +----------------------------------------------------------------------------------------------------------------+

(mu/defn ^:private add-implicit-breakout-order-by :- mbql.s/MBQLQuery
  "Fields specified in `breakout` should add an implicit ascending `order-by` subclause *unless* that Field is already
  *explicitly* referenced in `order-by`."
  [{breakouts :breakout, :as inner-query} :- mbql.s/MBQLQuery]
  ;; Add a new [:asc <breakout-field>] clause for each breakout. The cool thing is `add-order-by-clause` will
  ;; automatically ignore new ones that are reference Fields already in the order-by clause
  (reduce mbql.u/add-order-by-clause inner-query (for [breakout breakouts]
                                                   [:asc breakout])))

+----------------------------------------------------------------------------------------------------------------+ | Middleware | +----------------------------------------------------------------------------------------------------------------+

Add implicit clauses such as :fields and :order-by to an 'inner' MBQL query as needed.

(defn add-implicit-mbql-clauses
  [form]
  (walk/postwalk
   (fn [form]
     ;; add implicit clauses to any 'inner query', except for joins themselves (we should still add implicit clauses
     ;; like `:fields` to source queries *inside* joins)
     (if (and (map? form)
              ((some-fn :source-table :source-query) form)
              (not (:condition form)))
       (-> form add-implicit-breakout-order-by add-implicit-fields)
       form))
   form))

Add an implicit fields clause to queries with no :aggregation, breakout, or explicit :fields clauses. Add implicit :order-by clauses for fields specified in a :breakout.

(defn add-implicit-clauses
  [{query-type :type, :as query}]
  (if (= query-type :native)
    query
    (update query :query add-implicit-mbql-clauses)))
 

Middleware that creates corresponding :joins for Tables referred to by :field clauses with :source-field info in the options and adds :join-alias info to those :field clauses.

(ns metabase.query-processor.middleware.add-implicit-joins
  (:refer-clojure :exclude [alias])
  (:require
   [clojure.set :as set]
   [clojure.walk :as walk]
   [medley.core :as m]
   [metabase.driver :as driver]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.middleware.add-implicit-clauses
    :as qp.add-implicit-clauses]
   [metabase.query-processor.store :as qp.store]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu]))

Find fields that come from implicit join in form x, presumably a query. Fields from metadata are not considered. It is expected, that field which would cause implicit join is in the query and not just in it's metadata. Example of query having :source-field fields in :source-metadata and no use of :source-field field in corresponding :source-query would be the one, that uses remappings. See [[metabase.models.params.custom-values-test/with-mbql-card-test]].

(defn- implicitly-joined-fields
  [x]
  (set (mbql.u/match x [:field _ (_ :guard (every-pred :source-field (complement :join-alias)))]
                     (when-not (some #{:source-metadata} &parents)
                       &match))))
(defn- join-alias [dest-table-name source-fk-field-name]
  (str dest-table-name "__via__" source-fk-field-name))
(def ^:private JoinInfo
  [:map
   [:source-table ::lib.schema.id/table]
   [:alias        ::lib.schema.common/non-blank-string]
   [:fields       [:= :none]]
   [:strategy     [:= :left-join]]
   [:condition    mbql.s/=]
   [:fk-field-id  ::lib.schema.id/field]])
(mu/defn ^:private fk-ids->join-infos :- [:maybe [:sequential JoinInfo]]
  "Given `fk-field-ids`, return a sequence of maps containing IDs and and other info needed to generate corresponding
  `joined-field` and `:joins` clauses."
  [fk-field-ids]
  (when (seq fk-field-ids)
    (let [fk-fields        (qp.store/bulk-metadata :metadata/column fk-field-ids)
          target-field-ids (into #{} (keep :fk-target-field-id) fk-fields)
          target-fields    (when (seq target-field-ids)
                             (qp.store/bulk-metadata :metadata/column fk-field-ids))
          target-table-ids (into #{} (keep :table-id) target-fields)]
      ;; this is for cache-warming purposes.
      (when (seq target-table-ids)
        (qp.store/bulk-metadata :metadata/table target-table-ids))
      (for [{fk-name :name, fk-field-id :id, pk-id :fk-target-field-id} fk-fields
            :when                                                       pk-id]
        (let [{source-table :table-id} (lib.metadata.protocols/field (qp.store/metadata-provider) pk-id)
              {table-name :name}       (lib.metadata.protocols/table (qp.store/metadata-provider) source-table)
              alias-for-join           (join-alias table-name fk-name)]
          (-> {:source-table source-table
               :alias        alias-for-join
               :fields       :none
               :strategy     :left-join
               :condition    [:= [:field fk-field-id nil] [:field pk-id {:join-alias alias-for-join}]]
               :fk-field-id  fk-field-id}
              (vary-meta assoc ::needs [:field fk-field-id nil])))))))

Create implicit join maps for a set of field-clauses-with-source-field.

(defn- implicitly-joined-fields->joins
  [field-clauses-with-source-field]
  (distinct
   (let [fk-field-ids (->> field-clauses-with-source-field
                           (map (fn [clause]
                                  (mbql.u/match-one clause
                                    [:field (id :guard integer?) (opts :guard (every-pred :source-field (complement :join-alias)))]
                                    (:source-field opts))))
                           (filter integer?)
                           set
                           not-empty)]
     (fk-ids->join-infos fk-field-ids))))

Set of all joins that are visible in the current level of the query or in a nested source query.

(defn- visible-joins
  [{:keys [source-query joins]}]
  (distinct
   (into joins
         (when source-query
           (visible-joins source-query)))))
(defn- distinct-fields [fields]
  (m/distinct-by
   (fn [field]
     (mbql.u/replace (mbql.u/remove-namespaced-options field)
       [:field id-or-name (opts :guard map?)]
       [:field id-or-name (not-empty (dissoc opts :base-type :effective-type))]))
   fields))
(mu/defn ^:private construct-fk-field-id->join-alias :- [:map-of
                                                         ::lib.schema.id/field
                                                         ::lib.schema.common/non-blank-string]
  [form]
  ;; Build a map of FK Field ID -> alias used for IMPLICIT joins. Only implicit joins have `:fk-field-id`
  (into {}
        (comp (map (fn [{:keys [fk-field-id], join-alias :alias}]
                     (when fk-field-id
                       [fk-field-id join-alias])))
              ;; only keep the first alias for each FK Field ID
              (m/distinct-by first))
        (visible-joins form)))

Add :join-aliases to fields containing :source-field in :source-metadata of query. It is required, that :source-query has already it's joins resolved. It is valid, when no :join-alias could be found. For examaple during remaps, metadata contain fields with :source-field, that are not used further in their :source-query.

(defn- add-implicit-joins-aliases-to-metadata
  [{:keys [source-query] :as query}]
  (let [fk-field-id->join-alias (construct-fk-field-id->join-alias source-query)]
    (update query :source-metadata
            #(mbql.u/replace %
               [:field id-or-name (opts :guard (every-pred :source-field (complement :join-alias)))]
               (let [join-alias (fk-field-id->join-alias (:source-field opts))]
                 (if (some? join-alias)
                   [:field id-or-name (assoc opts :join-alias join-alias)]
                   &match))))))

Add :field :join-alias to :field clauses with :source-field in form. Ignore :source-metadata.

(defn- add-join-alias-to-fields-with-source-field
  [form]
  (let [fk-field-id->join-alias (construct-fk-field-id->join-alias form)]
    (cond-> (mbql.u/replace form
              [:field id-or-name (opts :guard (every-pred :source-field (complement :join-alias)))]
              (if-not (some #{:source-metadata} &parents)
                (let [join-alias (or (fk-field-id->join-alias (:source-field opts))
                                     (throw (ex-info (tru "Cannot find matching FK Table ID for FK Field {0}"
                                                          (format "%s %s"
                                                                  (pr-str (:source-field opts))
                                                                  (let [field (lib.metadata/field
                                                                               (qp.store/metadata-provider)
                                                                               (:source-field opts))]
                                                                    (pr-str (:display-name field)))))
                                                     {:resolving  &match
                                                      :candidates fk-field-id->join-alias
                                                      :form       form})))]
                  [:field id-or-name (assoc opts :join-alias join-alias)])
                &match))
      (sequential? (:fields form)) (update :fields distinct-fields))))

Whether the current query level already has a join with the same alias.

(defn- already-has-join?
  [{:keys [joins source-query]} {join-alias :alias, :as join}]
  (or (some #(= (:alias %) join-alias)
            joins)
      (when source-query
        (recur source-query join))))

Add any fields that are needed for newly-added join conditions to source query :fields if they're not already present.

(defn- add-condition-fields-to-source
  [{{source-query-fields :fields} :source-query, :keys [joins], :as form}]
  (if (empty? source-query-fields)
    form
    (let [needed (set (filter some? (map (comp ::needs meta) joins)))]
      (update-in form [:source-query :fields] (fn [existing-fields]
                                                (distinct-fields (concat existing-fields needed)))))))
(defn- add-referenced-fields-to-source [form reused-joins]
  (let [reused-join-alias? (set (map :alias reused-joins))
        referenced-fields  (set (mbql.u/match (dissoc form :source-query :joins)
                                  [:field _ (_ :guard (fn [{:keys [join-alias]}]
                                                        (reused-join-alias? join-alias)))]
                                  &match))]
    (update-in form [:source-query :fields] (fn [existing-fields]
                                              (distinct-fields
                                               (concat existing-fields referenced-fields))))))
(defn- add-fields-to-source
  [{{source-query-fields :fields, :as source-query} :source-query, :as form} reused-joins]
  (cond
    (not source-query)
    form
    (:native source-query)
    form
    (seq ((some-fn :aggregation :breakout) source-query))
    form
    :else
    (let [form (cond-> form
                 (empty? source-query-fields) (update :source-query qp.add-implicit-clauses/add-implicit-mbql-clauses))]
      (if (empty? (get-in form [:source-query :fields]))
        form
        (-> form
            add-condition-fields-to-source
            (add-referenced-fields-to-source reused-joins))))))

Get a set of join aliases that join has an immediate dependency on.

(defn- join-dependencies
  [join]
  (set
   (mbql.u/match (:condition join)
     [:field _ (opts :guard :join-alias)]
     (let [{:keys [join-alias]} opts]
       (when-not (= join-alias (:alias join))
         join-alias)))))

Sort joins by topological dependency order: joins that are referenced by the :condition of another will be sorted first. If no dependencies exist between joins, preserve the existing order.

(defn- topologically-sort-joins
  [joins]
  (let [ ;; make a map of join alias -> immediate dependencies
        join->immediate-deps (into {}
                                   (map (fn [join]
                                          [(:alias join) (join-dependencies join)]))
                                   joins)
        ;; make a map of join alias -> immediate and transient dependencies
        all-deps             (fn all-deps [join-alias]
                               (let [immediate-deps (set (get join->immediate-deps join-alias))]
                                 (into immediate-deps
                                       (mapcat all-deps)
                                       immediate-deps)))
        join->all-deps       (into {}
                                   (map (fn [[join-alias]]
                                          [join-alias (all-deps join-alias)]))
                                   join->immediate-deps)
        ;; now we can create a function to decide if one join depends on another
        depends-on?          (fn [join-1 join-2]
                               (contains? (join->all-deps (:alias join-1))
                                          (:alias join-2)))]
    (->> ;; add a key to each join to record its original position
         (map-indexed (fn [i join]
                        (assoc join ::original-position i)) joins)
         ;; sort the joins by topological order falling back to preserving original position
         (sort (fn [join-1 join-2]
                 (cond
                   (depends-on? join-1 join-2) 1
                   (depends-on? join-2 join-1) -1
                   :else                       (compare (::original-position join-1)
                                                        (::original-position join-2)))))
         ;; remove the keys we used to record original position
         (mapv (fn [join]
                 (dissoc join ::original-position))))))

Add new :joins for tables referenced by :field forms with a :source-field. Add :join-alias info to those :fields. Add additional :fields to source query if needed to perform the join.

(defn- resolve-implicit-joins-this-level
  [form]
  (let [implicitly-joined-fields (implicitly-joined-fields form)
        new-joins                (implicitly-joined-fields->joins implicitly-joined-fields)
        required-joins           (remove (partial already-has-join? form) new-joins)
        reused-joins             (set/difference (set new-joins) (set required-joins))]
    (cond-> form
      (seq required-joins) (update :joins (fn [existing-joins]
                                            (m/distinct-by
                                             :alias
                                             (concat existing-joins required-joins))))
      true                 add-join-alias-to-fields-with-source-field
      true                 (add-fields-to-source reused-joins)
      (seq required-joins) (update :joins topologically-sort-joins))))
(defn- resolve-implicit-joins [query]
  (let [has-source-query-and-metadata? (every-pred map? :source-query :source-metadata)
        query? (every-pred map? (some-fn :source-query :source-table) #(not (contains? % :condition)))]
    (walk/postwalk
     (fn [form]
       (cond-> form
         ;; `:source-metadata` of `:source-query` in this `form` are on this level. This `:source-query` has already
         ;;   its implicit joins resolved by `postwalk`. The following code updates its metadata too.
         (has-source-query-and-metadata? form)
         add-implicit-joins-aliases-to-metadata
         (query? form)
         resolve-implicit-joins-this-level))
     query)))

+----------------------------------------------------------------------------------------------------------------+ | Middleware | +----------------------------------------------------------------------------------------------------------------+

Fetch and store any Tables other than the source Table referred to by :field clauses with :source-field in an MBQL query, and add a :join-tables key inside the MBQL inner query containing information about the JOINs (or equivalent) that need to be performed for these tables.

This middleware also adds :join-alias info to all :field forms with :source-fields.

(defn add-implicit-joins
  [query]
  (if (mbql.u/match-one (:query query) [:field _ (_ :guard (every-pred :source-field (complement :join-alias)))])
    (do
      (when-not (driver/database-supports? driver/*driver* :foreign-keys (lib.metadata/database (qp.store/metadata-provider)))
        (throw (ex-info (tru "{0} driver does not support foreign keys." driver/*driver*)
                        {:driver driver/*driver*
                         :type   qp.error-type/unsupported-feature})))
      (update query :query resolve-implicit-joins))
    query))
 

Adds :rows_truncated to the query results if the results were truncated because of the query's constraints.

(ns metabase.query-processor.middleware.add-rows-truncated
  (:require
   [metabase.query-processor.interface :as qp.i]
   [metabase.query-processor.middleware.limit :as limit]))
(defn- results-limit
  [{{:keys [max-results max-results-bare-rows]}                                    :constraints
    {aggregations :aggregation, :keys [limit page], ::limit/keys [original-limit]} :query
    :as                                                                            _query}]
  (or (when (and (or (not limit)
                     (= original-limit nil))
                 (not page)
                 (empty? aggregations))
        max-results-bare-rows)
      max-results
      qp.i/absolute-max-results))
(defn- add-rows-truncated-xform [limit rf]
  {:pre [(int? limit) (fn? rf)]}
  (let [row-count (volatile! 0)]
    (fn
      ([]
       (rf))
      ([result]
       (rf (cond-> result
             (and (map? result)
                  (= @row-count limit))
             (assoc-in [:data :rows_truncated] limit))))
      ([result row]
       (vswap! row-count inc)
       (rf result row)))))

Add :rows_truncated to the result if the results were truncated because of the query's constraints. Only affects QP results that are reduced to a map (e.g. the default reducing function; other reducing functions such as streaming to a CSV are unaffected.)

(defn add-rows-truncated
  [query rff]
  (fn add-rows-truncated-rff* [metadata]
    (add-rows-truncated-xform (results-limit query) (rff metadata))))
 
(ns metabase.query-processor.middleware.add-source-metadata
  (:require
   [clojure.walk :as walk]
   [metabase.api.common :as api]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.interface :as qp.i]
   [metabase.query-processor.store :as qp.store]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]))

Whether this source query itself has a nested source query, and will have the exact same fields in the results as its nested source. If this is the case, we can return the source-metadata for the nested source as-is, if it is present.

(defn- has-same-fields-as-nested-source?
  [{nested-source-query    :source-query
    nested-source-metadata :source-metadata
    breakouts              :breakout
    aggregations           :aggregation
    fields                 :fields}]
  (when nested-source-query
    (and (every? empty? [breakouts aggregations])
         (or (empty? fields)
             (and (= (count fields) (count nested-source-metadata))
                  (every? #(mbql.u/match-one % [:field (_ :guard string?) _])
                          fields))))))
(mu/defn ^:private native-source-query->metadata :- [:maybe [:sequential mbql.s/SourceQueryMetadata]]
  "Given a `source-query`, return the source metadata that should be added at the parent level (i.e., at the same
  level where this `source-query` was present.) This metadata is used by other middleware to determine what Fields to
  expect from the source query."
  [{nested-source-metadata :source-metadata, :as source-query} :- mbql.s/SourceQuery]
  ;; If the source query has a nested source with metadata and does not change the fields that come back, return
  ;; metadata as-is
  (if (has-same-fields-as-nested-source? source-query)
    nested-source-metadata
    ;; Otherwise we cannot determine the metadata automatically; usually, this is because the source query itself has
    ;; a native source query
    (do
      (when-not qp.i/*disable-qp-logging*
        (log/warn
         (trs "Cannot infer `:source-metadata` for source query with native source query without source metadata.")
         {:source-query source-query}))
      nil)))
(mu/defn mbql-source-query->metadata :- [:maybe [:sequential mbql.s/SourceQueryMetadata]]
  "Preprocess a `source-query` so we can determine the result columns."
  [source-query :- mbql.s/MBQLQuery]
  (try
    (let [cols (binding [api/*current-user-id* nil]
                 ((requiring-resolve 'metabase.query-processor/query->expected-cols)
                  {:database (:id (lib.metadata/database (qp.store/metadata-provider)))
                   :type     :query
                   ;; don't add remapped columns to the source metadata for the source query, otherwise we're going
                   ;; to end up adding it again when the middleware runs at the top level
                   :query    (assoc-in source-query [:middleware :disable-remaps?] true)}))]
      (for [col cols]
        (select-keys col [:name :id :table_id :display_name :base_type :effective_type :coercion_strategy
                          :semantic_type :unit :fingerprint :settings :source_alias :field_ref :nfc_path :parent_id])))
    (catch Throwable e
      (log/error e (str (trs "Error determining expected columns for query: {0}" (ex-message e))))
      nil)))
(mu/defn ^:private add-source-metadata :- [:map
                                           [:source-metadata
                                            {:optional true}
                                            [:maybe [:sequential mbql.s/SourceQueryMetadata]]]]
  [{{native-source-query? :native, :as source-query} :source-query, :as inner-query} :- :map]
  (let [metadata ((if native-source-query?
                     native-source-query->metadata
                     mbql-source-query->metadata) source-query)]
    (cond-> inner-query
      (seq metadata) (assoc :source-metadata metadata))))

Whether this source metadata is legacy source metadata from < 0.38.0. Legacy source metadata did not include :field_ref or :id, which made it hard to correctly construct queries with. For MBQL queries, we're better off ignoring legacy source metadata and using qp/query->expected-cols to infer the source metadata rather than relying on old stuff that can produce incorrect queries. See #14788 for more information.

(defn- legacy-source-metadata?
  [source-metadata]
  (and (seq source-metadata)
       (every? nil? (map :field_ref source-metadata))))

Should we add :source-metadata about the :source-query in this map? True if all of the following are true:

  • The map (e.g. an 'inner' MBQL query or a Join) has a :source-query

  • The map does not already have :source-metadata, or the :source-metadata is 'legacy' source metadata from versions < 0.38.0

  • The :source-query is an MBQL query, or a native source query with :source-metadata

(defn- should-add-source-metadata?
  [{{native-source-query?              :native
     source-query-has-source-metadata? :source-metadata
     :as                               source-query} :source-query
    :keys                                            [source-metadata]}]
  (and source-query
       (or (not source-metadata)
           (legacy-source-metadata? source-metadata))
       (or (not native-source-query?)
           source-query-has-source-metadata?)))
(defn- maybe-add-source-metadata [x]
  (if (and (map? x) (should-add-source-metadata? x))
    (add-source-metadata x)
    x))
(defn- add-source-metadata-at-all-levels [inner-query]
  (walk/postwalk maybe-add-source-metadata inner-query))

Middleware that attempts to recursively add :source-metadata, if not already present, to any maps with a :source-query.

:source-metadata is information about the columns we can expect to come back from the source query; this is added automatically for source queries added via the card__id source table form, but for explicit source queries that do not specify this information, we can often infer it by looking at the shape of the source query.

(defn add-source-metadata-for-source-queries
  [{query-type :type, :as query}]
  (if-not (= query-type :query)
    query
    (update query :query add-source-metadata-at-all-levels)))
 
(ns metabase.query-processor.middleware.add-timezone-info
  (:require
   [metabase.query-processor.timezone :as qp.timezone]))
(defn- add-timezone-metadata [metadata]
  (merge
   metadata
   {:results_timezone (qp.timezone/results-timezone-id)}
   (when-let [requested-timezone-id (qp.timezone/requested-timezone-id)]
     {:requested_timezone requested-timezone-id})))

Add :results_timezone and :requested_timezone info to query results.

(defn add-timezone-info
  [_query rff]
  (fn add-timezone-info-rff* [metadata]
    (rff (add-timezone-metadata metadata))))
 

Middleware for annotating (adding type information to) the results of a query, under the :cols column.

(ns metabase.query-processor.middleware.annotate
  (:require
   [clojure.set :as set]
   [clojure.string :as str]
   [medley.core :as m]
   [metabase.driver.common :as driver.common]
   [metabase.lib.convert :as lib.convert]
   [metabase.lib.core :as lib]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.calculation :as lib.metadata.calculation]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.mbql.util.match :as mbql.match]
   [metabase.models.humanization :as humanization]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.middleware.escape-join-aliases
    :as escape-join-aliases]
   [metabase.query-processor.reducible :as qp.reducible]
   [metabase.query-processor.store :as qp.store]
   [metabase.query-processor.util :as qp.util]
   [metabase.sync.analyze.fingerprint.fingerprinters :as fingerprinters]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru tru]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]))

Schema for a valid map of column info as found in the :cols key of the results after this namespace has ran.

(def ^:private Col
  ;; name and display name can be blank because some wacko DBMSes like SQL Server return blank column names for
  ;; unaliased aggregations like COUNT(*) (this only applies to native queries, since we determine our own names for
  ;; MBQL.)
  [:map
   [:name         :string]
   [:display_name :string]
   ;; type of the Field. For Native queries we look at the values in the first 100 rows to make an educated guess
   [:base_type    ms/FieldType]
   ;; effective_type, coercion, etc don't go here. probably best to rename base_type to effective type in the return
   ;; from the metadata but that's for another day
   ;; where this column came from in the original query.
   [:source       [:enum :aggregation :fields :breakout :native]]
   ;; a field clause that can be used to refer to this Field if this query is subsequently used as a source query.
   ;; Added by this middleware as one of the last steps.
   [:field_ref {:optional true} mbql.s/Reference]])

Determine the :cols info that should be returned in the query results, which is a sequence of maps containing information about the columns in the results. Dispatches on query type. results is a map with keys :cols and, optionally, :rows, if available.

TODO - I think we should change the signature of this to (column-info query cols rows)

(defmulti column-info
  {:arglists '([query results])}
  (fn [query _]
    (:type query)))
(defmethod column-info :default
  [{query-type :type, :as query} _]
  (throw (ex-info (tru "Unknown query type {0}" (pr-str query-type))
           {:type  qp.error-type/invalid-query
            :query query})))

+----------------------------------------------------------------------------------------------------------------+ | Adding :cols info for native queries | +----------------------------------------------------------------------------------------------------------------+

Double-check that the driver returned the correct number of columns for native query results.

(mu/defn ^:private check-driver-native-columns
  [cols :- [:maybe [:sequential [:map-of :any :any]]] rows]
  (when (seq rows)
    (let [expected-count (count cols)
          actual-count   (count (first rows))]
      (when-not (= expected-count actual-count)
        (throw (ex-info (str (deferred-tru "Query processor error: number of columns returned by driver does not match results.")
                             "\n"
                             (deferred-tru "Expected {0} columns, but first row of resuls has {1} columns."
                               expected-count actual-count))
                 {:expected-columns (map :name cols)
                  :first-row        (first rows)
                  :type             qp.error-type/qp}))))))
(defn- annotate-native-cols [cols]
  (let [unique-name-fn (mbql.u/unique-name-generator)]
    (vec (for [{col-name :name, base-type :base_type, :as driver-col-metadata} cols]
           (let [col-name (name col-name)]
             (merge
              {:display_name (u/qualified-name col-name)
               :source       :native}
              ;; It is perfectly legal for a driver to return a column with a blank name; for example, SQL Server does
              ;; this for aggregations like `count(*)` if no alias is used. However, it is *not* legal to use blank
              ;; names in MBQL `:field` clauses, because `SELECT ` doesn't make any sense. So if we can't return a
              ;; valid `:field`, omit the `:field_ref`.
              (when-not (str/blank? col-name)
                {:field_ref [:field (unique-name-fn col-name) {:base-type base-type}]})
              driver-col-metadata))))))
(defmethod column-info :native
  [_query {:keys [cols rows] :as _results}]
  (check-driver-native-columns cols rows)
  (annotate-native-cols cols))

+----------------------------------------------------------------------------------------------------------------+ | Adding :cols info for MBQL queries | +----------------------------------------------------------------------------------------------------------------+

(mu/defn ^:private join-with-alias :- [:maybe mbql.s/Join]
  [{:keys [joins source-query]} :- :map
   join-alias                   :- ms/NonBlankString]
  (or (some
       (fn [{:keys [alias], :as join}]
         (when (= alias join-alias)
           join))
       joins)
      (when source-query
        (join-with-alias source-query join-alias))))

--------------------------------------------------- Field Info ---------------------------------------------------

Return an appropriate display name for a joined field. For explicitly joined Fields, the qualifier is the join alias; for implicitly joined fields, it is the display name of the foreign key used to create the join.

(defn- display-name-for-joined-field
  [field-display-name {:keys [fk-field-id], join-alias :alias}]
  (let [qualifier (if fk-field-id
                    ;; strip off trailing ` id` from FK display name
                    (str/replace (:display-name (lib.metadata/field (qp.store/metadata-provider) fk-field-id))
                                 #"(?i)\sid$"
                                 "")
                    join-alias)]
    (format "%s → %s" qualifier field-display-name)))

Helper for [[infer-expression-type]]. Returns true if a given clause returns a :type/DateTime type.

(defn- datetime-arithmetics?
  [clause]
  (mbql.match/match-one clause
    #{:datetime-add :datetime-subtract :relative-datetime}
    true
    [:field _ (_ :guard :temporal-unit)]
    true
    :+
    (some (partial mbql.u/is-clause? :interval) (rest clause))
    _ false))
(declare col-info-for-field-clause)

Columns to select from a field to get its type information without getting information that is specific to that column.

(def type-info-columns
  [:base_type :effective_type :coercion_strategy :semantic_type])

Infer base-type/semantic-type information about an expression clause.

(defn infer-expression-type
  [expression]
  (cond
    (string? expression)
    {:base_type :type/Text}
    (number? expression)
    {:base_type :type/Number}
    (mbql.u/is-clause? :field expression)
    (col-info-for-field-clause {} expression)
    (mbql.u/is-clause? :coalesce expression)
    (select-keys (infer-expression-type (second expression)) type-info-columns)
    (mbql.u/is-clause? :length expression)
    {:base_type :type/BigInteger}
    (mbql.u/is-clause? :case expression)
    (let [[_ clauses] expression]
      (some
       (fn [[_ expression]]
         ;; get the first non-nil val
         (when (and (not= expression nil)
                    (or (not (mbql.u/is-clause? :value expression))
                        (let [[_ value] expression]
                          (not= value nil))))
           (select-keys (infer-expression-type expression) type-info-columns)))
       clauses))
    (mbql.u/is-clause? :convert-timezone expression)
    {:converted_timezone (nth expression 2)
     :base_type          :type/DateTime}
    (datetime-arithmetics? expression)
    ;; make sure converted_timezone survived if we do nested datetime operations
    ;; FIXME: this does not preverse converted_timezone for cases nested expressions
    ;; i.e:
    ;; {"expression" {"converted-exp" [:convert-timezone "created-at" "Asia/Ho_Chi_Minh"]
    ;;                "date-add-exp"  [:datetime-add [:expression "converted-exp"] 2 :month]}}
    ;; The converted_timezone metadata added for "converted-exp" will not be brought over
    ;; to ["date-add-exp"].
    ;; maybe this `infer-expression-type` should takes an `inner-query` and look up the
    ;; source expresison as well?
    (merge (select-keys (infer-expression-type (second expression)) [:converted_timezone])
     {:base_type :type/DateTime})
    (mbql.u/is-clause? mbql.s/string-functions expression)
    {:base_type :type/Text}
    (mbql.u/is-clause? mbql.s/numeric-functions expression)
    {:base_type :type/Float}
    :else
    {:base_type :type/*}))
(defn- col-info-for-expression
  [inner-query [_ expression-name :as clause]]
  (merge
   (infer-expression-type (mbql.u/expression-with-name inner-query expression-name))
   {:name            expression-name
    :display_name    expression-name
    ;; provided so the FE can add easily add sorts and the like when someone clicks a column header
    :expression_name expression-name
    :field_ref       clause}))
(mu/defn ^:private col-info-for-field-clause*
  [{:keys [source-metadata source-card-id], :as inner-query} [_ id-or-name opts :as clause] :- mbql.s/field]
  (let [join                      (when (:join-alias opts)
                                    (join-with-alias inner-query (:join-alias opts)))
        join-is-at-current-level? (some #(= (:alias %) (:join-alias opts)) (:joins inner-query))
        ;; record additional information that may have been added by middleware. Sometimes pre-processing middleware
        ;; needs to add extra info to track things that it did (e.g. the
        ;; [[metabase.query-processor.middleware.add-dimension-projections]] pre-processing middleware adds keys to
        ;; track which Fields it adds or needs to remap, and then the post-processing middleware does the actual
        ;; remapping based on that info)
        namespaced-options        (not-empty (into {}
                                                   (filter (fn [[k _v]]
                                                             (and (keyword? k) (namespace k))))
                                                   opts))]
    ;; TODO -- I think we actually need two `:field_ref` columns -- one for referring to the Field at the SAME
    ;; level, and one for referring to the Field from the PARENT level.
    (cond-> {:field_ref (mbql.u/remove-namespaced-options clause)}
      (:base-type opts)
      (assoc :base_type (:base-type opts))
      namespaced-options
      (assoc :options namespaced-options)
      (string? id-or-name)
      (merge (or (some-> (some #(when (= (:name %) id-or-name) %) source-metadata)
                         (dissoc :field_ref))
                 {:name         id-or-name
                  :display_name (humanization/name->human-readable-name id-or-name)}))
      (integer? id-or-name)
      (merge (let [{:keys [parent-id], :as field} (-> (lib.metadata/field (qp.store/metadata-provider) id-or-name)
                                                      (dissoc :database-type))]
               #_{:clj-kondo/ignore [:deprecated-var]}
               (if-not parent-id
                 (qp.store/->legacy-metadata field)
                 (let [parent (col-info-for-field-clause inner-query [:field parent-id nil])]
                   (-> (update field :name #(str (:name parent) \. %))
                       qp.store/->legacy-metadata)))))
      (:binning opts)
      (assoc :binning_info (-> (:binning opts)
                               (set/rename-keys {:strategy :binning-strategy})
                               u/snake-keys))
      (:temporal-unit opts)
      (assoc :unit (:temporal-unit opts))
      (or (:join-alias opts) (:alias join))
      (assoc :source_alias (or (:join-alias opts) (:alias join)))
      join
      (update :display_name display-name-for-joined-field join)
      ;; Join with fk-field-id => IMPLICIT JOIN
      ;; Join w/o fk-field-id  => EXPLICIT JOIN
      (:fk-field-id join)
      (assoc :fk_field_id (:fk-field-id join))
      ;; For IMPLICIT joins, remove `:join-alias` in the resulting Field ref -- it got added there during
      ;; preprocessing by us, and wasn't there originally. Make sure the ref has `:source-field`.
      (:fk-field-id join)
      (update :field_ref mbql.u/update-field-options (fn [opts]
                                                       (-> opts
                                                           (dissoc :join-alias)
                                                           (assoc :source-field (:fk-field-id join)))))
      ;; If source Field (for an IMPLICIT join) is specified in either the field ref or matching join, make sure we
      ;; return it as `fk_field_id`. (Not sure what situations it would actually be present in one but not the other
      ;; -- but it's in the tests :confused:)
      (or (:source-field opts)
          (:fk-field-id join))
      (assoc :fk_field_id (or (:source-field opts)
                              (:fk-field-id join)))
      ;; If the source query is from a saved question, remove the join alias as the caller should not be aware of joins
      ;; happening inside the saved question. The `not join-is-at-current-level?` check is to ensure that we are not
      ;; removing `:join-alias` from fields from the right side of the join.
      (and source-card-id
           (not join-is-at-current-level?))
      (update :field_ref mbql.u/update-field-options dissoc :join-alias))))
(mu/defn ^:private col-info-for-field-clause :- [:map
                                                 [:field_ref mbql.s/Field]]
  "Return results column metadata for a `:field` or `:expression` clause, in the format that gets returned by QP results"
  [inner-query :- :map
   clause      :- mbql.s/Field]
  (mbql.u/match-one clause
    :expression
    (col-info-for-expression inner-query &match)
    :field
    (col-info-for-field-clause* inner-query &match)
    ;; we should never reach this if our patterns are written right so this is more to catch code mistakes than
    ;; something the user should expect to see
    _
    (throw (ex-info (tru "Don''t know how to get information about Field: {0}" &match)
                    {:field &match}))))
(defn- mlv2-query [inner-query]
  (qp.store/cached [:mlv2-query (hash inner-query)]
    (try
      (lib/query
       (qp.store/metadata-provider)
       (lib.convert/->pMBQL (lib.convert/legacy-query-from-inner-query
                             (:id (lib.metadata/database (qp.store/metadata-provider)))
                             (mbql.normalize/normalize-fragment [:query] inner-query))))
      (catch Throwable e
        (throw (ex-info (tru "Error converting query to pMBQL: {0}" (ex-message e))
                        {:inner-query inner-query, :type qp.error-type/qp}
                        e))))))

Return appropriate column metadata for an :aggregation clause.

(mu/defn ^:private col-info-for-aggregation-clause
  ;; `clause` is normally an aggregation clause but this function can call itself recursively; see comments by the
  ;; `match` pattern for field clauses below
  [inner-query :- :map
   clause]
  (let [mlv2-clause (lib.convert/->pMBQL clause)]
    ;; for some mystery reason it seems like the annotate code uses `:long` style display names when something appears
    ;; inside an aggregation clause, e.g.
    ;;
    ;;    Distinct values of Category → Name
    ;;
    ;; but `:default` style names when they appear on their own or in breakouts, e.g.
    ;;
    ;;    Name
    ;;
    ;; why is this the case? Who knows! But that's the old pre-MLv2 behavior. I think we should try to fix it, but it's
    ;; probably going to involve updating a ton of tests that encode the old behavior.
    (binding [lib.metadata.calculation/*display-name-style* :long]
      (-> (lib/metadata (mlv2-query inner-query) -1 mlv2-clause)
          (update-keys u/->snake_case_en)
          (dissoc :lib/type)))))
(mu/defn aggregation-name :- ::lib.schema.common/non-blank-string
  "Return an appropriate aggregation name/alias *used inside a query* for an `:aggregation` subclause (an aggregation
  or expression). Takes an options map as schema won't support passing keypairs directly as a varargs.
  These names are also used directly in queries, e.g. in the equivalent of a SQL `AS` clause."
  [inner-query :- [:and
                   :map
                   [:fn
                    {:error/message "legacy inner-query with :source-table or :source-query"}
                    (some-fn :source-table :source-query)]]
   ag-clause]
  (lib/column-name (mlv2-query inner-query) (lib.convert/->pMBQL ag-clause)))

----------------------------------------- Putting it all together (MBQL) -----------------------------------------

(defn- check-correct-number-of-columns-returned [returned-mbql-columns results]
  (let [expected-count (count returned-mbql-columns)
        actual-count   (count (:cols results))]
    (when (seq (:rows results))
      (when-not (= expected-count actual-count)
        (throw
         (ex-info (str (tru "Query processor error: mismatched number of columns in query and results.")
                       " "
                       (tru "Expected {0} fields, got {1}" expected-count actual-count)
                       "\n"
                       (tru "Expected: {0}" (mapv :name returned-mbql-columns))
                       "\n"
                       (tru "Actual: {0}" (vec (:columns results))))
                  {:expected returned-mbql-columns
                   :actual   (:cols results)}))))))
(mu/defn ^:private cols-for-fields
  [{:keys [fields], :as inner-query} :- :map]
  (for [field fields]
    (assoc (col-info-for-field-clause inner-query field)
           :source :fields)))
(mu/defn ^:private cols-for-ags-and-breakouts
  [{aggregations :aggregation, breakouts :breakout, :as inner-query} :- :map]
  (concat
   (for [breakout breakouts]
     (assoc (col-info-for-field-clause inner-query breakout)
            :source :breakout))
   (for [[i aggregation] (m/indexed aggregations)]
     (assoc (col-info-for-aggregation-clause inner-query aggregation)
            :source            :aggregation
            :field_ref         [:aggregation i]
            :aggregation_index i))))

Return results metadata about the expected columns in an 'inner' MBQL query.

(mu/defn cols-for-mbql-query
  [inner-query :- :map]
  (concat
   (cols-for-ags-and-breakouts inner-query)
   (cols-for-fields inner-query)))
(mu/defn ^:private merge-source-metadata-col :- [:maybe :map]
  [source-metadata-col :- [:maybe :map]
   col                 :- [:maybe :map]]
  (merge
    {} ;; ensure the type is not FieldInstance
    (when-let [field-id (:id source-metadata-col)]
      (-> (lib.metadata/field (qp.store/metadata-provider) field-id)
          (dissoc :database-type)
          #_{:clj-kondo/ignore [:deprecated-var]}
          qp.store/->legacy-metadata))
   source-metadata-col
   col
   ;; pass along the unit from the source query metadata if the top-level metadata has unit `:default`. This way the
   ;; frontend will display the results correctly if bucketing was applied in the nested query, e.g. it will format
   ;; temporal values in results using that unit
   (when (= (:unit col) :default)
     (select-keys source-metadata-col [:unit]))))

Merge information from source-metadata into the returned cols for queries that return the columns of a source query as-is (i.e., the parent query does not have breakouts, aggregations, or an explicit:fields clause -- excluding the one added automatically by add-source-metadata).

(defn- maybe-merge-source-metadata
  [source-metadata cols]
  (if (= (count cols) (count source-metadata))
    (map merge-source-metadata-col source-metadata cols)
    cols))

Merge information about fields from source-metadata into the returned cols.

(defn- flow-field-metadata
  [source-metadata cols dataset?]
  (let [by-key (m/index-by (comp qp.util/field-ref->key :field_ref) source-metadata)]
    (for [{:keys [field_ref source] :as col} cols]
     ;; aggregation fields are not from the source-metadata and their field_ref
     ;; are not unique for a nested query. So do not merge them otherwise the metadata will be messed up.
     ;; TODO: I think the best option here is to introduce a parent_field_ref so that
     ;; we could preserve metadata such as :sematic_type or :unit from the source field.
      (if-let [source-metadata-for-field (and (not= :aggregation source)
                                              (get by-key (qp.util/field-ref->key field_ref)))]
        (merge-source-metadata-col source-metadata-for-field
                                   (merge col
                                          (when dataset?
                                            (select-keys source-metadata-for-field qp.util/preserved-keys))))
        col))))
(declare mbql-cols)
(defn- cols-for-source-query
  [{:keys [source-metadata], {native-source-query :native, :as source-query} :source-query} results]
  (let [columns       (if native-source-query
                        (maybe-merge-source-metadata source-metadata (column-info {:type :native} results))
                        (mbql-cols source-query results))]
    (qp.util/combine-metadata columns source-metadata)))

Return the :cols result metadata for an 'inner' MBQL query based on the fields/breakouts/aggregations in the query.

(defn mbql-cols
  [{:keys [source-metadata source-query :source-query/dataset? fields], :as inner-query}, results]
  (let [cols (cols-for-mbql-query inner-query)]
    (cond
      (and (empty? cols) source-query)
      (cols-for-source-query inner-query results)
      source-query
      (flow-field-metadata (cols-for-source-query inner-query results) cols dataset?)
      (every? #(mbql.u/match-one % [:field (field-name :guard string?) _] field-name) fields)
      (maybe-merge-source-metadata source-metadata cols)
      :else
      cols)))
(defn- restore-cumulative-aggregations
  [{aggregations :aggregation breakouts :breakout :as inner-query} replaced-indices]
  (let [offset   (count breakouts)
        restored (reduce (fn [aggregations index]
                           (mbql.u/replace-in aggregations [(- index offset)]
                             [:count]       [:cum-count]
                             [:count field] [:cum-count field]
                             [:sum field]   [:cum-sum field]))
                         (vec aggregations)
                         replaced-indices)]
    (assoc inner-query :aggregation restored)))
(defmethod column-info :query
  [{inner-query :query,
    replaced-indices :metabase.query-processor.middleware.cumulative-aggregations/replaced-indices}
   results]
  (u/prog1 (mbql-cols (cond-> inner-query
                        replaced-indices (restore-cumulative-aggregations replaced-indices))
                      results)
    (check-correct-number-of-columns-returned <> results)))

+----------------------------------------------------------------------------------------------------------------+ | Deduplicating names | +----------------------------------------------------------------------------------------------------------------+

(def ^:private ColsWithUniqueNames
  [:and
   [:maybe [:sequential Col]]
   [:fn
    {:error/message ":cols with unique names"}
    (fn [cols]
      (u/empty-or-distinct? (map :name cols)))]])
(mu/defn ^:private deduplicate-cols-names :- ColsWithUniqueNames
  [cols :- [:sequential Col]]
  (map (fn [col unique-name]
         (assoc col :name unique-name))
       cols
       (mbql.u/uniquify-names (map :name cols))))

+----------------------------------------------------------------------------------------------------------------+ | add-column-info middleware | +----------------------------------------------------------------------------------------------------------------+

Merge a map from :cols returned by the driver with the column metadata determined by the logic above.

(defn- merge-col-metadata
  [our-col-metadata driver-col-metadata]
  ;; 1. Prefer our `:name` if it's something different that what's returned by the driver
  ;;    (e.g. for named aggregations)
  ;; 2. Prefer our inferred base type if the driver returned `:type/*` and ours is more specific
  ;; 3. Then, prefer any non-nil keys returned by the driver
  ;; 4. Finally, merge in any of our other keys
  (let [non-nil-driver-col-metadata (m/filter-vals some? driver-col-metadata)
        our-base-type               (when (= (:base_type driver-col-metadata) :type/*)
                                      (u/select-non-nil-keys our-col-metadata [:base_type]))
        ;; whatever type comes back from the query is by definition the effective type, fallback to our effective
        ;; type, fallback to the base_type
        effective-type              (when-let [db-base (or (:base_type driver-col-metadata)
                                                           (:effective_type our-col-metadata)
                                                           (:base_type our-col-metadata))]
                                      {:effective_type db-base})
        our-name                    (u/select-non-nil-keys our-col-metadata [:name])]
    (merge our-col-metadata
           non-nil-driver-col-metadata
           our-base-type
           our-name
           effective-type)))

Merge our column metadata (:cols) derived from logic above with the column metadata returned by the driver. We'll prefer the values in theirs to ours. This is important for wacky drivers like GA that use things like native metrics, which we have no information about.

It's the responsibility of the driver to make sure the :cols are returned in the correct number and order.

(defn- merge-cols-returned-by-driver
  [our-cols cols-returned-by-driver]
  (if (seq cols-returned-by-driver)
    (mapv merge-col-metadata our-cols cols-returned-by-driver)
    our-cols))
(mu/defn merged-column-info :- ColsWithUniqueNames
  "Returns deduplicated and merged column metadata (`:cols`) for query results by combining (a) the initial results
  metadata returned by the driver's impl of `execute-reducible-query` and (b) column metadata inferred by logic in
  this namespace."
  [query {cols-returned-by-driver :cols, :as result} :- [:maybe :map]]
  (deduplicate-cols-names
   (merge-cols-returned-by-driver (column-info query result) cols-returned-by-driver)))

Native queries don't have the type information from the original Field objects used in the query. If the driver returned a base type more specific than :type/*, use that; otherwise look at the sample of rows and infer the base type based on the classes of the values

(defn base-type-inferer
  [{:keys [cols]}]
  (apply fingerprinters/col-wise
         (for [{driver-base-type :base_type} cols]
           (if (contains? #{nil :type/*} driver-base-type)
             (driver.common/values->base-type)
             (fingerprinters/constant-fingerprinter driver-base-type)))))
(defn- add-column-info-xform
  [query metadata rf]
  (qp.reducible/combine-additional-reducing-fns
   rf
   [(base-type-inferer metadata)
    ((take 1) conj)]
   (fn combine [result base-types truncated-rows]
     (let [metadata (update metadata :cols
                            (comp annotate-native-cols
                                  (fn [cols]
                                    (map (fn [col base-type]
                                           (-> col
                                               (assoc :base_type base-type)
                                               ;; annotate will add a field ref with type info
                                               (dissoc :field_ref)))
                                         cols
                                         base-types))))]
       (rf (cond-> result
             (map? result)
             (assoc-in [:data :cols]
                       (merged-column-info
                        query
                        (assoc metadata :rows truncated-rows)))))))))

Middleware for adding type information about the columns in the query results (the :cols key).

(defn add-column-info
  [{query-type :type, :as query
    {:keys [:metadata/dataset-metadata :alias/escaped->original]} :info} rff]
  (fn add-column-info-rff* [metadata]
    (if (and (= query-type :query)
             ;; we should have type metadata eiter in the query fields
             ;; or in the result metadata for the following code to work
             (or (->> query :query keys (some #{:aggregation :breakout :fields}))
                 (every? :base_type (:cols metadata))))
      (let [query (cond-> query
                    (seq escaped->original) ;; if we replaced aliases, restore them
                    (escape-join-aliases/restore-aliases escaped->original))]
        (rff (cond-> (assoc metadata :cols (merged-column-info query metadata))
               (seq dataset-metadata)
               (update :cols qp.util/combine-metadata dataset-metadata))))
      ;; rows sampling is only needed for native queries! TODO ­ not sure we really even need to do for native
      ;; queries...
      (let [metadata (cond-> (update metadata :cols annotate-native-cols)
                       ;; annotate-native-cols ensures that column refs are present which we need to match metadata
                       (seq dataset-metadata)
                       (update :cols qp.util/combine-metadata dataset-metadata)
                       ;; but we want those column refs removed since they have type info which we don't know yet
                       :always
                       (update :cols (fn [cols] (map #(dissoc % :field_ref) cols))))]
        (add-column-info-xform query metadata (rff metadata))))))
 

Middleware for automatically bucketing unbucketed :type/Temporal (but not :type/Time) Fields with :day bucketing. Applies to any unbucketed Field in a breakout, or fields in a filter clause being compared against yyyy-MM-dd format datetime strings.

(ns metabase.query-processor.middleware.auto-bucket-datetimes
  (:require
   [clojure.walk :as walk]
   [medley.core :as m]
   [metabase.mbql.predicates :as mbql.preds]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.store :as qp.store]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]))
(def ^:private FieldTypeInfo
  [:map
   [:base-type [:maybe ms/FieldType]]
   [:semantic-type {:optional true} [:maybe ms/FieldSemanticOrRelationType]]])
(def ^:private FieldIDOrName->TypeInfo
  [:map-of
   [:or ms/NonBlankString ms/PositiveInt]
   [:maybe FieldTypeInfo]])

Unfortunately these Fields won't be in the store yet since Field resolution can't happen before we add the implicit :fields clause, which happens after this

TODO - What we could do tho is fetch all the stuff we need for the Store and then save these Fields in the store, which would save a bit of time when we do resolve them

(mu/defn ^:private unbucketed-fields->field-id->type-info :- FieldIDOrName->TypeInfo
  "Fetch a map of Field ID -> type information for the Fields referred to by the `unbucketed-fields`."
  [unbucketed-fields :- [:sequential {:min 1} mbql.s/field]]
  (merge
   ;; build map of field-literal-name -> {:base-type base-type}
   (into {} (for [[_ id-or-name {:keys [base-type]}] unbucketed-fields
                  :when                              (string? id-or-name)]
              [id-or-name {:base-type base-type}]))
   ;; build map of field ID -> <info from DB>
   (when-let [field-ids (not-empty (into #{}
                                         (comp (map second)
                                               (filter integer?))
                                         unbucketed-fields))]
     (into {} (for [{id :id, :as field} (try
                                          (qp.store/bulk-metadata :metadata/column field-ids)
                                          ;; don't fail if some of the Fields are invalid.
                                          (catch Throwable e
                                            (log/errorf e "Error fetching Fields: %s" (ex-message e))
                                            nil))]
                [id (select-keys field [:base-type :effective-type :semantic-type])])))))
(defn- yyyy-MM-dd-date-string? [x]
  (and (string? x)
       (re-matches #"^\d{4}-\d{2}-\d{2}$" x)))
(defn- auto-bucketable-value? [v]
  (or (yyyy-MM-dd-date-string? v)
      (mbql.u/is-clause? :relative-datetime v)))

Is x a clause (or a clause that contains a clause) that we should definitely not autobucket?

(defn- should-not-be-autobucketed?
  [x]
  (or
   ;; do not autobucket Fields in a non-compound filter clause that either:
   (when (and (mbql.preds/Filter? x)
              (not (mbql.u/is-clause? #{:and :or :not} x)))
     (or
      ;; *  is not an equality or comparison filter. e.g. wouldn't make sense to bucket a field and then check if it is
      ;;    `NOT NULL`
      (not (mbql.u/is-clause? #{:= :!= :< :> :<= :>= :between} x))
      ;; *  has arguments that aren't `yyyy-MM-dd` date strings. The only reason we auto-bucket datetime Fields in the
      ;; *  first place is for legacy reasons, if someone is specifying additional info like hour/minute then we
      ;; *  shouldn't assume they want to bucket by day
      (let [[_ _ & vs] x]
        (not (every? auto-bucketable-value? vs)))))
   ;; do not auto-bucket fields inside a `:time-interval` filter: it already supplies its own unit
   ;; do not auto-bucket fields inside a `:datetime-diff` clause: the precise timestamp is needed for the difference
   (mbql.u/is-clause? #{:time-interval :datetime-diff} x)
   ;; do not autobucket Fields that already have a temporal unit, or have a binning strategy
   (and (mbql.u/is-clause? :field x)
        (let [[_ _ opts] x]
          ((some-fn :temporal-unit :binning) opts)))))
(defn- date-or-datetime-field? [{base-type :base-type, effective-type :effective-type}]
  (some (fn [field-type]
          (some #(isa? field-type %)
                [:type/Date :type/DateTime]))
        [base-type effective-type]))

Add :temporal-unit to :fields in breakouts and filters if appropriate; look at corresponing type information in field-id->type-info to see if we should do so.

(mu/defn ^:private wrap-unbucketed-fields
  ;; we only want to wrap clauses in `:breakout` and `:filter` so just make a 3-arg version of this fn that takes the
  ;; name of the clause to rewrite and call that twice
  ([inner-query field-id->type-info :- FieldIDOrName->TypeInfo]
   (-> inner-query
       (wrap-unbucketed-fields field-id->type-info :breakout)
       (wrap-unbucketed-fields field-id->type-info :filter)))
  ([inner-query field-id->type-info clause-to-rewrite]
   (let [datetime-but-not-time? (comp date-or-datetime-field? field-id->type-info)]
     (letfn [(wrap-fields [x]
               (mbql.u/replace x
                 ;; don't replace anything that's already bucketed or otherwise is not subject to autobucketing
                 (_ :guard should-not-be-autobucketed?)
                 &match
                 ;; if it's a `:field` clause and `field-id->type-info` tells us it's a `:type/Temporal` (but not
                 ;; `:type/Time`), then go ahead and replace it
                 [:field (id-or-name :guard datetime-but-not-time?) opts]
                 [:field id-or-name (assoc opts :temporal-unit :day)]))]
       (m/update-existing inner-query clause-to-rewrite wrap-fields)))))
(mu/defn ^:private auto-bucket-datetimes-this-level
  [{breakouts :breakout, filter-clause :filter, :as inner-query}]
  ;; find any breakouts or filters in the query that are just plain `[:field-id ...]` clauses (unwrapped by any other
  ;; clause)
  (if-let [unbucketed-fields (mbql.u/match (cons filter-clause breakouts)
                               (_ :guard should-not-be-autobucketed?) nil
                               :field                                 &match)]
    ;; if we found some unbucketed breakouts/filters, fetch the Fields & type info that are referred to by those
    ;; breakouts/filters...
    (let [field-id->type-info (unbucketed-fields->field-id->type-info unbucketed-fields)]
      ;; ...and then update each breakout/filter by wrapping it if appropriate
      (wrap-unbucketed-fields inner-query field-id->type-info))
    ;; otherwise if there are no unbucketed breakouts/filters return the query as-is
    inner-query))

Middleware that automatically adds :temporal-unit :day to breakout and filter :field clauses if the Field they refer to has a type that derives from :type/Temporal (but not :type/Time). (This is done for historic reasons, before datetime bucketing was added to MBQL; datetime Fields defaulted to breaking out by day. We might want to revisit this behavior in the future.)

Applies to any unbucketed Field in a breakout, or fields in a filter clause being compared against yyyy-MM-dd format datetime strings.

(defn auto-bucket-datetimes
  [{query-type :type, :as query}]
  (if (not= query-type :query)
    query
    ;; walk query, looking for inner-query forms that have a `:filter` key
    (walk/postwalk
     (fn [form]
       (if (and (map? form)
                (or (seq (:filter form))
                    (seq (:breakout form))))
         (auto-bucket-datetimes-this-level form)
         form))
     query)))
 

Middleware that parses filter clause values that come in as strings (e.g. from the API) to the appropriate type. E.g. a String value in a filter clause against a :type/Integer Field should get parsed into an integer.

Note that logic for automatically parsing temporal values lives in the wrap-values-literals middleware for historic reasons. When time permits it should be moved into this middleware since it's really a separate transformation from wrapping the value literals themselves.

(ns metabase.query-processor.middleware.auto-parse-filter-values
  (:require
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]))
(set! *warn-on-reflection* true)
(mu/defn ^:private parse-value-for-base-type
  [v         :- :string
   base-type :- ms/FieldType]
  {:pre [(string? v)]}
  (try
    (condp #(isa? %2 %1) base-type
      :type/BigInteger (bigint v)
      :type/Integer    (Long/parseLong v)
      :type/Decimal    (bigdec v)
      :type/Float      (Double/parseDouble v)
      :type/Boolean    (Boolean/parseBoolean v)
      v)
    (catch Throwable e
      (throw (ex-info (tru "Error filtering against {0} Field: unable to parse String {1} to a {2}"
                           base-type
                           (pr-str v)
                           base-type)
                      {:type qp.error-type/invalid-query}
                      e)))))

Automatically parse String filter clause values to the appropriate type.

(defn auto-parse-filter-values
  [query]
  (mbql.u/replace-in query [:query]
    [:value (v :guard string?) (info :guard (fn [{base-type :base_type}]
                                              (and base-type
                                                   (not (isa? base-type :type/Text)))))]
    [:value (parse-value-for-base-type v (:base_type info)) info]))
 

Middleware that handles :binning strategy in :field clauses. This adds extra info to the :binning options maps that contain the information Query Processors will need in order to perform binning.

(ns metabase.query-processor.middleware.binning
  (:require
   [metabase.lib.binning.util :as lib.binning.util]
   [metabase.lib.card :as lib.card]
   [metabase.lib.equality :as lib.equality]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.store :as qp.store]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu]))
(set! *warn-on-reflection* true)
(def ^:private FieldID->Filters
  [:map-of [:ref ::lib.schema.id/field] [:sequential mbql.s/Filter]])
(mu/defn ^:private filter->field-map :- FieldID->Filters
  "Find any comparison or `:between` filter and return a map of referenced Field ID -> all the clauses the reference
  it."
  [filter-clause :- [:maybe mbql.s/Filter]]
  (reduce
   (partial merge-with concat)
   {}
   (for [subclause (mbql.u/match filter-clause #{:between :< :<= :> :>=})
         field-id  (mbql.u/match subclause [:field (field-id :guard integer?) _] field-id)]
     {field-id [subclause]})))
(mu/defn ^:private extract-bounds :- [:map [:min-value number?] [:max-value number?]]
  "Given query criteria, find a min/max value for the binning strategy using the greatest user specified min value and
  the smallest user specified max value. When a user specified min or max is not found, use the global min/max for the
  given field."
  [field-id          :- [:maybe ::lib.schema.common/positive-int]
   fingerprint       :- [:maybe :map]
   field-id->filters :- FieldID->Filters]
  (let [{global-min :min, global-max :max} (get-in fingerprint [:type :type/Number])
        filter-clauses                     (get field-id->filters field-id)
        ;; [:between <field> <min> <max>] or [:< <field> <x>]
        user-maxes                         (mbql.u/match filter-clauses
                                             [(_ :guard #{:< :<= :between}) & args] (last args))
        user-mins                          (mbql.u/match filter-clauses
                                             [(_ :guard #{:> :>= :between}) _ min-val & _] min-val)
        min-value                          (or (when (seq user-mins)
                                                 (apply max user-mins))
                                               global-min)
        max-value                          (or (when (seq user-maxes)
                                                 (apply min user-maxes))
                                               global-max)]
    (when-not (and min-value max-value)
      (throw (ex-info (tru "Unable to bin Field without a min/max value (missing or incomplete fingerprint)")
               {:type        qp.error-type/invalid-query
                :field-id    field-id
                :fingerprint fingerprint})))
    {:min-value min-value, :max-value max-value}))
(def ^:private PossiblyLegacyColumnMetadata
  [:map
   [:name :string]])
(mu/defn ^:private matching-metadata-from-source-metadata :- ::lib.schema.metadata/column
  [field-name      :- ::lib.schema.common/non-blank-string
   source-metadata :- [:maybe [:sequential PossiblyLegacyColumnMetadata]]]
  (do
    ;; make sure source-metadata exists
    (when-not source-metadata
      (throw (ex-info (tru "Cannot update binned field: query is missing source-metadata")
                      {:field field-name})))
    ;; try to find field in source-metadata with matching name
    (let [mlv2-metadatas (for [col source-metadata]
                           (lib.card/->card-metadata-column (qp.store/metadata-provider) col))]
      (or
       (lib.equality/find-matching-column
        [:field {:lib/uuid (str (random-uuid)), :base-type :type/*} field-name]
        mlv2-metadatas)
       (throw (ex-info (tru "Cannot update binned field: could not find matching source metadata for Field {0}"
                            (pr-str field-name))
                       {:field field-name, :resolved-metadata mlv2-metadatas}))))))
(mu/defn ^:private matching-metadata :- ::lib.schema.metadata/column
  [field-id-or-name :- [:or ::lib.schema.id/field ::lib.schema.common/non-blank-string]
   source-metadata  :- [:maybe [:sequential PossiblyLegacyColumnMetadata]]]
  (if (integer? field-id-or-name)
    ;; for Field IDs, just fetch the Field from the Store
    (lib.metadata/field (qp.store/metadata-provider) field-id-or-name)
    ;; for field literals, we require `source-metadata` from the source query
    (matching-metadata-from-source-metadata field-id-or-name source-metadata)))
(mu/defn ^:private update-binned-field :- mbql.s/field
  "Given a `binning-strategy` clause, resolve the binning strategy (either provided or found if default is specified)
  and calculate the number of bins and bin width for this field. `field-id->filters` contains related criteria that
  could narrow the domain for the field. This info is saved as part of each `binning-strategy` clause."
  [{:keys [source-metadata], :as _inner-query}
   field-id->filters                          :- FieldID->Filters
   [_ id-or-name {:keys [binning], :as opts}] :- mbql.s/field]
  (let [metadata                                   (matching-metadata id-or-name source-metadata)
        {:keys [min-value max-value], :as min-max} (extract-bounds (when (integer? id-or-name) id-or-name)
                                                                   (:fingerprint metadata)
                                                                   field-id->filters)
        [new-strategy resolved-options]            (lib.binning.util/resolve-options (qp.store/metadata-provider)
                                                                                     (:strategy binning)
                                                                                     (get binning (:strategy binning))
                                                                                     metadata
                                                                                     min-value max-value)
        resolved-options                           (merge min-max resolved-options)
        ;; Bail out and use unmodifed version if we can't converge on a nice version.
        new-options (or (lib.binning.util/nicer-breakout new-strategy resolved-options)
                        resolved-options)]
    [:field id-or-name (update opts :binning merge {:strategy new-strategy} new-options)]))

Update :field clauses with :binning strategy options in an inner [MBQL] query.

(defn update-binning-strategy-in-inner-query
  [{filters :filter, :as inner-query}]
  (let [field-id->filters (filter->field-map filters)]
    (mbql.u/replace inner-query
      [:field _ (_ :guard :binning)]
      (try
        (update-binned-field inner-query field-id->filters &match)
        (catch Throwable e
          (throw (ex-info (.getMessage e) {:clause &match} e)))))))

When a binned field is found, it might need to be updated if a relevant query criteria affects the min/max value of the binned field. This middleware looks for that criteria, then updates the related min/max values and calculates the bin-width based on the criteria values (or global min/max information).

(defn update-binning-strategy
  [{query-type :type, :as query}]
  (if (= query-type :native)
    query
    (update query :query update-binning-strategy-in-inner-query)))
 

Middleware that returns cached results for queries when applicable.

If caching is enabled (enable-query-caching is true) cached results will be returned for Cards if possible. There's a global default TTL defined by the setting query-caching-default-ttl, but individual Cards can override this value with custom TTLs with a value for :cache_ttl.

For all other queries, caching is skipped.

The default backend is db, which uses the application database; this value can be changed by setting the env var MB_QP_CACHE_BACKEND. Refer to [[metabase.query-processor.middleware.cache-backend.interface]] for more details about how the cache backends themselves.

(ns metabase.query-processor.middleware.cache
  (:require
   [java-time.api :as t]
   [medley.core :as m]
   [metabase.config :as config]
   [metabase.public-settings :as public-settings]
   [metabase.query-processor.context :as qp.context]
   [metabase.query-processor.middleware.cache-backend.db :as backend.db]
   [metabase.query-processor.middleware.cache-backend.interface :as i]
   [metabase.query-processor.middleware.cache.impl :as impl]
   [metabase.query-processor.util :as qp.util]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log])
  (:import
   (org.eclipse.jetty.io EofException)))
(set! *warn-on-reflection* true)
(comment backend.db/keep-me)

Current serialization format version. Basically

[initial-metadata row-1 row-2 ... row-n final-metadata]

(def ^:private cache-version
  3)

Current cache backend. Dynamically rebindable primary for test purposes.

(def ^:dynamic *backend*
  (i/cache-backend (config/config-kw :mb-qp-cache-backend)))

------------------------------------------------------ Save ------------------------------------------------------

(defn- purge! [backend]
  (try
    (log/tracef "Purging cache entries older than %s" (u/format-seconds (public-settings/query-caching-max-ttl)))
    (i/purge-old-entries! backend (public-settings/query-caching-max-ttl))
    (log/trace "Successfully purged old cache entries.")
    :done
    (catch Throwable e
      (log/error e (trs "Error purging old cache entries: {0}" (ex-message e))))))

Minimum duration it must take a query to complete in order for it to be eligible for caching.

(defn- min-duration-ms
  []
  (* (public-settings/query-caching-min-ttl) 1000))

The in-fn provided by [[impl/do-with-serialization]].

(def ^:private ^:dynamic *in-fn*
  nil)

Add object (e.g. a result row or metadata) to the current cache entry.

(defn- add-object-to-cache!
  [object]
  (when *in-fn*
    (*in-fn* object)))

The result-fn provided by [[impl/do-with-serialization]].

(def ^:private ^:dynamic *result-fn*
  nil)
(defn- serialized-bytes []
  (when *result-fn*
    (*result-fn*)))

Save the final results of a query.

(defn- cache-results!
  [query-hash]
  (log/info (trs "Caching results for next time for query with hash {0}."
                 (pr-str (i/short-hex-hash query-hash))) (u/emoji "💾"))
  (try
    (let [bytez (serialized-bytes)]
      (if-not (instance? (Class/forName "[B") bytez)
        (log/error (trs "Cannot cache results: expected byte array, got {0}" (class bytez)))
        (do
          (log/trace "Got serialized bytes; saving to cache backend")
          (i/save-results! *backend* query-hash bytez)
          (log/debug "Successfully cached results for query.")
          (purge! *backend*))))
    :done
    (catch Throwable e
      (if (= (:type (ex-data e)) ::impl/max-bytes)
        (log/debug e (trs "Not caching results: results are larger than {0} KB" (public-settings/query-caching-max-kb)))
        (log/error e (trs "Error saving query results to cache: {0}" (ex-message e)))))))
(defn- save-results-xform [start-time metadata query-hash rf]
  (let [has-rows? (volatile! false)]
    (add-object-to-cache! (assoc metadata
                                 :cache-version cache-version
                                 :last-ran      (t/zoned-date-time)))
    (fn
      ([] (rf))
      ([result]
       (add-object-to-cache! (if (map? result)
                               (m/dissoc-in result [:data :rows])
                               {}))
       (let [duration-ms (- (System/currentTimeMillis) start-time)
             eligible?   (and @has-rows?
                              (> duration-ms (min-duration-ms)))]
         (log/infof "Query took %s to run; minimum for cache eligibility is %s; %s"
                    (u/format-milliseconds duration-ms)
                    (u/format-milliseconds (min-duration-ms))
                    (if eligible? "eligible" "not eligible"))
         (when eligible?
           (cache-results! query-hash)))
       (rf (cond-> result
             (map? result) (assoc-in [:cache/details :hash] query-hash))))
      ([acc row]
       (add-object-to-cache! row)
       (vreset! has-rows? true)
       (rf acc row)))))

----------------------------------------------------- Fetch ------------------------------------------------------

Reducing function for cached results. Merges the final object in the cached results, the final-metdata map, with the reduced value assuming it is a normal metadata map.

(defn- cached-results-rff
  [rff query-hash]
  (fn [{:keys [last-ran], :as metadata}]
    (let [metadata       (dissoc metadata :last-ran :cache-version)
          rf             (rff metadata)
          final-metadata (volatile! nil)]
      (fn
        ([]
         (rf))
        ([result]
         (let [normal-format? (and (map? (unreduced result))
                                   (seq (get-in (unreduced result) [:data :cols])))
               result*        (-> (if normal-format?
                                    (merge-with merge @final-metadata (unreduced result))
                                    (unreduced result))
                                  (assoc :cache/details {:hash query-hash :cached true :updated_at last-ran}))]
           (rf (cond-> result*
                 (reduced? result) reduced))))
        ([acc row]
         (if (map? row)
           (vreset! final-metadata row)
           (rf acc row)))))))

Reduces cached results if there is a hit. Otherwise, returns ::miss directly.

(defn- maybe-reduce-cached-results
  [ignore-cache? query-hash max-age-seconds rff context]
  (try
    (or (when-not ignore-cache?
          (log/tracef "Looking for cached results for query with hash %s younger than %s\n"
                      (pr-str (i/short-hex-hash query-hash)) (u/format-seconds max-age-seconds))
          (i/with-cached-results *backend* query-hash max-age-seconds [is]
            (when is
              (impl/with-reducible-deserialized-results [[metadata reducible-rows] is]
                (log/tracef "Found cached results. Version: %s" (pr-str (:cache-version metadata)))
                (when (and (= (:cache-version metadata) cache-version)
                           reducible-rows)
                  (log/tracef "Reducing cached rows...")
                  (qp.context/reducef (cached-results-rff rff query-hash) context metadata reducible-rows)
                  (log/tracef "All cached rows reduced")
                  ::ok)))))
        ::miss)
    (catch EofException _
      (log/debug (trs "Request is closed; no one to return cached results to"))
      ::canceled)
    (catch Throwable e
      (log/error e (trs "Error attempting to fetch cached results for query with hash {0}: {1}"
                        (i/short-hex-hash query-hash) (ex-message e)))
      ::miss)))

--------------------------------------------------- Middleware ---------------------------------------------------

(defn- run-query-with-cache
  [qp {:keys [cache-ttl middleware], :as query} rff {:keys [reducef], :as context}]
  ;; Query will already have `info.hash` if it's a userland query. It's not the same hash, because this is calculated
  ;; after normalization, instead of before. This is necessary to make caching work properly with sandboxed users, see
  ;; #14388.
  (let [query-hash (qp.util/query-hash query)
        result     (maybe-reduce-cached-results (:ignore-cached-results? middleware) query-hash cache-ttl rff context)]
    (when (= result ::miss)
      (let [start-time-ms (System/currentTimeMillis)]
        (log/trace "Running query and saving cached results (if eligible)...")
        (let [reducef' (fn [rff context metadata rows]
                         (impl/do-with-serialization
                          (fn [in-fn result-fn]
                            (binding [*in-fn*     in-fn
                                      *result-fn* result-fn]
                              (reducef rff context metadata rows)))))]
          (qp query
              (fn [metadata]
                (save-results-xform start-time-ms metadata query-hash (rff metadata)))
              (assoc context :reducef reducef')))))))
(defn- is-cacheable? {:arglists '([query])} [{:keys [cache-ttl]}]
  (and (public-settings/enable-query-caching)
       cache-ttl))

Middleware for caching results of a query if applicable. In order for a query to be eligible for caching:

  • Caching (the enable-query-caching Setting) must be enabled
  • The query must pass a :cache-ttl value. For Cards, this can be the value of :cache_ttl, otherwise falling back to the value of the query-caching-default-ttl Setting.
  • The query must already be permissions-checked. Since the cache bypasses the normal query processor pipeline, the ad-hoc permissions-checking middleware isn't applied for cached results. (The various /api/card/ endpoints that make use of caching do can-read? checks for the Card before running the query, satisfying this requirement.)
  • The result rows of the query must be less than query-caching-max-kb when serialized (before compression).
(defn maybe-return-cached-results
  [qp]
  (fn maybe-return-cached-results* [query rff context]
    (let [cacheable? (is-cacheable? query)]
      (log/tracef "Query is cacheable? %s" (boolean cacheable?))
      (if cacheable?
        (run-query-with-cache qp query rff context)
        (qp query rff context)))))
 
(ns metabase.query-processor.middleware.cache-backend.db
  (:require
   [java-time.api :as t]
   [metabase.db :as mdb]
   [metabase.db.query :as mdb.query]
   [metabase.models.query-cache :refer [QueryCache]]
   [metabase.query-processor.middleware.cache-backend.interface :as i]
   [metabase.util.date-2 :as u.date]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [toucan2.connection :as t2.connection]
   #_{:clj-kondo/ignore [:discouraged-namespace]}
   [toucan2.core :as t2])
  (:import
   (java.sql Connection PreparedStatement ResultSet Types)))
(set! *warn-on-reflection* true)
(defn- seconds-ago [n]
  (let [[unit n] (if-not (integer? n)
                   [:millisecond (long (* 1000 n))]
                   [:second n])]
    (u.date/add (t/offset-date-time) unit (- n))))
(def ^:private ^{:arglists '([])} cached-results-query-sql
  ;; this is memoized for a given application DB so we can deliver cached results EXTRA FAST and not have to spend an
  ;; extra microsecond compiling the same exact query every time. :shrug:
  ;;
  ;; Since application DB can change at run time (during tests) it's not just a plain delay
  (let [f (memoize (fn [_db-type]
                     (first (mdb.query/compile {:select   [:results]
                                                :from     [:query_cache]
                                                :where    [:and
                                                           [:= :query_hash [:raw "?"]]
                                                           [:>= :updated_at [:raw "?"]]]
                                                :order-by [[:updated_at :desc]]
                                                :limit    [:inline 1]}))))]
    (fn []
      (f (mdb/db-type)))))
(defn- prepare-statement
  ^PreparedStatement [^Connection conn query-hash max-age-seconds]
  (let [stmt (.prepareStatement conn ^String (cached-results-query-sql)
                                ResultSet/TYPE_FORWARD_ONLY
                                ResultSet/CONCUR_READ_ONLY
                                ResultSet/CLOSE_CURSORS_AT_COMMIT)]
    (try
      (doto stmt
        (.setFetchDirection ResultSet/FETCH_FORWARD)
        (.setBytes 1 query-hash)
        (.setObject 2 (seconds-ago max-age-seconds) Types/TIMESTAMP_WITH_TIMEZONE)
        (.setMaxRows 1))
      (catch Throwable e
        (log/error e (trs "Error preparing statement to fetch cached query results"))
        (.close stmt)
        (throw e)))))
(defn- cached-results [query-hash max-age-seconds respond]
  ;; VERY IMPORTANT! Open up a connection (which internally binds [[toucan2.connection/*current-connectable*]] so it
  ;; will get reused elsewhere for the duration of results reduction, otherwise we can potentially end up deadlocking if
  ;; we need to acquire another connection for one reason or another, such as recording QueryExecutions
  (t2/with-connection [conn]
    (with-open [stmt (prepare-statement conn query-hash max-age-seconds)
                rs   (.executeQuery stmt)]
      (assert (= t2.connection/*current-connectable* conn))
      (if-not (.next rs)
        (respond nil)
        (with-open [is (.getBinaryStream rs 1)]
          (respond is))))))

Delete any cache entries that are older than the global max age max-cache-entry-age-seconds (currently 3 months).

(defn- purge-old-cache-entries!
  [max-age-seconds]
  {:pre [(number? max-age-seconds)]}
  (log/tracef "Purging old cache entries.")
  (try
    (t2/delete! (t2/table-name QueryCache)
                :updated_at [:<= (seconds-ago max-age-seconds)])
    (catch Throwable e
      (log/error e (trs "Error purging old cache entries"))))
  nil)

Save the results of query with query-hash, updating an existing QueryCache entry if one already exists, otherwise creating a new entry.

(defn- save-results!
  [^bytes query-hash ^bytes results]
  (log/debug (trs "Caching results for query with hash {0}." (pr-str (i/short-hex-hash query-hash))))
  (try
    (or (pos? (t2/update! QueryCache {:query_hash query-hash}
                          {:updated_at (t/offset-date-time)
                           :results    results}))
        (first (t2/insert-returning-instances! QueryCache
                                               :updated_at (t/offset-date-time)
                                               :query_hash query-hash
                                               :results    results)))
    (catch Throwable e
      (log/error e (trs "Error saving query results to cache."))))
  nil)
(defmethod i/cache-backend :db
  [_]
  (reify i/CacheBackend
    (cached-results [_ query-hash max-age-seconds respond]
      (cached-results query-hash max-age-seconds respond))

    (save-results! [_ query-hash is]
      (save-results! query-hash is)
      nil)

    (purge-old-entries! [_ max-age-seconds]
      (purge-old-cache-entries! max-age-seconds))))
 

Interface used to define different Query Processor cache backends. To add a new backend, implement cache-backend and have it return an object that implements the CacheBackend protocol.

See metabase.query-processor.middleware.cache-backend.db for a complete example of how this is done.

(ns metabase.query-processor.middleware.cache-backend.interface
  (:require
   [buddy.core.codecs :as codecs]
   [potemkin.types :as p.types]))

Protocol that different Metabase cache backends must implement.

query-hash as passed below is a byte-array representing a 256-byte SHA3 hash; encode this as needed for use as a cache entry key. results are passed as a compressed byte array.

The implementation is responsible for purging old cache entries when appropriate.

(p.types/defprotocol+ CacheBackend
  (^{:style/indent 3} cached-results [this ^bytes query-hash max-age-seconds respond]
    "Call `respond` with cached results for the query (as an `InputStream` to the raw bytes) if present and not
  expired; otherwise, call `respond` with `nil.
    (cached-results [_ hash _ respond]
      (with-open [is (...)]
        (respond is)))
  `max-age-seconds` may be floating-point. This method *must* return the result of `respond`.")
  (save-results! [this ^bytes query-hash ^bytes results]
    "Add a cache entry with the `results` of running query with byte array `query-hash`. This should replace any prior
  entries for `query-hash` and update the cache timestamp to the current system time.")
  (purge-old-entries! [this max-age-seconds]
    "Purge all cache entries older than `max-age-seconds`. Will be called periodically when this backend is in use.
  `max-age-seconds` may be floating-point."))

Macro version for consuming cached-results from a backend.

(with-cached-results backend query-hash max-age-seconds [is] ...)

InputStream is will be nil if no cached results were available.

(defmacro with-cached-results
  {:style/indent 4}
  [backend query-hash max-age-seconds [is-binding] & body]
  `(cached-results ~backend ~query-hash ~max-age-seconds (fn [~(vary-meta is-binding assoc :tag 'java.io.InputStream)]
                                                           ~@body)))

Return an instance of a cache backend, which is any object that implements QueryProcessorCacheBackend.

See db.clj for an example Cache Backend.

(defmulti cache-backend
  {:arglists '([backend-name])}
  keyword)

Util fn. Converts a query hash to a short hex string for logging purposes.

(defn short-hex-hash
  [^bytes b]
  (codecs/bytes->hex (byte-array 4 b)))
 
(ns metabase.query-processor.middleware.cache.impl
  (:require
   [flatland.ordered.map :as ordered-map]
   [metabase.public-settings :as public-settings]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [taoensso.nippy :as nippy])
  (:import
   (java.io BufferedInputStream BufferedOutputStream ByteArrayOutputStream DataInputStream DataOutputStream
            EOFException FilterOutputStream InputStream OutputStream)
   (java.util.zip GZIPInputStream GZIPOutputStream)))
(set! *warn-on-reflection* true)
(defn- max-bytes-output-stream ^OutputStream
  [max-bytes ^OutputStream os]
  (let [byte-count  (atom 0)
        check-total (fn [current-total]
                      (when (> current-total max-bytes)
                        (log/info (trs "Results are too large to cache.") (u/emoji "😫"))
                        (throw (ex-info (trs "Results are too large to cache.") {:type ::max-bytes}))))]
    (proxy [FilterOutputStream] [os]
      (write
        ([x]
         (if (int? x)
           (do
             (check-total (swap! byte-count inc))
             (.write os ^int x))
           (do
             (check-total (swap! byte-count + (alength ^bytes x)))
             (.write os ^bytes x))))
        ([^bytes ba ^Integer off ^Integer len]
         (check-total (swap! byte-count + len))
         (.write os ba off len))))))

flatland.ordered.map.OrderedMap gets encoded and decoded incorrectly, for some reason. See #25915

(nippy/extend-freeze flatland.ordered.map.OrderedMap :flatland/ordered-map
                     [x data-output]
                     (nippy/freeze-to-out! data-output (vec x)))
(nippy/extend-thaw :flatland/ordered-map
                   [data-input]
                   (ordered-map/ordered-map-reader-clj (nippy/thaw-from-in! data-input)))
(defn- freeze!
  [^OutputStream os obj]
  (log/tracef "Freezing %s" (pr-str obj))
  (nippy/freeze-to-out! os obj)
  (.flush os))

Create output streams for serializing QP results and invoke f, a function of the form

(f in-fn result-fn)

in-fn is of the form (in-fn object) and should be called once for each object that should be serialized. in-fn will catch any exceptions thrown during serialization; these will be thrown later when invoking result-fn. After the first exception in-fn will no-op for all subsequent calls.

When you have serialized all objects, call result-fn to get the serialized byte array. If an error was encountered during serialization (such as the serialized bytes being longer than max-bytes), result-fn will throw an Exception rather than returning a byte array; be sure to handle this case.

(do-with-serialization (fn [in result] (doseq [obj objects] (in obj)) (result)))

(defn do-with-serialization
  ([f]
   (do-with-serialization f {:max-bytes (* (public-settings/query-caching-max-kb) 1024)}))
  ([f {:keys [max-bytes]}]
   (with-open [bos (ByteArrayOutputStream.)]
     (let [os    (-> (max-bytes-output-stream max-bytes bos)
                     BufferedOutputStream.
                     (GZIPOutputStream. true)
                     DataOutputStream.)
           error (atom nil)]
       (try
         (f (fn in* [obj]
              (when-not @error
                (try
                  (freeze! os obj)
                  (catch Throwable e
                    (log/trace e "Caught error when freezing object")
                    (reset! error e))))
              nil)
            (fn result* []
              (when @error
                (throw @error))
              (log/trace "Getting result byte array")
              (.toByteArray bos)))
         ;; this is done manually instead of `with-open` because it might throw an Exception when we close it if it's
         ;; past the byte limit; that's fine and we can ignore it
         (finally
           (u/ignore-exceptions (.close os))))))))
(defn- thaw!
  [^InputStream is]
  (try
    (nippy/thaw-from-in! is)
    (catch EOFException _e
      ::eof)))
(defn- reducible-rows
  [^InputStream is]
  (reify clojure.lang.IReduceInit
    (reduce [_ rf init]
      (loop [acc init]
        ;; NORMALLY we would be checking whether `acc` is `reduced?` here and stop reading from the database if it was,
        ;; but since we currently store the final metadata at the very end of the database entry as a special pseudo-row
        ;; we actually have to keep reading the whole thing until we get to that last result. Don't worry, the reducing
        ;; functions can just throw out everything we don't need. See
        ;; [[metabase.query-processor.middleware.cache/cache-version]] for a description of our caching format.
        (let [row (thaw! is)]
          (if (= row ::eof)
            acc
            (recur (rf acc row))))))))

Impl for [[with-reducible-deserialized-results]].

(defn do-reducible-deserialized-results
  [^InputStream is f]
  (with-open [is (DataInputStream. (GZIPInputStream. (BufferedInputStream. is)))]
    (let [metadata (thaw! is)]
      (if (= metadata ::eof)
        (f nil)
        (f [metadata (reducible-rows is)])))))

Fetches metadata and reducible rows from an InputStream is and executes body with them bound

(with-reducible-deserialized-results [[metadata reducible-rows] is] ...)

metadata and reducible-rows will be nil if the data fetched from the input stream is invalid, from an older cache version, or otherwise unusable.

(defmacro with-reducible-deserialized-results
  [[metadata-rows-binding is] & body]
  `(do-reducible-deserialized-results ~is (fn [~metadata-rows-binding] ~@body)))
 

Middleware for catching exceptions thrown by the query processor and returning them in a friendlier format.

(ns metabase.query-processor.middleware.catch-exceptions
  (:require
   [metabase.query-processor.context :as qp.context]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.middleware.permissions :as qp.perms]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [schema.utils])
  (:import
   (clojure.lang ExceptionInfo)
   (java.sql SQLException)
   (schema.utils NamedError ValidationError)))
(set! *warn-on-reflection* true)

Format an Exception thrown by the Query Processor into a userland error response map.

(defmulti ^:private format-exception
  {:arglists '([^Throwable e])}
  class)
(defmethod format-exception Throwable
  [^Throwable e]
  {:status     :failed
   :class      (class e)
   :error      (.getMessage e)
   :stacktrace (u/filtered-stacktrace e)})
(defmethod format-exception InterruptedException
  [^InterruptedException _e]
  {:status :interrupted})

Return a nice error message to explain the Schema validation error.

TODO - consider moving this into separate middleware as part of a try-catch setup so queries running in a non-userland context can still have sane Exceptions

(defn- explain-schema-validation-error
  [error]
  (cond
    (instance? NamedError error)
    (let [nested-error (.error ^NamedError error)]
      ;; recurse until we find the innermost nested named error, which is the reason
      ;; we actually failed
      (if (instance? NamedError nested-error)
        (recur nested-error)
        (or (when (map? nested-error)
              (explain-schema-validation-error nested-error))
            (.name ^NamedError error))))
    (map? error)
    (first (for [e     (vals error)
                 :when (or (instance? NamedError e)
                           (instance? ValidationError e))
                 :let  [explanation (explain-schema-validation-error e)]
                 :when explanation]
             explanation))
    ;; When an exception is thrown, a ValidationError comes back like
    ;;    (throws? ("foreign-keys is not supported by this driver." 10))
    ;; Extract the message if applicable
    (instance? ValidationError error)
    (let [explanation (schema.utils/validation-error-explain error)]
      (or (when (list? explanation)
            (let [[reason [msg]] explanation]
              (when (= reason 'throws?)
                msg)))
          explanation))))
(defmethod format-exception ExceptionInfo
  [e]
  (let [{error :error, error-type :type, :as data} (ex-data e)]
    (merge
     ((get-method format-exception Throwable) e)
     (when (= error-type :schema.core/error)
       (merge
        {:error_type qp.error-type/invalid-query}
        (when-let [error-msg (explain-schema-validation-error error)]
          {:error error-msg})))
     (when (qp.error-type/known-error-type? error-type)
       {:error_type error-type})
     ;; TODO - we should probably change this key to `:data` so we're not mixing lisp-case and snake_case keys
     {:ex-data (dissoc data :schema)})))
(defmethod format-exception SQLException
  [^SQLException e]
  (assoc ((get-method format-exception Throwable) e)
         :state (.getSQLState e)))

Exception chain in reverse order, e.g. inner-most cause first.

TODO -- some of this logic duplicates the functionality of clojure.core/Throwable->map, we should consider whether we can use that more extensively and remove some of this logic

(defn- exception-chain
  [e]
  (reverse (u/full-exception-chain e)))

In cases where the top-level Exception doesn't have the best error message, return a better one to use instead. We usually want to show SQLExceptions at the top level since they contain more useful information.

(defn- best-top-level-error
  [maps]
  (some (fn [m]
          (when (isa? (:class m) SQLException)
            (select-keys m [:error])))
        maps))

Convert an Exception to a nicely-formatted Clojure map suitable for returning in userland QP responses.

(defn exception-response
  [^Throwable e]
  (let [[m & more :as maps] (for [e (exception-chain e)]
                              (format-exception e))]
    (merge
     m
     (best-top-level-error maps)
     ;; merge in the first error_type we see
     (when-let [error-type (some :error_type maps)]
       {:error_type error-type})
     (when (seq more)
       {:via (vec more)}))))

Map of about query to add to the exception response.

(defn- query-info
  [{query-type :type, :as query} {:keys [preprocessed native]}]
  (merge
   {:json_query (dissoc query :info :driver)}
   ;; add the fully-preprocessed and native forms to the error message for MBQL queries, since they're extremely
   ;; useful for debugging purposes.
   (when (= (keyword query-type) :query)
     {:preprocessed preprocessed
      :native       (when (qp.perms/current-user-has-adhoc-native-query-perms? query)
                      native)})))
(defn- query-execution-info [query-execution]
  (dissoc query-execution :result_rows :hash :executor_id :dashboard_id :pulse_id :native :start_time_millis))

Format a Throwable into the usual userland error-response format.

(defn- format-exception*
  [query ^Throwable e extra-info]
  (try
    (if-let [query-execution (:query-execution (ex-data e))]
      (merge (query-execution-info query-execution)
             (format-exception* query (.getCause e) extra-info))
      (merge
       {:data {:rows [], :cols []}, :row_count 0}
       (exception-response e)
       (query-info query extra-info)))
    (catch Throwable e
      e)))

Middleware for catching exceptions thrown by the query processor and returning them in a 'normal' format. Forwards exceptions to the result-chan.

(defn catch-exceptions
  [qp]
  (fn [query rff context]
    (let [extra-info (delay
                      {:native       (u/ignore-exceptions
                                      ((resolve 'metabase.query-processor/compile) query))
                       :preprocessed (u/ignore-exceptions
                                      ((resolve 'metabase.query-processor/preprocess) query))})]
      (letfn [(raisef* [e context]
                ;; format the Exception and return it
                (let [formatted-exception (format-exception* query e @extra-info)]
                  (log/error (str (trs "Error processing query: {0}"
                                       (or (:error formatted-exception)
                                           ;; log in server locale, respond in user locale
                                           (trs "Error running query")))
                                  "\n" (u/pprint-to-str formatted-exception)))
                  ;; ensure always a message on the error otherwise FE thinks query was successful.  (#23258, #23281)
                  (qp.context/resultf (update formatted-exception
                                              :error (fnil identity (trs "Error running query")))
                                      context)))]
        (try
          (qp query rff (assoc context :raisef raisef*))
          (catch Throwable e
            (raisef* e context)))))))
 
(ns metabase.query-processor.middleware.check-features
  (:require
   [metabase.driver :as driver]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.store :as qp.store]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]))

Assert that the driver/database supports keyword feature.

(defn assert-driver-supports
  [feature]
  (when-not (driver/database-supports? driver/*driver* feature (lib.metadata/database (qp.store/metadata-provider)))
    (throw (ex-info (tru "{0} is not supported by this driver." (name feature))
                    {:type    qp.error-type/unsupported-feature
                     :feature feature}))))

TODO - definitely a little incomplete. It would be cool if we cool look at the metadata in the schema namespace and auto-generate this logic

(defn- query->required-features [query]
  (into
   #{}
   (mbql.u/match (:query query)
     :stddev
     :standard-deviation-aggregations
     (join :guard (every-pred map? (comp mbql.s/join-strategies :strategy)))
     (let [{:keys [strategy]} join]
       (assert-driver-supports strategy)))))

Middleware that checks that drivers support the :features required to use certain clauses, like :stddev.

(defn check-features
  [{query-type :type, :as query}]
  (if-not (= query-type :query)
    query
    (u/prog1 query
      (doseq [required-feature (query->required-features query)]
        (assert-driver-supports required-feature)))))
 

Middleware that adds default constraints to limit the maximum number of rows returned to queries that specify the :add-default-userland-constraints? :middleware option.

(ns metabase.query-processor.middleware.constraints
  (:require
   [metabase.models.setting :as setting]
   [metabase.util.i18n :refer [deferred-tru]]))

The following "defaults" are not applied to the settings themselves - why not? Because the existing behavior is that, if you manually update the settings, queries are affected WHETHER OR NOT the add-default-userland-constraints middleware was applied.

To achieve this, the QP looks for the following, in order: 1. a non-nil value set by the add-default-userland-constraints middleware below, either: a) the value of the setting (if it's set), b) the "default" value from the constant below, or c) nil if the constraint middleware was not applied 2. a non-nil value for the appropriate setting (for aggregated vs. unaggregated queries) itself, either: a) the value of the setting, or b) nil if the setting is not set 3. the value of absolute-max-results

If we turned the below consts into :defaults on the settings themselves, we would use the default values for all queries, whether or not the middleware was applied.

(def ^:private ^:const default-unaggregated-query-row-limit 2000)
(def ^:private ^:const default-aggregated-query-row-limit 10000)

NOTE: this was changed from a hardcoded var with value of 2000 (now moved to [[default-unaggregated-query-row-limit]]) to a setting in 0.43 the setting, which allows for DB local value, can still be nil, so any places below that used to reference the former constant value have to expect it could return nil instead

(setting/defsetting unaggregated-query-row-limit
  (deferred-tru "Maximum number of rows to return specifically on :rows type queries via the API.")
  :visibility     :authenticated
  :type           :integer
  :database-local :allowed
  :audit          :getter)
(setting/defsetting aggregated-query-row-limit
  (deferred-tru "Maximum number of rows to return for aggregated queries via the API.")
  :visibility     :authenticated
  :type           :integer
  :database-local :allowed
  :audit          :getter)

Given a query, returns the max rows that should be returned as defined by settings. In other words, return (aggregated-query-row-limit) or (unaggregated-query-row-limit) depending on whether the query is aggregated or not.

(defn query->max-rows
  [{{aggregations :aggregation} :query}]
  (if-not aggregations
    (unaggregated-query-row-limit)
    (aggregated-query-row-limit)))

Default map of constraints that we apply on dataset queries executed by the api.

(defn default-query-constraints
  []
  {:max-results           (or (aggregated-query-row-limit) default-aggregated-query-row-limit)
   :max-results-bare-rows (or (unaggregated-query-row-limit) default-unaggregated-query-row-limit)})

Clamps the value of max-results-bare-rows to be less than or equal to the value of max-results.

(defn- ensure-valid-constraints
  [{:keys [max-results max-results-bare-rows], :as constraints}]
  (if (<= max-results-bare-rows max-results)
    constraints
    (assoc constraints :max-results-bare-rows max-results)))
(defn- merge-default-constraints [constraints]
  (merge (default-query-constraints) constraints))

Add default values of :max-results and :max-results-bare-rows to :constraints map m.

(defn- add-default-userland-constraints*
  [{{:keys [add-default-userland-constraints?]} :middleware, :as query}]
  (cond-> query
    add-default-userland-constraints? (update :constraints (comp ensure-valid-constraints merge-default-constraints))))

Middleware that optionally adds default max-results and max-results-bare-rows constraints to queries, meant for use with [[metabase.query-processor/process-query-and-save-with-max-results-constraints!]], which ultimately powers most QP API endpoints.

(defn add-default-userland-constraints
  [qp]
  (fn [query rff context]
    (qp (add-default-userland-constraints* query) rff context)))
 

Middlware for handling cumulative count and cumulative sum aggregations.

(ns metabase.query-processor.middleware.cumulative-aggregations
  (:require
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.util.malli :as mu]))

Pre-processing

Given two sequential collections, return indecies that are different between the two.

(defn- diff-indices
  [coll-1 coll-2]
  (into #{}
        (keep-indexed (fn [i transformed?]
                        (when transformed?
                          i)))
        (map not= coll-1 coll-2)))
(mu/defn ^:private replace-cumulative-ags :- mbql.s/Query
  "Replace `cum-count` and `cum-sum` aggregations in `query` with `count` and `sum` aggregations, respectively."
  [query]
  (mbql.u/replace-in query [:query :aggregation]
    ;; cumulative count doesn't neccesarily have a field-id arg
    [:cum-count]       [:count]
    [:cum-count field] [:count field]
    [:cum-sum field]   [:sum field]))

Pre-processing middleware. Rewrite :cum-count and :cum-sum aggregations as :count and :sum respectively. Add information about the indecies of the replaced aggregations under the ::replaced-indices key.

(defn rewrite-cumulative-aggregations
  [{{breakouts :breakout, aggregations :aggregation} :query, :as query}]
  (if-not (mbql.u/match aggregations #{:cum-count :cum-sum})
    query
    (let [query'            (replace-cumulative-ags query)
          ;; figure out which indexes are being changed in the results. Since breakouts always get included in
          ;; results first we need to offset the indexes to change by the number of breakouts
          replaced-indices (set (for [i (diff-indices (-> query  :query :aggregation)
                                                      (-> query' :query :aggregation))]
                                  (+ (count breakouts) i)))]
      (cond-> query'
        (seq replaced-indices) (assoc ::replaced-indices replaced-indices)))))

Post-processing

Update values in row by adding values from last-row for a set of specified indexes.

(add-values-from-last-row #{0} [100 200] [50 60]) ; -> [150 60]

(defn- add-values-from-last-row
  [[index & more] last-row row]
  (cond
   (not index)
   row
   (not last-row)
   row
   :else
   (recur more last-row (update (vec row) index (partial (fnil + 0 0) (nth last-row index))))))
(defn- cumulative-ags-xform [replaced-indices rf]
  {:pre [(fn? rf)]}
  (let [last-row (volatile! nil)]
    (fn
      ([] (rf))
      ([result] (rf result))
      ([result row]
       (let [row' (add-values-from-last-row replaced-indices @last-row row)]
         (vreset! last-row row')
         (rf result row'))))))

Post-processing middleware. Sum the cumulative count aggregations that were rewritten by [[rewrite-cumulative-aggregations]] in Clojure-land.

(defn sum-cumulative-aggregation-columns
  [{::keys [replaced-indices]} rff]
  (if (seq replaced-indices)
    (fn sum-cumulative-aggregation-columns-rff* [metadata]
      (cumulative-ags-xform replaced-indices (rff metadata)))
    rff))
 
(ns metabase.query-processor.middleware.desugar
  (:require
   [medley.core :as m]
   [metabase.mbql.predicates :as mbql.preds]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.util.malli :as mu]))
(mu/defn desugar :- mbql.s/Query
  "Middleware that uses MBQL lib functions to replace high-level 'syntactic sugar' clauses like `time-interval` and
  `inside` with lower-level clauses like `between`. This is done to minimize the number of MBQL clauses individual
  drivers need to support. Clauses replaced by this middleware are marked `^:sugar` in the MBQL schema."
  [query]
  (m/update-existing query :query (fn [query]
                                    (mbql.u/replace query
                                      (filter-clause :guard mbql.preds/Filter?)
                                      (mbql.u/desugar-filter-clause filter-clause)
                                      (temporal-extract-clause :guard mbql.preds/DatetimeExpression?)
                                      (mbql.u/desugar-temporal-extract temporal-extract-clause)
                                      (expression :guard mbql.preds/FieldOrExpressionDef?)
                                      (mbql.u/desugar-expression expression)))))
 

Wrappers for enterprise-only QP middleware using [[defenterprise]]. Pre-processing and post-processing middleware can use [[defenterprise]] directly, since the top-level function is applied directly each during each QP run, meaning it gets the chance to dispatch correctly every time it is run; 'around' middleware (including 'execution' middleware) needs a helper function that invokes the [[defenterprise]] function during every QP run, rather than just once when all middleware is combined. See [[handle-audit-app-internal-queries]] and [[handle-audit-app-internal-queries-middleware]] for example.

(ns metabase.query-processor.middleware.enterprise
  (:require
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.util.i18n :as i18n]))

Pre-processing middleware

(f query) => query

Pre-processing middleware. Replaces source tables a User was querying against with source queries that (presumably) restrict the rows returned, based on presence of sandboxes.

(defenterprise apply-sandboxing
  metabase-enterprise.sandbox.query-processor.middleware.row-level-restrictions
  [query]
  query)

Pre-processing middleware to apply row limits to MBQL export queries if the user has limited download perms. This does not apply to native queries, which are instead limited by the [[limit-download-result-rows]] post-processing middleware.

(defenterprise apply-download-limit
  metabase-enterprise.advanced-permissions.query-processor.middleware.permissions
  [query]
  query)

Execution middleware

(f qp) => qp

Middleware for queries that generate downloads, which checks that the user has permissions to download the results of the query, and aborts the query or limits the number of results if necessary.

If this query is not run to generate an export (e.g. :export-format is :api) we return user's download permissions in the query metadata so that the frontend can determine whether to show the download option on the UI.

(defenterprise check-download-permissions
  metabase-enterprise.advanced-permissions.query-processor.middleware.permissions
  [qp]
  qp)

Helper middleware wrapper for [[check-download-permissions]] to make sure we do [[defenterprise]] dispatch correctly on each QP run rather than just once when we combine all of the QP middleware.

(defn check-download-permissions-middleware
  [qp]
  (fn [query rff context]
    ((check-download-permissions qp) query rff context)))

Execution middleware. Check column-level permissions if applicable.

(defenterprise maybe-apply-column-level-perms-check
  metabase-enterprise.sandbox.query-processor.middleware.column-level-perms-check
  [qp]
  qp)

Helper middleware wrapper for [[maybe-apply-column-level-perms-check]] to make sure we do [[defenterprise]] dispatch correctly on each QP run rather than just once when we combine all of the QP middleware.

(defn maybe-apply-column-level-perms-check-middleware
  [qp]
  (fn [query rff context]
    ((maybe-apply-column-level-perms-check qp) query rff context)))

Post-processing middleware

(f query rff) => rff

Post-processing middleware to limit the number of rows included in downloads if the user has limited download perms. Mainly useful for native queries, which are not modified by the [[apply-download-limit]] pre-processing middleware.

(defenterprise limit-download-result-rows
  metabase-enterprise.advanced-permissions.query-processor.middleware.permissions
  [_query rff]
  rff)

Post-processing middleware. Merges in column metadata from the original, unsandboxed version of the query.

(defenterprise merge-sandboxing-metadata
  metabase-enterprise.sandbox.query-processor.middleware.row-level-restrictions
  [_query rff]
  rff)

Around middleware

(f qp) => qp

'Around' middleware that handles :internal (Audit App) type queries.

(defenterprise handle-audit-app-internal-queries
  metabase-enterprise.audit-app.query-processor.middleware.handle-audit-queries
  [qp]
  (fn [{query-type :type, :as query} rff context]
    (when (= (keyword query-type) :internal)
      (throw (ex-info (i18n/tru "Audit App queries are not enabled on this instance.")
                      {:type qp.error-type/invalid-query})))
    (qp query rff context)))

Helper middleware wrapper for [[handle-audit-app-internal-queries]] to make sure we do [[defenterprise]] dispatch correctly on each QP run rather than just once when we combine all of the QP middleware.

(defn handle-audit-app-internal-queries-middleware
  [qp]
  (fn [query rff context]
    ((handle-audit-app-internal-queries qp) query rff context)))
 

Deduplicate and escape join aliases. This is done in a series of discrete steps; see the middleware function, [[escape-join-aliases]] for more info.

Enable trace logging in this namespace for easier debugging:

(metabase.test/set-ns-log-level! 'metabase.query-processor.middleware.escape-join-aliases :trace)

(ns metabase.query-processor.middleware.escape-join-aliases
  (:require
   [clojure.set :as set]
   [metabase.driver :as driver]
   [metabase.mbql.util :as mbql.u]
   [metabase.util :as u]
   [metabase.util.log :as log]))

this is done in a series of discrete steps

(defn- escape-alias [driver join-alias]
  (driver/escape-alias driver join-alias))
(defn- driver->escape-fn [driver]
  (comp (mbql.u/unique-name-generator
         ;; some databases treat aliases as case-insensitive so make sure the generated aliases
         ;; are unique regardless of case
         :name-key-fn     u/lower-case-en
         ;; uniqified aliases needs to be escaped again just in case
         :unique-alias-fn (fn [original suffix]
                            (escape-alias driver (str original \_ suffix))))
        (partial escape-alias driver)))

Walk the query and add an ::alias key to every join in the query.

(defn- add-escaped-aliases
  [query escape-fn]
  (mbql.u/replace query
    (join :guard (every-pred map? :condition :alias (complement ::alias)))
    (let [join (assoc join ::alias (escape-fn (:alias join)))]
      ;; now recursively add escaped aliases for `:source-query` etc.
      (add-escaped-aliases join escape-fn))))

Walk the query and add a map of original alias -> escaped alias at all levels that have either a :source-table or :source-query.

(defn- add-original->escaped-alias-maps
  [query]
  (mbql.u/replace query
    (m :guard (every-pred map? (some-fn :source-table :source-query) (complement ::original->escaped)))
    (let [original->escaped (into {} (map (juxt :alias ::alias) (:joins m)))
          m                 (assoc m ::original->escaped original->escaped)]
      ;; now recursively add `::original->escaped` for source query or joins
      (add-original->escaped-alias-maps m))))

Walk the query and merge the ::original->escaped maps from nested levels (i.e., source queries or joins) up into their parent levels. When duplicate original aliases exist, they should shadow each other in this order:

  1. Direct :joins at the current level;

  2. :joins inside the :source-query chain

  3. :joins inside of other joins

e.g. when duplicate aliases exist, a join with alias X from the source query should 'shadow' a join with the alias X inside another join. Important! This includes join conditions! So that means we need to merge in the ::original->escaped map from the parent level into the maps in its :joins as well.

(defn- merge-original->escaped-maps
  [query]
  (mbql.u/replace query
    (m :guard (every-pred map? ::original->escaped))
    ;; first, recursively merge all the stuff in the source levels (`:source-query` and `:joins`)
    (let [m'                                 (merge-original->escaped-maps (dissoc m ::original->escaped))
          ;; once things are recursively merged we can collect all the ones that are visible to this level into a
          ;; sequence of maps. For :source-query:
          source-query-original->escaped-map (get-in m' [:source-query ::original->escaped])
          ;; For :joins:
          joins-original->escaped-maps       (keep ::original->escaped (:joins m'))
          ;; ...and then merge them together into one merged map.
          merged-original->escaped           (reduce (fn [m1 m2]
                                                       (merge m2 m1))
                                                     (::original->escaped m)
                                                     (filter some?
                                                             (cons
                                                              source-query-original->escaped-map
                                                              joins-original->escaped-maps)))]
      ;; now merge in the `merged-original->escaped` map into our immediate joins, so they are available in the
      ;; conditions.
      (cond-> (assoc m' ::original->escaped merged-original->escaped)
        (seq (:joins m')) (update :joins (fn [joins]
                                           (mapv (fn [join]
                                                   (update join ::original->escaped merge merged-original->escaped))
                                                 joins)))))))

Walk the query and add an ::join-alias to all :field clauses.

(defn- add-escaped-join-aliases-to-fields
  [query]
  (mbql.u/replace query
    (m :guard (every-pred map? ::original->escaped))
    (let [original->escaped (::original->escaped m)
          ;; recursively update source levels *first*
          m'                (assoc (add-escaped-join-aliases-to-fields (dissoc m ::original->escaped))
                                   ::original->escaped original->escaped)]
      ;; now update any `:field` clauses that don't have an `::join-alias`
      (mbql.u/replace m'
        [:field id-or-name (field-options :guard (every-pred map? :join-alias (complement ::join-alias)))]
        [:field id-or-name (assoc field-options ::join-alias (get original->escaped (:join-alias field-options)))]))))

Build a map of escaped alias -> original alias for the query (current level and all nested levels). Remove keys where the original alias is identical to the escaped alias; that's not useful information to include in :info.

(defn- merged-escaped->original-with-no-ops-removed
  [query]
  (let [escaped->original-maps (mbql.u/match query
                                 (m :guard (every-pred map? ::original->escaped))
                                 (merge
                                  (set/map-invert (::original->escaped m))
                                  (merged-escaped->original-with-no-ops-removed (dissoc m ::original->escaped))))]
    (not-empty
     (into {}
           (comp cat
                 (remove (fn [[k v]]
                           (= k v))))
           escaped->original-maps))))

Add a map of escaped alias -> original alias under [:info :alias/escaped->original]; this is used by [[restore-aliases]] below.

(defn- add-escaped->original-info
  [query]
  (let [escaped->original (not-empty (merged-escaped->original-with-no-ops-removed query))]
    (cond-> query
      escaped->original (assoc-in [:info :alias/escaped->original] escaped->original))))

'Commit' all the new escaped aliases we determined we should use to the query, and clean up all the keys we added in the process of determining this information.

  • Replace the :join-alias in :field clauses with the ::join-alias and remove ::join-alias.

  • Replace the :alias in join clauses with the ::alias and remove ::alias.

  • Remove the ::original->escaped maps.

You might be asking, why don't we just do this in the first place rather than adding all these extra keys that we eventually remove? For joins, we need to track the original alias for a while to build the ::original->escaped map. For :field clauses, we need to keep track of whether we already escaped it or not , since the mapping between original alias and escaped alias might be different based on the level of query we're at.

(defn- replace-original-aliases-with-escaped-aliases
  [query]
  (mbql.u/replace query
    ;; update inner queries that have `::original->escaped` maps
    (m :guard (every-pred map? ::original->escaped))
    (-> (dissoc m ::original->escaped)
        ;; recursively update source levels and `:field` clauses.
        replace-original-aliases-with-escaped-aliases)
    ;; update joins
    (m :guard (every-pred map? ::alias))
    (-> m
        (assoc :alias (::alias m))
        (dissoc ::alias)
        ;; recursively update source levels and `:field` clauses.
        replace-original-aliases-with-escaped-aliases)
    ;; update `:field` clauses
    [:field id-or-name (options :guard (every-pred map? ::join-alias))]
    [:field id-or-name (-> options
                           (assoc :join-alias (::join-alias options))
                           (dissoc ::join-alias))]))

Pre-processing middleware. Make sure all join aliases are unique, regardless of case (some databases treat table aliases as case-insensitive, even if table names themselves are not); escape all join aliases with [[metabase.driver/escape-alias]]. If aliases are 'uniquified', will include a map at [:info :alias/escaped->original] of the escaped name back to the original, to be restored in post processing.

(defn escape-join-aliases
  [query]
  ;; add logging around the steps to make this easier to debug.
  (log/debugf "Escaping join aliases\n%s" (u/pprint-to-str query))
  (letfn [(add-escaped-aliases* [query]
            (add-escaped-aliases query (driver->escape-fn driver/*driver*)))
          (add-original->escaped-alias-maps* [query]
            (log/tracef "Adding ::alias to joins\n%s" (u/pprint-to-str query))
            (add-original->escaped-alias-maps query))
          (merge-original->escaped-maps* [query]
            (log/tracef "Adding ::original->escaped alias maps\n%s" (u/pprint-to-str query))
            (merge-original->escaped-maps query))
          (add-escaped-join-aliases-to-fields* [query]
            (log/tracef "Adding ::join-alias to :field clauses with :join-alias\n%s" (u/pprint-to-str query))
            (add-escaped-join-aliases-to-fields query))
          (add-escaped->original-info* [query]
            (log/tracef "Adding [:info :alias/escaped->original]\n%s" (u/pprint-to-str query))
            (add-escaped->original-info query))
          (replace-original-aliases-with-escaped-aliases* [query]
            (log/tracef "Replacing original aliases with escaped aliases\n%s" (u/pprint-to-str query))
            (replace-original-aliases-with-escaped-aliases query))]
    (let [result (if-not (:query query)
                   ;; nothing to do if this is a native query rather than MBQL.
                   query
                   (-> query
                       (update :query (fn [inner-query]
                                        (-> inner-query
                                            add-escaped-aliases*
                                            add-original->escaped-alias-maps*
                                            merge-original->escaped-maps*
                                            add-escaped-join-aliases-to-fields*)))
                       add-escaped->original-info*
                       (update :query replace-original-aliases-with-escaped-aliases*)))]
      (log/debugf "=>\n%s" (u/pprint-to-str result))
      result)))

The stuff below is used by the [[metabase.query-processor.middleware.annotate]] middleware when generating results metadata to restore the escaped aliases back to what they were in the original query so things don't break if you try to take stuff like the field refs and manipulate the original query with them.

Rename joins in query by replacing aliases whose keys appear in original->new with their corresponding values.

(defn- rename-join-aliases
  [query original->new]
  (let [original->new      (into {} (remove (fn [[original-alias escaped-alias]] (= original-alias escaped-alias))
                                            original->new))
        aliases-to-replace (set (keys original->new))]
    (if (empty? original->new)
      query
      (do
        (log/tracef "Rewriting join aliases:\n%s" (u/pprint-to-str original->new))
        (letfn [(rename-join-aliases* [query]
                  (mbql.u/replace query
                    [:field id-or-name (opts :guard (comp aliases-to-replace :join-alias))]
                    [:field id-or-name (update opts :join-alias original->new)]
                    (join :guard (every-pred map? :condition (comp aliases-to-replace :alias)))
                    (merge
                     ;; recursively update stuff inside the join
                     (rename-join-aliases* (dissoc join :alias))
                     {:alias (original->new (:alias join))})))]
          (rename-join-aliases* query))))))

Restore aliases in query. If aliases were changed in [[escape-join-aliases]], there is a key in :info of :alias/escaped->original which we can restore the aliases in the query.

(defn restore-aliases
  [query escaped->original]
  (rename-join-aliases query escaped->original))
 

Middleware for expanding :metric and :segment 'macros' in unexpanded MBQL queries.

(:metric forms are expanded into aggregations and sometimes filter clauses, while :segment forms are expanded into filter clauses.)

TODO - this namespace is ancient and written with MBQL '95 in mind, e.g. it is case-sensitive. At some point this ought to be reworked to be case-insensitive and cleaned up.

(ns metabase.query-processor.middleware.expand-macros
  (:require
   [malli.core :as mc]
   [malli.error :as me]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.schema.helpers :as helpers]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.store :as qp.store]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]))

+----------------------------------------------------------------------------------------------------------------+ | SEGMENTS | +----------------------------------------------------------------------------------------------------------------+

(defn- segment-clauses->id->definition [segment-clauses]
  (when-let [segment-ids (not-empty (into #{}
                                          (comp (map second)
                                                (filter integer?))
                                          segment-clauses))]
    (into {}
          (map (juxt :id :definition))
          (qp.store/bulk-metadata :metadata/segment segment-ids))))
(defn- replace-segment-clauses [outer-query segment-id->definition]
  (mbql.u/replace-in outer-query [:query]
    [:segment (segment-id :guard (complement mbql.u/ga-id?))]
    (or (:filter (segment-id->definition segment-id))
        (throw (IllegalArgumentException. (tru "Segment {0} does not exist, or is invalid." segment-id))))))
(mu/defn ^:private expand-segments :- mbql.s/Query
  "Recursively expand segments in the `query`."
  [query :- mbql.s/Query]
  (loop [{inner-query :query :as outer-query} query
         depth 0]
    (if-let [segments (mbql.u/match inner-query [:segment (_ :guard (complement mbql.u/ga-id?))])]
      (let [segment-id->definition (segment-clauses->id->definition segments)
            expanded-query (replace-segment-clauses outer-query segment-id->definition)]
        ;; Following line is in place to avoid infinite recursion caused by mutually recursive
        ;; segment definitions or other unforseen circumstances. Number 41 is arbitrary.
        (if (or (= expanded-query outer-query) (= depth 41))
          (throw (ex-info (tru "Segment expansion failed. Check mutually recursive segment definitions.")
                          {:type qp.error-type/invalid-query
                           :original-query query
                           :expanded-query expanded-query
                           :segment-id->definition segment-id->definition
                           :depth depth}))
          (recur expanded-query (inc depth))))
      outer-query)))

+----------------------------------------------------------------------------------------------------------------+ | METRICS | +----------------------------------------------------------------------------------------------------------------+

Return a sequence of any (non-GA) :metric MBQL clauses in query.

(defn- metrics
  [query]
  ;; metrics won't be in a native query but they could be in source-query or aggregation clause
  (mbql.u/match query [:metric (_ :guard (complement mbql.u/ga-id?))]))
(def ^:private MetricInfo
  [:map
   [:id         ms/PositiveInt]
   [:name       ms/NonBlankString]
   [:definition [:map
                 [:aggregation [:tuple mbql.s/Aggregation]]
                 [:filter {:optional true} [:maybe mbql.s/Filter]]]]])
(defn- metric-info-validation-errors [metric-info]
  (me/humanize (mc/explain MetricInfo metric-info)))
(mu/defn ^:private metric-clauses->id->info :- [:map-of ms/PositiveInt MetricInfo]
  [metric-clauses :- [:sequential mbql.s/metric]]
  (when-let [metric-ids (not-empty (into #{} (map second) metric-clauses))]
    (into {}
          (comp (remove (fn [metric]
                          (when-let [errors (metric-info-validation-errors metric)]
                            (log/warn (trs "Invalid metric: {0} reason: {1}" metric errors))
                            errors)))
                (map (juxt :id #(select-keys % [:id :name :definition]))))
          (qp.store/bulk-metadata :metadata/metric metric-ids))))
(mu/defn ^:private add-metrics-filters-this-level :- mbql.s/MBQLQuery
  [inner-query                :- mbql.s/MBQLQuery
   this-level-metric-id->info :- [:map-of ms/PositiveInt MetricInfo]]
  (let [filters (for [{{filter-clause :filter} :definition} (vals this-level-metric-id->info)
                      :when filter-clause]
                  filter-clause)]
    (reduce mbql.u/add-filter-clause-to-inner-query inner-query filters)))
(mu/defn ^:private metric-info->ag-clause :- mbql.s/Aggregation
  "Return an appropriate aggregation clause from `metric-info`."
  [{{[aggregation] :aggregation} :definition, metric-name :name} :- MetricInfo
   {:keys [use-metric-name-as-display-name?]}                    :- [:map [:use-metric-name-as-display-name? :boolean]]]
  (if-not use-metric-name-as-display-name?
    aggregation
    ;; try to give the resulting aggregation the name of the Metric it came from, unless it already has a display
    ;; name in which case keep that name
    (mbql.u/match-one aggregation
      [:aggregation-options _ (_ :guard :display-name)]
      &match
      [:aggregation-options ag options]
      [:aggregation-options ag (assoc options :display-name metric-name)]
      _
      [:aggregation-options &match {:display-name metric-name}])))
(mu/defn ^:private replace-metrics-aggregations-this-level :- mbql.s/MBQLQuery
  [inner-query                :- mbql.s/MBQLQuery
   this-level-metric-id->info :- [:map-of ms/PositiveInt MetricInfo]]
  (letfn [(metric [metric-id]
            (or (get this-level-metric-id->info metric-id)
                (throw (ex-info (tru "Metric {0} does not exist, or is invalid." metric-id)
                                {:type   :invalid-query
                                 :metric metric-id
                                 :query  inner-query}))))]
    (mbql.u/replace-in inner-query [:aggregation]
      ;; if metric is wrapped in aggregation options that give it a display name, expand the metric but do not name it
      [:aggregation-options [:metric (metric-id :guard (complement mbql.u/ga-id?))] (options :guard :display-name)]
      [:aggregation-options
       (metric-info->ag-clause (metric metric-id) {:use-metric-name-as-display-name? false})
       options]
      ;; if metric is wrapped in aggregation options that *do not* give it a display name, expand the metric and then
      ;; merge the options
      [:aggregation-options [:metric (metric-id :guard (complement mbql.u/ga-id?))] options]
      (let [[_ ag ag-options] (metric-info->ag-clause (metric metric-id) {:use-metric-name-as-display-name? true})]
        [:aggregation-options ag (merge ag-options options)])
      ;; otherwise for unwrapped metrics expand them in-place
      [:metric (metric-id :guard (complement mbql.u/ga-id?))]
      (metric-info->ag-clause (metric metric-id) {:use-metric-name-as-display-name? true}))))
(mu/defn ^:private metric-ids-this-level :- [:maybe [:set ms/PositiveInt]]
  [inner-query]
  (when (map? inner-query)
    (when-let [aggregations (:aggregation inner-query)]
      (not-empty
       (set
        (mbql.u/match aggregations
          [:metric (metric-id :guard (complement mbql.u/ga-id?))]
          metric-id))))))
(mu/defn ^:private expand-metrics-clauses-this-level :- [:and
                                                         mbql.s/MBQLQuery
                                                         [:fn
                                                          {:error/message "Inner MBQL query with no :metric clauses at this level"}
                                                          (complement metric-ids-this-level)]]
  [inner-query     :- mbql.s/MBQLQuery
   metric-id->info :- [:map-of ms/PositiveInt MetricInfo]]
  (let [this-level-metric-ids      (metric-ids-this-level inner-query)
        this-level-metric-id->info (select-keys metric-id->info this-level-metric-ids)]
    (-> inner-query
        (add-metrics-filters-this-level this-level-metric-id->info)
        (replace-metrics-aggregations-this-level this-level-metric-id->info))))
(mu/defn ^:private expand-metrics-clauses :- ms/Map
  "Add appropriate `filter` and `aggregation` clauses for a sequence of Metrics.
    (expand-metrics-clauses {:query {}} [[:metric 10]])
    ;; -> {:query {:aggregation [[:count]], :filter [:= [:field-id 10] 20]}}"
  [query :- ms/Map metric-id->info :- (helpers/non-empty [:map-of ms/PositiveInt MetricInfo])]
  (mbql.u/replace query
    (m :guard metric-ids-this-level)
    (-> m
        ;; expand this this level...
        (expand-metrics-clauses-this-level metric-id->info)
        ;; then recursively expand things at any other levels.
        (expand-metrics-clauses metric-id->info))))
(mu/defn ^:private expand-metrics :- mbql.s/Query
  [query :- mbql.s/Query]
  (if-let [metrics (metrics query)]
    (expand-metrics-clauses query (metric-clauses->id->info metrics))
    query))

+----------------------------------------------------------------------------------------------------------------+ | MIDDLEWARE | +----------------------------------------------------------------------------------------------------------------+

(mu/defn ^:private expand-metrics-and-segments  :- mbql.s/Query
  "Expand the macros (`segment`, `metric`) in a `query`."
  [query  :- mbql.s/Query]
  (-> query
      expand-metrics
      expand-segments))

Middleware that looks for :metric and :segment macros in an unexpanded MBQL query and substitute the macros for their contents.

(defn expand-macros
  [{query-type :type, :as query}]
  (if-not (= query-type :query)
    query
    (expand-metrics-and-segments query)))
 

Middleware responsible for 'hydrating' the source query for queries that use another query as their source. This middleware looks for MBQL queries like

{:source-table "card__1" ; Shorthand for using Card 1 as source query ...}

and resolves the referenced source query, transforming the query to look like the following:

{:source-query {...} ; Query for Card 1 :source-metadata [...] ; metadata about columns in Card 1 :source-card-id 1 ; Original Card ID ...}

This middleware resolves Card ID :source-tables at all levels of the query, but the top-level query often uses the so-called virtual-id, because the frontend client might not know the original Database; this middleware will replace that ID with the appropriate ID, e.g.

{:database , :type :query, :query {:source-table "card__1"}} -> {:database 1, :type :query, :query {:source-query {...}, :source-metadata {...}, :source-card-id 1}}

TODO - consider renaming this namespace to metabase.query-processor.middleware.resolve-card-id-source-tables

(ns metabase.query-processor.middleware.fetch-source-query
  (:require
   [clojure.set :as set]
   [medley.core :as m]
   [metabase.driver.ddl.interface :as ddl.i]
   [metabase.driver.util :as driver.u]
   [metabase.lib.convert :as lib.convert]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.lib.util :as lib.util]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.public-settings :as public-settings]
   [metabase.query-processor.middleware.permissions :as qp.perms]
   [metabase.query-processor.store :as qp.store]
   [metabase.query-processor.util.persisted-cache :as qp.persisted]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [weavejester.dependency :as dep]))
(set! *warn-on-reflection* true)

These next two schemas are for validating the intermediate stages of the middleware. We don't need to validate the entire query

(def ^:private SourceQueryAndMetadata
  [:map
   [:source-query    mbql.s/SourceQuery]
   [:database        mbql.s/DatabaseID]
   [:source-metadata [:maybe [:sequential mbql.s/SourceQueryMetadata]]]
   [:source-query/dataset? {:optional true} :boolean]
   [:persisted-info/native {:optional true} :string]])
(def ^:private MapWithResolvedSourceQuery
  [:and
   [:map
    [:database        mbql.s/DatabaseID]
    [:source-metadata [:maybe [:sequential mbql.s/SourceQueryMetadata]]]
    [:source-query    mbql.s/SourceQuery]
    [:source-card-id  ms/PositiveInt]]
   [:fn
    {:error/message "`:source-table` should be removed"}
    (complement :source-table)]])
(defn- query-has-unresolved-card-id-source-tables? [{inner-mbql-query :query}]
  (when inner-mbql-query
    (mbql.u/match-one inner-mbql-query
      (&match :guard (every-pred map? (comp string? :source-table))))))
(defn- query-has-resolved-database-id? [{:keys [database]}]
  ((every-pred integer? pos?) database))

Schema for a MBQL query where all card__id :source-tables have been removes and appropriate :source-querys have been added instead, and where the top-level :database ID, if it was the 'source query placeholder`, is replaced by the actual database ID of the source query.

This schema represents the way the query should look after this middleware finishes preprocessing it.

(def ^:private FullyResolvedQuery
  [:and
   mbql.s/Query
   [:fn
    {:error/message "Query where all card__id :source-tables are fully resolved"}
    (complement query-has-unresolved-card-id-source-tables?)]
   [:fn
    {:error/message "Query where source-query virtual `:database` has been replaced with actual Database ID"}
    query-has-resolved-database-id?]])

+----------------------------------------------------------------------------------------------------------------+ | Resolving card__id -> source query | +----------------------------------------------------------------------------------------------------------------+

Get the query to be run from the card

(defn- source-query
  [{dataset-query :dataset-query, card-id :id, :as card}]
  (let [dataset-query (cond-> dataset-query
                        (:lib/type dataset-query) lib.convert/->legacy-MBQL)
        {db-id                                           :database
         mbql-query                                      :query
         {template-tags :template-tags :as native-query} :native} dataset-query]
    (or
     mbql-query
     ;; rename `:query` to `:native` because source queries have a slightly different shape
     (when-some [native-query (set/rename-keys native-query {:query :native})]
       (let [mongo? (= (driver.u/database->driver db-id) :mongo)]
         (cond-> native-query
           ;; MongoDB native  queries consist of a collection and a pipelne (query)
           mongo? (update :native (fn [pipeline] {:collection (:collection native-query)
                                                  :query      pipeline}))
           (empty? template-tags) (dissoc :template-tags))))
     (throw (ex-info (tru "Missing source query in Card {0}" card-id)
                     {:card card, :dataset-query dataset-query})))))
(mu/defn card-id->source-query-and-metadata :- SourceQueryAndMetadata
  "Return the source query info for Card with `card-id`. Pass true as the optional second arg `log?` to enable
  logging. (The circularity check calls this and will print more than desired)"
  ([card-id :- ::lib.schema.id/card]
   (card-id->source-query-and-metadata card-id false))
  ([card-id :- ::lib.schema.id/card log? :- :boolean]
   (let [;; todo: we need to cache this. We are running this in preprocess, compile, and then again
         card           (or (lib.metadata/card (qp.store/metadata-provider) card-id)
                            (throw (ex-info (tru "Card {0} does not exist." card-id)
                                            {:card-id card-id})))
         persisted-info (:lib/persisted-info card)
         {{database-id :database} :dataset-query
          result-metadata         :result-metadata
          dataset?                :dataset} card
         persisted?     (qp.persisted/can-substitute? card persisted-info)
         source-query   (source-query card)]
     (when (and persisted? log?)
       (log/info (trs "Found substitute cached query for card {0} from {1}.{2}"
                      card-id
                      (ddl.i/schema-name {:id database-id} (public-settings/site-uuid))
                      (:table-name persisted-info))))
     ;; log the query at this point, it's useful for some purposes
     (log/debug (trs "Fetched source query from Card {0}:" card-id)
                "\n"
                (u/pprint-to-str 'yellow source-query))
     (cond-> {:source-query    (cond-> source-query
                                 ;; This will be applied, if still appropriate, by the peristence middleware
                                 persisted?
                                 (assoc :persisted-info/native
                                        (qp.persisted/persisted-info-native-query
                                         (u/the-id (lib.metadata/database (qp.store/metadata-provider)))
                                         persisted-info)))
              :database        database-id
              :source-metadata (seq (map mbql.normalize/normalize-source-metadata result-metadata))}
       dataset? (assoc :source-query/dataset? dataset?)))))

+----------------------------------------------------------------------------------------------------------------+ | Logic for traversing the query | +----------------------------------------------------------------------------------------------------------------+

Is x a map with a "card__id" :source-table, i.e., something this middleware needs to resolve?

(def ^:private ^{:arglists '([x])} map-with-card-id-source-table?
  (every-pred
   map?
   (comp string? :source-table)
   (comp (partial re-matches mbql.s/source-table-card-id-regex) :source-table)))
(mu/defn ^:private resolve-one :- MapWithResolvedSourceQuery
  [{:keys [source-table], :as m} :- [:map [:source-table mbql.s/source-table-card-id-regex]]]
  (let [card-id                   (-> source-table lib.util/legacy-string-table-id->card-id)
        source-query-and-metadata (-> card-id (card-id->source-query-and-metadata true))]
    (merge
     (dissoc m :source-table)
     ;; record the `card-id` we've resolved here. We'll include it in `:info` for permissions purposes later
     {:source-card-id card-id}
     source-query-and-metadata)))
(defn- resolve-all*
  [m]
  (mbql.u/replace m
    map-with-card-id-source-table?
    ;; if this is a map that has a Card ID `:source-table`, resolve that (replacing it with the appropriate
    ;; `:source-query`, then recurse and resolve any nested-nested queries that need to be resolved too
    (let [resolved (if (public-settings/enable-nested-queries)
                     (resolve-one &match)
                     (throw (ex-info (trs "Nested queries are disabled")
                                     {:clause &match})))]
      ;; wrap the recursive call in a try-catch; if the recursive resolution fails, add context about the
      ;; resolution that were we in the process of
      (try
        (resolve-all* resolved)
        (catch Throwable e
          (throw (ex-info (tru "Error resolving source query")
                          {:resolving &match, :resolved resolved}
                          e)))))))

Check that there are no circular dependencies among source cards. This is equivalent to finding a topological sort of the dependency graph. https://en.wikipedia.org/wiki/Topological_sorting

(defn- check-for-circular-references
  ([m]
   (check-for-circular-references (dep/graph) m)
   m)
  ([g m]
   (transduce (comp (filter map-with-card-id-source-table?)
                    (map (comp card-id->source-query-and-metadata
                               lib.util/legacy-string-table-id->card-id
                               :source-table)))
              (fn
                ([] g)
                ([g source-query]
                 (-> g
                     (dep/depend m source-query)
                     ;; Recursive call will circuit break the moment there's a cycle, so no
                     ;; danger of unbounded recursion.
                     (check-for-circular-references source-query)))
                ([g]
                 ;; This will throw if there's a cycle
                 (dep/topo-sort g)
                 g))
              (tree-seq coll? identity m))))

If m has the saved questions virtual :database ID, (recursively) look for actual resolved Database IDs in the next level down and copy it to our level.

(defn- copy-source-query-database-ids
  [{:keys [database], :as m}]
  (if (and database (not= database lib.schema.id/saved-questions-virtual-database-id))
    m
    (let [{:keys [query source-query], :as m}
          (cond-> m
            (:query m)        (update :query        copy-source-query-database-ids)
            (:source-query m) (update :source-query copy-source-query-database-ids))
          db-id
          (some (fn [{:keys [database]}]
                  (when (some-> database (not= lib.schema.id/saved-questions-virtual-database-id))
                    database))
                [source-query query])]
      (cond-> m
        db-id (assoc :database db-id)))))

Remove :database from all levels besides the top level.

(defn- remove-unneeded-database-ids
  [m]
  (mbql.u/replace-in m [:query]
    (&match :guard (every-pred map? :database (comp integer? :database)))
    (recur (dissoc &match :database))))
(mu/defn ^:private extract-resolved-card-id :- [:map
                                                [:card-id [:maybe ms/PositiveInt]]
                                                [:query   :map]]
  "If the ID of the Card we've resolved (`:source-card-id`) was added by a previous step, add it
  to `:query` `:info` (so it can be included in the QueryExecution log), then return a map with the resolved
  `:card-id` and updated `:query`."
  [query :- :map]
  (let [card-id (get-in query [:query :source-card-id])]
    {:query   (cond-> query
                card-id (update-in [:info :card-id] #(or % card-id)))
     :card-id card-id}))
(mu/defn ^:private resolve-all :- [:map
                                   [:card-id [:maybe ms/PositiveInt]]
                                   [:query   :map]]
  "Recursively replace all Card ID source tables in `query` with resolved `:source-query` and `:source-metadata`. Since
  the `:database` is only useful for top-level source queries, we'll remove it from all other levels."
  [query :- :map]
  ;; if a `:source-card-id` is already in the query, remove it, so we don't pull user-supplied input up into `:info`
  ;; allowing someone to bypass permissions
  (-> (m/dissoc-in query [:query :source-card-id])
      check-for-circular-references
      resolve-all*
      copy-source-query-database-ids
      remove-unneeded-database-ids
      extract-resolved-card-id))
(mu/defn resolve-card-id-source-tables* :- [:map
                                            [:card-id [:maybe ms/PositiveInt]]
                                            [:query   FullyResolvedQuery]]
  "Resolve `card__n`-style `:source-tables` in `query`."
  [{inner-query :query, :as outer-query} :- mbql.s/Query]
  (if-not inner-query
    ;; for non-MBQL queries there's nothing to do since they have nested queries
    {:query outer-query, :card-id nil}
    ;; Otherwise attempt to expand any source queries as needed. Pull the `:database` key up into the top-level if it
    ;; exists
    (resolve-all outer-query)))

Middleware that assocs the :source-query for this query if it was specified using the shorthand :source-table card__n format.

(defn resolve-card-id-source-tables
  [qp]
  (fn [query rff context]
    (let [{:keys [query card-id]} (resolve-card-id-source-tables* query)]
      (if card-id
        (let [dataset? (:dataset (lib.metadata.protocols/card (qp.store/metadata-provider) card-id))]
          (binding [qp.perms/*card-id* (or card-id qp.perms/*card-id*)]
            (qp query
                (fn [metadata]
                  (rff (cond-> metadata dataset? (assoc :dataset dataset?))))
                context)))
        (qp query rff context)))))
 
(ns metabase.query-processor.middleware.fix-bad-references
  (:require
   [clojure.walk :as walk]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.store :as qp.store]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]))
(defn- find-source-table [{:keys [source-table source-query]}]
  (or source-table
      (when source-query
        (recur source-query))))
(defn- find-join-against-table [{:keys [joins source-query]} table-id]
  (or (when source-query
        (find-join-against-table source-query table-id))
      (some (fn [join]
              (when (= (find-source-table join) table-id)
                join))
            joins)))
(defn- table [table-id]
  (when table-id
    (lib.metadata/table (qp.store/metadata-provider) table-id)))

A function to be called on each bad field found by this middleware. Not used except for in tests.

(def ^:dynamic *bad-field-reference-fn*
  (constantly nil))
(defn- fix-bad-references*
  ([inner-query]
   (fix-bad-references* inner-query inner-query (find-source-table inner-query)))
  ([inner-query form source-table & sources]
   (mbql.u/replace form
     ;; don't replace anything inside source metadata.
     (_ :guard (constantly ((set &parents) :source-metadata)))
     &match
     ;; if we have entered a join map and don't have `join-source` info yet, determine that and recurse.
     (m :guard (every-pred map?
                           :condition
                           (fn [join]
                             (let [join-source (find-source-table join)]
                               (not (contains? (set sources) join-source))))))
     (apply fix-bad-references* inner-query m source-table (cons (find-source-table m) sources))
     ;; find Field ID fields whose Table IS NOT the source table (or not directly available in some `[:source-query+
     ;; :source-table]` path that do not have `:join-alias` info
     [:field
      (id :guard (every-pred integer? (fn [id]
                                        (let [{:keys [table-id]} (lib.metadata/field (qp.store/metadata-provider) id)]
                                          (not (some (partial = table-id)
                                                     (cons source-table sources)))))))
      (opts :guard (complement :join-alias))]
     (let [{:keys [table-id], :as field} (lib.metadata/field (qp.store/metadata-provider) id)
           {join-alias :alias}           (find-join-against-table inner-query table-id)]
       (log/warn (u/colorize 'yellow (str (trs "Bad :field clause {0} for field {1} at {2}: clause should have a :join-alias."
                                               (pr-str &match)
                                               (pr-str (format "%s.%s"
                                                               (:name (table table-id))
                                                               (:name field)))
                                               (pr-str &parents))
                                          " "
                                          (if join-alias
                                            (trs "Guessing join {0}" (pr-str join-alias))
                                            (trs "Unable to infer an appropriate join. Query may not work as expected.")))))
       (*bad-field-reference-fn* &match)
       (if join-alias
         [:field id (assoc opts :join-alias join-alias)]
         &match)))))

Walk query and look for :field ID clauses without :join-alias information that reference Fields belonging to Tables other than the source Table (or an 'indirect' source Table that is available via source queries). Such references are technically disallowed. Since we are nice we will look thru joins and try to figure out a join that will work and add appropriate :join-alias information if we can.

This middleware performs a best-effort DWIM transformation, and isn't smart enough to fix every broken query out there. If the query cannot be fixed, this log a warning and move on. See #19612 for more information.

(defn fix-bad-references
  [query]
  (walk/postwalk
   (fn [form]
     (if (and (map? form)
              ((some-fn :source-query :source-table) form)
              (not (:condition form)))
       (fix-bad-references* form)
       form))
   query))
 

Middleware that formats the results of a query. Currently, the only thing this does is convert datetime types to ISO-8601 strings in the appropriate timezone.

(ns metabase.query-processor.middleware.format-rows
  (:require
   [java-time.api :as t]
   [metabase.query-processor.timezone :as qp.timezone]
   [metabase.util.date-2 :as u.date]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   [potemkin.types :as p.types])
  (:import
   (java.time Instant LocalDate LocalDateTime LocalTime OffsetDateTime OffsetTime ZonedDateTime ZoneId)))

Protocol for determining how QP results of various classes are serialized. Drivers can add implementations to support custom driver types as needed.

(p.types/defprotocol+ FormatValue
  (format-value [v ^ZoneId timezone-id]
    "Serialize a value in the QP results. You can add impementations for driver-specific types as needed."))
(extend-protocol FormatValue
  nil
  (format-value [_ _]
    nil)

  Object
  (format-value [v _]
    v)

  LocalTime
  (format-value [t timezone-id]
    (t/format :iso-offset-time (u.date/with-time-zone-same-instant t timezone-id)))

  OffsetTime
  (format-value [t timezone-id]
    (t/format :iso-offset-time (u.date/with-time-zone-same-instant t timezone-id)))

  LocalDate
  (format-value [t timezone-id]
    (t/format :iso-offset-date-time (u.date/with-time-zone-same-instant t timezone-id)))

  LocalDateTime
  (format-value [t timezone-id]
    (t/format :iso-offset-date-time (u.date/with-time-zone-same-instant t timezone-id)))

  ;; convert to a ZonedDateTime
  Instant
  (format-value [t timezone-id]
    (format-value (t/zoned-date-time t (t/zone-id "UTC")) timezone-id))

  OffsetDateTime
  (format-value [t, ^ZoneId timezone-id]
    (t/format :iso-offset-date-time (u.date/with-time-zone-same-instant t timezone-id)))

  ZonedDateTime
  (format-value [t timezone-id]
    (t/format :iso-offset-date-time (u.date/with-time-zone-same-instant t timezone-id))))
(defn- format-rows-xform [rf metadata]
  {:pre [(fn? rf)]}
  (log/debug (tru "Formatting rows with results timezone ID {0}" (qp.timezone/results-timezone-id)))
  (let [timezone-id  (t/zone-id (qp.timezone/results-timezone-id))
        ;; a column will have `converted_timezone` metadata if it is the result of `convert-timezone` expression
        ;; in that case, we'll format the results with the target timezone.
        ;; Otherwise format it with results-timezone
        cols-zone-id (map #(t/zone-id (get % :converted_timezone timezone-id)) (:cols metadata))]
    (fn
      ([]
       (rf))
      ([result]
       (rf result))
      ([result row]
       (rf result (mapv format-value row cols-zone-id))))))

Format individual query result values as needed. Ex: format temporal values as ISO-8601 strings w/ timezone offset.

(defn format-rows
  [{{:keys [format-rows?] :or {format-rows? true}} :middleware, :as _query} rff]
  (if format-rows?
    (fn format-rows-rff* [metadata]
      (format-rows-xform (rff metadata) metadata))
    rff))
 

Middleware for handling conversion of IDs to strings for proper display of large numbers

(ns metabase.query-processor.middleware.large-int-id
  (:require
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.store :as qp.store]))
(defn- ->string [x]
  (when x
    (str x)))
(defn- result-int->string
  [field-indexes rf]
  ((map (fn [row]
          (reduce #(update (vec %1) %2 ->string) row field-indexes)))
   rf))
(defn- should-convert-to-string? [field]
  (and (or (isa? (:semantic-type field) :type/PK)
           (isa? (:semantic-type field) :type/FK))
       (or (isa? (:base-type field) :type/Integer)
           (isa? (:base-type field) :type/Number))))
(defn- field-indexes [fields]
  (not-empty
   (keep-indexed
    (fn [idx val]
      ;; TODO -- we could probably fix the rest of #5816 by adding support for
      ;; `:field` w/ name and removing the PK/FK requirements -- might break
      ;; the FE client tho.
      (when-let [field (mbql.u/match-one val
                         [:field (field-id :guard integer?) _]
                         ;; TODO -- can't we use the QP store here? Seems like
                         ;; we should be able to, but it doesn't work (not
                         ;; initialized)
                         (lib.metadata.protocols/field (qp.store/metadata-provider) field-id))]
        (when (should-convert-to-string? field)
          idx)))
    fields)))

Converts any ID (:type/PK and :type/FK) in a result to a string to handle a number > 2^51 or < -2^51, the JavaScript float mantissa. This will allow proper display of large numbers, like IDs from services like social media. All ID numbers are converted to avoid the performance penalty of a comparison based on size. NULLs are converted to Clojure nil/JS null.

(defn convert-id-to-string
  [{{:keys [js-int-to-string?] :or {js-int-to-string? false}} :middleware, :as query} rff]
  ;; currently, this excludes `:field` w/ name clauses, aggregations, etc.
  ;;
  ;; for a query like below, *no* conversion will occur
  ;;
  ;;    (mt/mbql-query venues
  ;;                 {:source-query {:source-table $$venues
  ;;                                 :aggregation  [[:aggregation-options
  ;;                                                 [:avg $id]
  ;;                                                 {:name "some_generated_name", :display-name "My Cool Ag"}]]
  ;;                                 :breakout     [$price]}})
  ;;
  ;; when you run in this fashion, you lose the ability to determine if it's an ID - you get a `:fields` value like:
  ;;
  ;;    [[:field "PRICE" {:base-type :type/Integer}] [:field "some_generated_name" {:base-type :type/BigInteger}]]
  ;;
  ;; so, short of turning all `:type/Integer` derived values into strings, this is the best approximation of a fix
  ;; that can be accomplished.
  (let [rff' (when js-int-to-string?
               (when-let [field-indexes (field-indexes (:fields (:query query)))]
                 (fn [metadata]
                   (result-int->string field-indexes (rff metadata)))))]
    (or rff' rff)))
 

Middleware that handles limiting the maximum number of rows returned by a query.

(ns metabase.query-processor.middleware.limit
  (:require
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.interface :as qp.i]
   [metabase.query-processor.middleware.constraints :as qp.constraints]
   [metabase.query-processor.util :as qp.util]))

Pre-processing

Returns the value of the disable-max-results? option in this query.

(defn disable-max-results?
  [query]
  (get-in query [:middleware :disable-max-results?] false))

Sets the value of the disable-max-results? option in this query.

(defn disable-max-results
  [query]
  (assoc-in query [:middleware :disable-max-results?] true))
(defn- add-limit [max-rows {query-type :type, {original-limit :limit}, :query, :as query}]
  (cond-> query
    (and (= query-type :query)
         (qp.util/query-without-aggregations-or-limits? query))
    (update :query assoc :limit max-rows, ::original-limit original-limit)))

Given a query, return the max rows that should be returned, or nil if no limit should be applied. If a limit should be applied, this is the first non-nil value from (in decreasing priority order):

  1. the value of the [[metabase.query-processor.middleware.constraints/query->max-rows]] setting, which allows for database-local override
  2. the output of [[metabase.mbql.util/query->max-rows-limit]] when called on the given query
  3. [[metabase.query-processor.interface/absolute-max-results]] (a constant, non-nil backstop value)
(defn determine-query-max-rows
  [query]
  (when-not (disable-max-results? query)
    (or (qp.constraints/query->max-rows query)
        (mbql.u/query->max-rows-limit query)
        qp.i/absolute-max-results)))

Pre-processing middleware. Add default :limit to MBQL queries without any aggregations.

(defn add-default-limit
  [query]
  (if-let [max-rows (determine-query-max-rows query)]
    (add-limit max-rows query)
    query))

Post-processing

(defn- limit-xform [max-rows rf]
  {:pre [(fn? rf)]}
  ;; TODO FIXME: This is sort of a hack, but our old version of this code used to always take the first row no matter
  ;; what and [[metabase.driver.sqlserver-test/max-results-bare-rows-test]] was written expecting that behavior. I
  ;; haven't quite worked around how to fix that test yet. When that happens we can change this to
  ;;
  ;;    ((take max-rows) rf)
  ;;
  ;; Background: SQL Server treats a limit of `0` as meaning "unbounded". SQL Server can override
  ;; [[qp.constraints/max-results-bare-rows]] with a Database-local Setting to fix #9940, where queries with aggregations
  ;; and expressions could return the wrong results because of limits being applied to subselects. Realistically the
  ;; overriden limit of `0` should probably only apply to the MBQL query and not to the number of rows we take. But we'd
  ;; have to break [[determine-query-max-rows]] into two separate things in order to do that. :shrug:
  ((take (if-not (pos? max-rows) 1 max-rows)) rf))

Post-processing middleware. Limit the maximum number of rows that are returned in post-processing.

(defn limit-result-rows
  [query rff]
  (let [max-rows (determine-query-max-rows query)]
    (fn limit-result-rows-rff* [metadata]
      (limit-xform max-rows (rff metadata)))))
 

Middleware responsible for converting MBQL queries to native queries (by calling the driver's QP methods) so the query can then be executed.

(ns metabase.query-processor.middleware.mbql-to-native
  (:require
   [metabase.driver :as driver]
   [metabase.util :as u]
   [metabase.util.log :as log]))

Return a :native query form for query, converting it from MBQL if needed.

(defn query->native-form
  [{query-type :type, :as query}]
  (if-not (= :query query-type)
    (:native query)
    (driver/mbql->native driver/*driver* query)))

Middleware that handles conversion of MBQL queries to native (by calling driver QP methods) so the queries can be executed. For queries that are already native, this function is effectively a no-op.

(defn mbql->native
  [qp]
  (fn [query rff context]
    (let [native-query (query->native-form query)]
      (log/trace (u/format-color 'yellow "\nPreprocessed:\n%s" (u/pprint-to-str query)))
      (log/trace (u/format-color 'green "Native form: \n%s" (u/pprint-to-str native-query)))
      (qp
       (assoc query :native native-query)
       (fn [metadata]
         (rff (assoc metadata :native_form native-query)))
       context))))
 

Middleware that converts a query into a normalized, canonical form.

(ns metabase.query-processor.middleware.normalize-query
  (:require
   [metabase.lib.convert :as lib.convert]
   [metabase.lib.core :as lib]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.util :as u]
   [metabase.util.log :as log]))
(set! *warn-on-reflection* true)
(defn- normalize* [query]
  (try
    (let [query-type (keyword (some #(get query %) [:lib/type "lib/type" :type "type"]))
          _          (assert query-type
                             (format "Invalid query, missing query :type or :lib/type: %s" (pr-str query)))
          normalized (case query-type
                       :mbql/query      ; pMBQL pipeline query
                       (lib.convert/->legacy-MBQL (lib/normalize query))
                       (:query :native)
                       (mbql.normalize/normalize query))]
      (log/tracef "Normalized query:\n%s\n=>\n%s" (u/pprint-to-str query) (u/pprint-to-str normalized))
      normalized)
    (catch Throwable e
      (throw (ex-info (format "Error normalizing query: %s" (.getMessage e))
                      {:type  qp.error-type/qp
                       :query query}
                      e)))))

Middleware that converts a query into a normalized, canonical form, including things like converting all identifiers into standard lisp-case ones, removing/rewriting legacy clauses, removing empty ones, etc. This is done to simplifiy the logic in the QP steps following this.

(defn normalize
  [qp]
  (fn [query rff context]
    (qp (normalize* query) rff context)))
 

Middlware that optimizes equality filter clauses against bucketed temporal fields. See docstring for optimize-temporal-filters for more details.

(ns metabase.query-processor.middleware.optimize-temporal-filters
  (:require
   [clojure.walk :as walk]
   [metabase.mbql.util :as mbql.u]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]))
(def ^:private optimizable-units
  #{:second :minute :hour :day :week :month :quarter :year})
(defn- temporal-unit [field]
  (mbql.u/match-one field [:field _ (opts :guard :temporal-unit)] (:temporal-unit opts)))
(defn- optimizable-field? [field]
  (mbql.u/match-one field
    [:field _ (_ :guard (comp optimizable-units :temporal-unit))]))
(defmulti ^:private can-optimize-filter?
  mbql.u/dispatch-by-clause-name-or-class)

Can temporal-value clause can be optimized?

(defn- optimizable-temporal-value?
  [temporal-value]
  (mbql.u/match-one temporal-value
    [:relative-datetime (_ :guard #{0 :current})]
    true
    [(_ :guard #{:absolute-datetime :relative-datetime}) _ (unit :guard optimizable-units)]
    true))

Do datetime field clause and temporal-value clause have 'compatible' units that mean we'll be able to optimize the filter clause they're in?

(defn- field-and-temporal-value-have-compatible-units?
  [field temporal-value]
  (mbql.u/match-one temporal-value
    [:relative-datetime (_ :guard #{0 :current})]
    true
    [(_ :guard #{:absolute-datetime :relative-datetime}) _ (unit :guard optimizable-units)]
    (= (temporal-unit field) unit)))
(defmethod can-optimize-filter? :default
  [filter-clause]
  (mbql.u/match-one filter-clause
    [_
     (field :guard optimizable-field?)
     (temporal-value :guard optimizable-temporal-value?)]
    (field-and-temporal-value-have-compatible-units? field temporal-value)))
(defmethod can-optimize-filter? :between
  [filter-clause]
  (mbql.u/match-one filter-clause
    [_
     (field :guard optimizable-field?)
     (temporal-value-1 :guard optimizable-temporal-value?)
     (temporal-value-2 :guard optimizable-temporal-value?)]
    (and (field-and-temporal-value-have-compatible-units? field temporal-value-1)
         (field-and-temporal-value-have-compatible-units? field temporal-value-2))))
(mu/defn ^:private temporal-literal-lower-bound
  [unit t :- (ms/InstanceOfClass java.time.temporal.Temporal)]
  (:start (u.date/range t unit)))
(mu/defn ^:private temporal-literal-upper-bound
  [unit t :- (ms/InstanceOfClass java.time.temporal.Temporal)]
  (:end (u.date/range t unit)))
(defn- change-temporal-unit-to-default [field]
  (mbql.u/replace field
    [:field _ (_ :guard (comp optimizable-units :temporal-unit))]
    (mbql.u/update-field-options &match assoc :temporal-unit :default)))

Get a clause representing the lower bound that should be used when converting a temporal-value-clause (e.g. :absolute-datetime or :relative-datetime) to an optimized range.

(defmulti ^:private temporal-value-lower-bound
  {:arglists '([temporal-value-clause temporal-unit])}
  mbql.u/dispatch-by-clause-name-or-class)

Get a clause representing the upper bound that should be used when converting a temporal-value-clause (e.g. :absolute-datetime or :relative-datetime) to an optimized range.

(defmulti ^:private temporal-value-upper-bound
  {:arglists '([temporal-value-clause temporal-unit])}
  mbql.u/dispatch-by-clause-name-or-class)
(defmethod temporal-value-lower-bound :absolute-datetime
  [[_ t unit] _]
  [:absolute-datetime (temporal-literal-lower-bound unit t) :default])
(defmethod temporal-value-upper-bound :absolute-datetime
  [[_ t unit] _]
  [:absolute-datetime (temporal-literal-upper-bound unit t) :default])
(defmethod temporal-value-lower-bound :relative-datetime
  [[_ n unit] temporal-unit]
  [:relative-datetime (if (= n :current) 0 n) (or unit temporal-unit)])
(defmethod temporal-value-upper-bound :relative-datetime
  [[_ n unit] temporal-unit]
  [:relative-datetime (inc (if (= n :current) 0 n)) (or unit temporal-unit)])

Optimize a filter clause against a temporal-bucketed :field clause and :absolute-datetime or :relative-datetime value by converting to an unbucketed range.

(defmulti ^:private optimize-filter
  {:arglists '([clause])}
  mbql.u/dispatch-by-clause-name-or-class)
(defmethod optimize-filter :=
  [[_tag field temporal-value]]
  (let [temporal-unit (mbql.u/match-one field [:field _ (opts :guard :temporal-unit)] (:temporal-unit opts))]
    (when (field-and-temporal-value-have-compatible-units? field temporal-value)
      (let [field' (change-temporal-unit-to-default field)]
        [:and
         [:>= field' (temporal-value-lower-bound temporal-value temporal-unit)]
         [:< field'  (temporal-value-upper-bound temporal-value temporal-unit)]]))))
(defmethod optimize-filter :!=
  [filter-clause]
  (mbql.u/negate-filter-clause ((get-method optimize-filter :=) filter-clause)))
(defn- optimize-comparison-filter
  [optimize-temporal-value-fn [_filter-type field temporal-value] new-filter-type]
  [new-filter-type
   (change-temporal-unit-to-default field)
   (optimize-temporal-value-fn temporal-value (temporal-unit field))])
(defmethod optimize-filter :<
  [filter-clause]
  (optimize-comparison-filter temporal-value-lower-bound filter-clause :<))
(defmethod optimize-filter :<=
  [filter-clause]
  (optimize-comparison-filter temporal-value-upper-bound filter-clause :<))
(defmethod optimize-filter :>
  [filter-clause]
  (optimize-comparison-filter temporal-value-upper-bound filter-clause :>=))
(defmethod optimize-filter :>=
  [filter-clause]
  (optimize-comparison-filter temporal-value-lower-bound filter-clause :>=))
(defmethod optimize-filter :between
  [[_ field lower-bound upper-bound]]
  (let [field' (change-temporal-unit-to-default field)]
    [:and
     [:>= field' (temporal-value-lower-bound lower-bound (temporal-unit field))]
     [:<  field' (temporal-value-upper-bound upper-bound (temporal-unit field))]]))
(defn- optimize-temporal-filters* [query]
  (mbql.u/replace query
    (_ :guard (partial mbql.u/is-clause? (set (keys (methods optimize-filter)))))
    (or (when (can-optimize-filter? &match)
          (u/prog1 (optimize-filter &match)
            (if <>
              (when-not (= &match <>)
                (log/tracef "Optimized filter %s to %s" (pr-str &match) (pr-str <>)))
              ;; if for some reason `optimize-filter` doesn't return an optimized filter clause, log and error and use
              ;; the original. `can-optimize-filter?` shouldn't have said we could optimize this filter in the first
              ;; place
              (log/error (trs "Error optimizing temporal filter clause") (pr-str &match)))))
        &match)))

Middlware that optimizes equality (= and !=) and comparison (<, between, etc.) filter clauses against bucketed datetime fields. Rewrites those filter clauses as logically equivalent filter clauses that do not use bucketing (i.e., their datetime unit is :default, meaning no bucketing functions need be applied).

[:= [:field 1 {:temporal-unit :month}] [:absolute-datetime #t "2019-09-01" :month]] -> [:and [:>= [:field 1 {:temporal-unit :default}] [:absolute-datetime #t "2019-09-01" :month]] [:< [:field 1 {:temporal-unit :default}] [:absolute-datetime #t "2019-10-01" :month]]]

The equivalent SQL, before and after, looks like:

-- before SELECT ... WHERE datetrunc('month', myfield) = date_trunc('month', timestamp '2019-09-01 00:00:00')

-- after SELECT ... WHERE myfield >= timestamp '2019-09-01 00:00:00' AND myfield < timestamp '2019-10-01 00:00:00'

The idea here is that by avoiding casts/extraction/truncation operations, databases will be able to make better use of indexes on these columns.

This namespace expects to run after the wrap-value-literals middleware, meaning datetime literal strings like "2019-09-24" should already have been converted to :absolute-datetime clauses.

(defn optimize-temporal-filters
  [{query-type :type, :as query}]
  (if (not= query-type :query)
    query
    ;; walk query, looking for inner-query forms that have a `:filter` key
    (walk/postwalk
     (fn [form]
       (if-not (and (map? form) (seq (:filter form)))
         form
         ;; optimize the filters in this inner-query form.
         (let [optimized (optimize-temporal-filters* form)]
           ;; if we did some optimizations, we should flatten/deduplicate the filter clauses afterwards.
           (cond-> optimized
             (not= optimized form) (update :filter mbql.u/combine-filter-clauses)))))
     query)))
 

Middleware for substituting parameters in queries.

(ns metabase.query-processor.middleware.parameters
  (:require
   [clojure.data :as data]
   [clojure.set :as set]
   [medley.core :as m]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.middleware.parameters.mbql :as qp.mbql]
   [metabase.query-processor.middleware.parameters.native :as qp.native]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]))
(defn- join? [m]
  (:condition m))
(mu/defn ^:private move-join-condition-to-source-query :- mbql.s/Join
  "Joins aren't allowed to have `:filter` clauses, generated by the `expand-mbql-params` function below. Move the filter
  clause into the `:source-query`, converting `:source-table` to a source query if needed."
  [{:keys [source-table], filter-clause :filter, :as join}]
  (if-not filter-clause
    join
    (if source-table
      (-> (assoc join :source-query {:source-table source-table, :filter filter-clause})
          (dissoc :source-table :filter))
      ;; putting parameters in a join that has a `:source-query` is a little wacky (just add them to `:parameters` in
      ;; the source query itself), but we'll allow it for now
      (-> (update-in join [:source-query :filter] mbql.u/combine-filter-clauses filter-clause)
          (dissoc :filter)))))
(defn- expand-mbql-params [outer-query {:keys [parameters], :as m}]
  ;; HACK `qp.mbql/expand` assumes it's operating on an outer query so wrap `m` to look like an outer query. TODO
  ;; - fix `qp.mbql` to operate on abitrary maps instead of only on top-level queries.
  (let [wrapped           (assoc outer-query :query m)
        {expanded :query} (qp.mbql/expand (dissoc wrapped :parameters) parameters)]
    (cond-> expanded
      (join? m) move-join-condition-to-source-query)))

Expand :parameters in one inner-query-style map that contains them.

(defn- expand-one
  [outer-query {:keys [source-table source-query parameters], :as m}]
  ;; HACK - normalization does not yet operate on `:parameters` that aren't at the top level, so double-check that
  ;; they're normalized properly before proceeding.
  (let [m        (cond-> m
                   (seq parameters) (update :parameters (partial mbql.normalize/normalize-fragment [:parameters])))
        expanded (if (or source-table source-query)
                   (expand-mbql-params outer-query m)
                   (qp.native/expand-inner m))]
    (dissoc expanded :parameters :template-tags)))

Expand all :parameters anywhere in the query.

(defn- expand-all
  ([outer-query]
   (expand-all outer-query outer-query))
  ([outer-query m]
   (mbql.u/replace m
     (_ :guard (every-pred map? (some-fn :parameters :template-tags)))
     (let [expanded (expand-one outer-query &match)]
       ;; now recursively expand any remaining maps that contain `:parameters`
       (expand-all outer-query expanded)))))

Move any top-level parameters to the same level (i.e., 'inner query') as the query they affect.

(defn- move-top-level-params-to-inner-query
  [{:keys [parameters], query-type :type, :as outer-query}]
  {:pre [(#{:query :native} query-type)]}
  (cond-> (set/rename-keys outer-query {:parameters :user-parameters})
    (seq parameters)
    (assoc-in [query-type :parameters] parameters)))

Expand parameters in the outer-query, and if the query is using a native source query, expand params in that as well.

(defn- expand-parameters
  [outer-query]
  (-> outer-query move-top-level-params-to-inner-query expand-all))
(mu/defn ^:private substitute-parameters* :- :map
  "If any parameters were supplied then substitute them into the query."
  [query]
  (u/prog1 (expand-parameters query)
    (when (not= <> query)
      (when-let [diff (second (data/diff query <>))]
        (log/tracef "\n\nSubstituted params:\n%s\n" (u/pprint-to-str 'cyan diff))))))
(defn- assoc-db-in-snippet-tag
  [db template-tags]
  (->> template-tags
       (m/map-vals
        (fn [v]
          (cond-> v
            (= (:type v) :snippet) (assoc :database db))))
       (into {})))

Assocs the :database ID from query in all snippet template tags.

(defn- hoist-database-for-snippet-tags
  [query]
  (u/update-in-if-exists query [:native :template-tags] (partial assoc-db-in-snippet-tag (:database query))))

Substitute Dashboard or Card-supplied parameters in a query, replacing the param placeholers with appropriate values and/or modifiying the query as appropriate. This looks for maps that have the key :parameters and/or :template-tags and removes those keys, splicing appropriate conditions into the queries they affect.

A SQL query with a param like {{param}} will have that part of the query replaced with an appropriate snippet as well as any prepared statement args needed. MBQL queries will have additional filter clauses added.

(defn substitute-parameters
  [query]
  (-> query
      hoist-database-for-snippet-tags
      substitute-parameters*))
 

Code for handling parameter substitution in MBQL queries.

(ns metabase.query-processor.middleware.parameters.mbql
  (:require
   [metabase.driver.common.parameters.dates :as params.dates]
   [metabase.driver.common.parameters.operators :as params.ops]
   [metabase.lib.convert :as lib.convert]
   [metabase.lib.core :as lib]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.params :as params]
   [metabase.query-processor.store :as qp.store]
   [metabase.util.malli :as mu]))
(set! *warn-on-reflection* true)
(mu/defn ^:private to-numeric :- number?
  "Returns either a double or a long. Possible to use the edn reader but we would then have to worry about biginters
  or arbitrary maps/stuff being read. Error messages would be more confusing EOF while reading instead of a more
  sensical number format exception."
  [s]
  (if (re-find #"\." s)
    (Double/parseDouble s)
    (Long/parseLong s)))
(defn- field-type
  [field-clause]
  (mbql.u/match-one field-clause
    [:field (id :guard integer?) _]  ((some-fn :effective-type :base-type)
                                      (lib.metadata.protocols/field (qp.store/metadata-provider) id))
    [:field (_ :guard string?) opts] (:base-type opts)))
(defn- expression-type
  [query expression-clause]
  (mbql.u/match-one expression-clause
    [:expression (expression-name :guard string?)]
    (lib/type-of (lib/query (qp.store/metadata-provider) (lib.convert/->pMBQL query))
                 (lib.convert/->pMBQL &match))))

Convert param-value to a type appropriate for param-type. The frontend always passes parameters in as strings, which is what we want in most cases; for numbers, instead convert the parameters to integers or floating-point numbers.

(mu/defn ^:private parse-param-value-for-type
  [query param-type param-value field-clause :- mbql.s/Field]
  (cond
    ;; for `id` or `category` type params look up the base-type of the Field and see if it's a number or not.
    ;; If it *is* a number then recursively call this function and parse the param value as a number as appropriate.
    (and (#{:id :category} param-type)
         (let [base-type (or (field-type field-clause)
                             (expression-type query field-clause))]
           (isa? base-type :type/Number)))
    (recur query :number param-value field-clause)
    ;; no conversion needed if PARAM-TYPE isn't :number or PARAM-VALUE isn't a string
    (or (not= param-type :number)
        (not (string? param-value)))
    param-value
    :else
    (to-numeric param-value)))
(mu/defn ^:private build-filter-clause :- [:maybe mbql.s/Filter]
  [query {param-type :type, param-value :value, [_ field :as target] :target, :as param}]
  (cond
    (params.ops/operator? param-type)
    (params.ops/to-clause param)
    ;; multipe values. Recursively handle them all and glue them all together with an OR clause
    (sequential? param-value)
    (mbql.u/simplify-compound-filter
     (vec (cons :or (for [value param-value]
                      (build-filter-clause query {:type param-type, :value value, :target target})))))
    ;; single value, date range. Generate appropriate MBQL clause based on date string
    (params.dates/date-type? param-type)
    (params.dates/date-string->filter
     (parse-param-value-for-type query param-type param-value (params/unwrap-field-or-expression-clause field))
     field)
    ;; TODO - We can't tell the difference between a dashboard parameter (convert to an MBQL filter) and a native
    ;; query template tag parameter without this. There's should be a better, less fragile way to do this. (Not 100%
    ;; sure why, but this is needed for GTAPs to work.)
    (mbql.u/is-clause? :template-tag field)
    nil
    ;; single-value, non-date param. Generate MBQL [= [field <field> nil] <value>] clause
    :else
    [:=
     (params/wrap-field-id-if-needed field)
     (parse-param-value-for-type query param-type param-value (params/unwrap-field-or-expression-clause field))]))

Expand parameters for MBQL queries in query (replacing Dashboard or Card-supplied params with the appropriate values in the queries themselves).

(defn expand
  [query [{:keys [target value default], :as param} & rest]]
  (let [param-value (or value default)]
    (cond
      (not param)
      query
      (or (not target)
          (not param-value))
      (recur query rest)
      :else
      (let [filter-clause (build-filter-clause query (assoc param :value param-value))
            query         (mbql.u/add-filter-clause query filter-clause)]
        (recur query rest)))))
 

Param substitution for native queries.

The Basics:

  • Things like {{x}} (required params) get substituted with the value of :x, which can be a literal used in a clause (e.g. in a clause like value = {{x}}) or a "field filter" that handles adding the clause itself (e.g. {{timestamp}} might become timestamp BETWEEN ? AND ?).

  • Things like [[AND {{x}]] are optional params. If the param (:x) isn't specified, the entire clause inside [[...]] is replaced with an empty string; If it is specified, the value inside the curly brackets {{x}} is replaced as usual and the rest of the clause (AND ...) is included in the query as-is

Native parameter parsing and substution logic shared by multiple drivers lives in metabase.driver.common.parameters.*. Driver-specific parsing/substitution logic is implemented in metabase.driver.sql.parameters.* (for SQL drivers) or similar namespaces for others.

The different steps of this process, are similar between existing driver implementations, and are as follows:

  1. values parses :parameters passed in as arguments to the query and returns a map of param key -> value

  2. parse takes a string and breaks it out into a series of string fragments interleaved with objects representing optional and non-optional params

  3. substitute (and the related namespace substitution) replace optional and param objects with appropriate SQL snippets and prepared statement args, and combine the sequence of fragments back into a single SQL string.

(ns metabase.query-processor.middleware.parameters.native
  (:require
   [clojure.set :as set]
   [metabase.driver :as driver]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.query-processor.store :as qp.store]))

Expand parameters inside an inner native query. Not recursive -- recursive transformations are handled in the middleware.parameters functions that invoke this function.

(defn expand-inner
  [inner-query]
  (if-not (driver/database-supports? driver/*driver* :native-parameters (lib.metadata/database (qp.store/metadata-provider)))
    inner-query
    ;; Totally ridiculous, but top-level native queries use the key `:query` for SQL or equivalent, while native
    ;; source queries use `:native`. So we need to handle either case.
    (let [source-query?           (:native inner-query)
          substituted-inner-query (driver/substitute-native-parameters driver/*driver*
                                                                       (set/rename-keys inner-query {:native :query}))]
      (cond-> (dissoc substituted-inner-query :parameters :template-tags)
        source-query? (set/rename-keys {:query :native})))))
 

Middleware for checking that the current user has permissions to run the current query.

(ns metabase.query-processor.middleware.permissions
  (:require
   [clojure.set :as set]
   [metabase.api.common
    :refer [*current-user-id* *current-user-permissions-set*]]
   [metabase.config :as config]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.models.interface :as mi]
   [metabase.models.permissions :as perms]
   [metabase.models.query.permissions :as query-perms]
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.store :as qp.store]
   [metabase.query-processor.util.tag-referenced-cards
    :as qp.u.tag-referenced-cards]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]))

ID of the Card currently being executed, if there is one. Bind this in a Card-execution so we will use Card [Collection] perms checking rather than ad-hoc perms checking.

(def ^:dynamic *card-id*
  nil)

Returns an ExceptionInfo instance containing data relevant for a permissions error.

(defn perms-exception
  ([required-perms]
   (perms-exception (tru "You do not have permissions to run this query.") required-perms))
  ([message required-perms & [additional-ex-data]]
   (ex-info message
            (merge {:type                 qp.error-type/missing-required-permissions
                    :required-permissions required-perms
                    :actual-permissions   @*current-user-permissions-set*
                    :permissions-error?   true}
                   additional-ex-data))))

Assert that block permissions are not in effect for Database for a query that's only allowed to run because of Collection perms; throw an Exception if they are. Otherwise returns a keyword explaining why the check wasn't done, or why it succeeded (this is mostly for test/debug purposes). The query is still allowed to run if the current User has appropriate data permissions from another Group. See the namespace documentation for [[metabase.models.collection]] for more details.

Note that this feature is Metabase© Enterprise Edition™ only. Actual implementation is in [[metabase-enterprise.advanced-permissions.models.permissions.block-permissions/check-block-permissions]] if EE code is present. This feature is only enabled if we have a valid Enterprise Edition™ token.

(def ^:private ^{:arglists '([query])} check-block-permissions
  (let [dlay (delay
              (when config/ee-available?
                (classloader/require 'metabase-enterprise.advanced-permissions.models.permissions.block-permissions)
                (resolve 'metabase-enterprise.advanced-permissions.models.permissions.block-permissions/check-block-permissions)))]
    (fn [query]
      (when-let [f @dlay]
        (f query)))))

Check that the current user has permissions to read Card with card-id, or throw an Exception.

(mu/defn ^:private check-card-read-perms
  [database-id :- ::lib.schema.id/database
   card-id     :- ::lib.schema.id/card]
  (qp.store/with-metadata-provider database-id
    (let [card (or (some-> (lib.metadata.protocols/card (qp.store/metadata-provider) card-id)
                           (update-keys u/->snake_case_en)
                           (vary-meta assoc :type :model/Card))
                   (throw (ex-info (tru "Card {0} does not exist." card-id)
                                   {:type    qp.error-type/invalid-query
                                    :card-id card-id})))]
      (log/tracef "Required perms to run Card: %s" (pr-str (mi/perms-objects-set card :read)))
      (when-not (mi/can-read? card)
        (throw (perms-exception (tru "You do not have permissions to view Card {0}." card-id)
                                (mi/perms-objects-set card :read)
                                {:card-id *card-id*}))))))
(declare check-query-permissions*)
(defn- required-perms
  {:arglists '([outer-query])}
  [{{gtap-perms :gtaps} ::perms, :as outer-query}]
  (set/difference
   (query-perms/perms-set outer-query, :throw-exceptions? true, :already-preprocessed? true)
   gtap-perms))
(defn- has-data-perms? [required-perms]
  (perms/set-has-full-permissions-for-set? @*current-user-permissions-set* required-perms))
(mu/defn ^:private check-ad-hoc-query-perms
  [outer-query]
  (let [required-perms (required-perms outer-query)]
    (when-not (has-data-perms? required-perms)
      (throw (perms-exception required-perms))))
  ;; check perms for any Cards referenced by this query (if it is a native query)
  (doseq [{query :dataset-query} (qp.u.tag-referenced-cards/tags-referenced-cards outer-query)]
    (check-query-permissions* query)))

Used to allow users looking at a dashboard to view (possibly chained) filters.

(def ^:dynamic *param-values-query*
  false)

OSS implementation always throws an exception since queries over the audit DB are not permitted.

(defenterprise check-audit-db-permissions
  metabase-enterprise.audit-app.permissions
  [query]
  (throw (ex-info (tru "Querying this database requires the audit-app feature flag")
                  query)))

Check that User with user-id has permissions to run query, or throw an exception.

(mu/defn ^:private check-query-permissions*
  [{database-id :database, :as outer-query} :- [:map [:database ::lib.schema.id/database]]]
  (when *current-user-id*
    (log/tracef "Checking query permissions. Current user perms set = %s" (pr-str @*current-user-permissions-set*))
    (when (= perms/audit-db-id database-id)
     (check-audit-db-permissions outer-query))
    (cond
      *card-id*
      (do
        (check-card-read-perms database-id *card-id*)
        (when-not (has-data-perms? (required-perms outer-query))
          (check-block-permissions outer-query)))
      ;; set when querying for field values of dashboard filters, which only require
      ;; collection perms for the dashboard and not ad-hoc query perms
      *param-values-query*
      (when-not (has-data-perms? (required-perms outer-query))
        (check-block-permissions outer-query))
      :else
      (check-ad-hoc-query-perms outer-query))))

Middleware that check that the current user has permissions to run the current query. This only applies if *current-user-id* is bound. In other cases, like when running public Cards or sending pulses, permissions need to be checked separately before allowing the relevant objects to be create (e.g., when saving a new Pulse or 'publishing' a Card).

(defn check-query-permissions
  [qp]
  (fn [query rff context]
    (check-query-permissions* query)
    (qp query rff context)))

Pre-processing middleware. Removes the ::perms key from the query. This is where we store important permissions information like perms coming from sandboxing (GTAPs). This is programatically added by middleware when appropriate, but we definitely don't want users passing it in themselves. So remove it if it's present.

(defn remove-permissions-key
  [query]
  (dissoc query ::perms))

+----------------------------------------------------------------------------------------------------------------+ | Writeback fns | +----------------------------------------------------------------------------------------------------------------+

Check that User with user-id has permissions to run query action query, or throw an exception.

(mu/defn check-query-action-permissions*
  [{database-id :database, :as outer-query} :- [:map [:database ::lib.schema.id/database]]]
  (log/tracef "Checking query permissions. Current user perms set = %s" (pr-str @*current-user-permissions-set*))
  (when *card-id*
    (check-card-read-perms database-id *card-id*))
  (when-not (has-data-perms? (required-perms outer-query))
    (check-block-permissions outer-query)))

Middleware that check that the current user has permissions to run the current query action.

(defn check-query-action-permissions
  [qp]
  (fn [query rff context]
    (check-query-action-permissions* query)
    (qp query rff context)))

+----------------------------------------------------------------------------------------------------------------+ | Non-middleware util fns | +----------------------------------------------------------------------------------------------------------------+

If current user is bound, do they have ad-hoc native query permissions for query's database? (This is used by [[metabase.query-processor/compile]] and the [[metabase.query-processor.middleware.catch-exceptions/catch-exceptions]] middleware to check the user should be allowed to see the native query before converting the MBQL query to native.)

(defn current-user-has-adhoc-native-query-perms?
  [{database-id :database, :as _query}]
  (or
   (not *current-user-id*)
   (let [required-perms (perms/adhoc-native-query-path database-id)]
     (perms/set-has-full-permissions? @*current-user-permissions-set* required-perms))))

Check that the current user (if bound) has adhoc native query permissions to run query, or throw an Exception. (This is used by the POST /api/dataset/native endpoint to check perms before converting an MBQL query to native.)

(defn check-current-user-has-adhoc-native-query-perms
  [{database-id :database, :as query}]
  (when-not (current-user-has-adhoc-native-query-perms? query)
    (throw (perms-exception (perms/adhoc-native-query-path database-id)))))
 
(ns metabase.query-processor.middleware.persistence
  (:require
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.middleware.permissions :as qp.perms]))

Removes persisted information if user is sandboxed. :persisted-info/native is set in fetch-source-query.

If permissions are applied to the query (sandboxing) then do not use the cached query. It may be be possible to use the persistence cache with sandboxing at a later date with further work.

(defn substitute-persisted-query
  [{::qp.perms/keys [perms] :as  query}]
  (if perms
    (mbql.u/replace query
      (x :guard (every-pred map? :persisted-info/native))
      (dissoc x :persisted-info/native))
    query))
 
(ns metabase.query-processor.middleware.pre-alias-aggregations
  (:require
   [metabase.driver :as driver]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.middleware.annotate :as annotate]))
(defn- ag-name [inner-query ag-clause]
  (driver/escape-alias driver/*driver* (annotate/aggregation-name inner-query ag-clause)))
(defn- pre-alias-and-uniquify [inner-query aggregations]
  (mapv
   (fn [original-ag updated-ag]
     (if (= original-ag updated-ag)
       original-ag
       (with-meta updated-ag {:auto-generated? true})))
   aggregations
   (mbql.u/pre-alias-and-uniquify-aggregations (partial ag-name inner-query) aggregations)))

Make sure all aggregations have aliases, and all aliases are unique, in an 'inner' MBQL query.

(defn pre-alias-aggregations-in-inner-query
  [{:keys [aggregation source-query joins], :as inner-query}]
  (cond-> inner-query
    (seq aggregation)
    (update :aggregation (partial pre-alias-and-uniquify inner-query))
    source-query
    (update :source-query pre-alias-aggregations-in-inner-query)
    joins
    (update :joins (partial mapv pre-alias-aggregations-in-inner-query))))

Middleware that generates aliases for all aggregations anywhere in a query, and makes sure they're unique.

(defn pre-alias-aggregations
  [{query-type :type, :as query}]
  (if-not (= query-type :query)
    query
    (update query :query pre-alias-aggregations-in-inner-query)))
 
(ns metabase.query-processor.middleware.prevent-infinite-recursive-preprocesses
  (:require
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]))
(def ^:private ^:dynamic *preprocessing-level* 1)
(def ^:private ^:const max-preprocessing-level 20)

QP around-middleware only used for preprocessing queries with [[metabase.query-processor/preprocess]]. Prevent infinite recursive calls to preprocess.

(defn prevent-infinite-recursive-preprocesses
  [qp]
  (fn [query rff context]
    (binding [*preprocessing-level* (inc *preprocessing-level*)]
      ;; record the number of recursive preprocesses taking place to prevent infinite preprocessing loops.
      (log/tracef "*preprocessing-level*: %d" *preprocessing-level*)
      (when (>= *preprocessing-level* max-preprocessing-level)
        (throw (ex-info (str (tru "Infinite loop detected: recursively preprocessed query {0} times."
                                  max-preprocessing-level))
                        {:type qp.error-type/qp})))
      (qp query rff context))))
 

Middleware related to doing extra steps for queries that are ran via API endpoints (i.e., most of them -- as opposed to queries ran internally e.g. as part of the sync process). These include things like saving QueryExecutions and adding query ViewLogs, storing exceptions and formatting the results.

(ns metabase.query-processor.middleware.process-userland-query
  (:require
   [java-time.api :as t]
   [metabase.events :as events]
   [metabase.models.query :as query]
   [metabase.models.query-execution
    :as query-execution
    :refer [QueryExecution]]
   [metabase.query-processor.util :as qp.util]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   #_{:clj-kondo/ignore [:discouraged-namespace]}
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)
(defn- add-running-time [{start-time-ms :start_time_millis, :as query-execution}]
  (-> query-execution
      (assoc :running_time (when start-time-ms
                             (- (System/currentTimeMillis) start-time-ms)))
      (dissoc :start_time_millis)))

+----------------------------------------------------------------------------------------------------------------+ | Save Query Execution | +----------------------------------------------------------------------------------------------------------------+

Save a QueryExecution and update the average execution time for the corresponding Query.

TODO - I'm not sure whether this should happen async as is currently the case, or should happen synchronously e.g. in the completing arity of the rf

Async seems like it makes sense from a performance standpoint, but should we have some sort of shared threadpool for other places where we would want to do async saves (such as results-metadata for Cards?)

(defn- save-query-execution!*
  [{query :json_query, query-hash :hash, running-time :running_time, context :context :as query-execution}]
  (when-not (:cache_hit query-execution)
    (query/save-query-and-update-average-execution-time! query query-hash running-time))
  (if-not context
    (log/warn (trs "Cannot save QueryExecution, missing :context"))
    (t2/insert! QueryExecution (dissoc query-execution :json_query))))

Save a QueryExecution row containing execution-info. Done asynchronously when a query is finished.

(defn- save-query-execution!
  [execution-info]
  (let [execution-info (add-running-time execution-info)]
    ;; 1. Asynchronously save QueryExecution, update query average execution time etc. using the Agent/pooledExecutor
    ;;    pool, which is a fixed pool of size `nthreads + 2`. This way we don't spin up a ton of threads doing unimportant
    ;;    background query execution saving (as `future` would do, which uses an unbounded thread pool by default)
    ;;
    ;; 2. This is on purpose! By *not* using `bound-fn` or `future`, any dynamic variables in play when the task is
    ;;    submitted, such as `db/*connection*`, won't be in play when the task is actually executed. That way we won't
    ;;    attempt to use closed DB connections
    (.submit clojure.lang.Agent/pooledExecutor ^Runnable (fn []
                                                           (log/trace "Saving QueryExecution info")
                                                           (try
                                                             (save-query-execution!* execution-info)
                                                             (catch Throwable e
                                                               (log/error e (trs "Error saving query execution info"))))))))
(defn- save-successful-query-execution! [cache-details is_sandboxed? query-execution result-rows]
  (let [qe-map (assoc query-execution
                      :cache_hit    (boolean (:cached cache-details))
                      :cache_hash   (:hash cache-details)
                      :result_rows  result-rows
                      :is_sandboxed (boolean is_sandboxed?))]
    (save-query-execution! qe-map)))
(defn- save-failed-query-execution! [query-execution message]
  (save-query-execution! (assoc query-execution :error (str message))))

+----------------------------------------------------------------------------------------------------------------+ | Middleware | +----------------------------------------------------------------------------------------------------------------+

(defn- success-response [{query-hash :hash, :as query-execution} {cache :cache/details :as result}]
  (merge
   (-> query-execution
       add-running-time
       (dissoc :error :hash :executor_id :action_id :is_sandboxed :card_id :dashboard_id :pulse_id :result_rows :native))
   (dissoc result :cache/details)
   {:cached                 (boolean (:cached cache))
    :status                 :completed
    :average_execution_time (when (:cached cache)
                              (query/average-execution-time-ms query-hash))}))
(defn- add-and-save-execution-info-xform! [execution-info rf]
  {:pre [(fn? rf)]}
  ;; previously we did nothing for cached results, now we have `cache_hit?` column
  (let [row-count (volatile! 0)]
    (fn execution-info-rf*
      ([]
       (rf))
      ([acc]
       ;; We don't actually have a guarantee that it's from a card just because it's userland
       (when (integer? (:card_id execution-info))
         (events/publish-event! :event/card-query {:user-id      (:executor_id execution-info)
                                                   :card-id      (:card_id execution-info)
                                                   :context      (:context execution-info)}))
       (save-successful-query-execution! (:cache/details acc) (get-in acc [:data :is_sandboxed]) execution-info @row-count)
       (rf (if (map? acc)
             (success-response execution-info acc)
             acc)))
      ([result row]
       (vswap! row-count inc)
       (rf result row)))))

Return the info for the QueryExecution entry for this query.

(defn- query-execution-info
  {:arglists '([query])}
  [{{:keys [executed-by query-hash context action-id card-id dashboard-id pulse-id]} :info
    database-id                                                                      :database
    query-type                                                                       :type
    :as                                                                              query}]
  {:pre [(instance? (Class/forName "[B") query-hash)]}
  {:database_id       database-id
   :executor_id       executed-by
   :action_id         action-id
   :card_id           card-id
   :dashboard_id      dashboard-id
   :pulse_id          pulse-id
   :context           context
   :hash              query-hash
   :native            (= (keyword query-type) :native)
   :json_query        (cond-> (dissoc query :info)
                        (empty? (:parameters query)) (dissoc :parameters))
   :started_at        (t/zoned-date-time)
   :running_time      0
   :result_rows       0
   :start_time_millis (System/currentTimeMillis)})

Do extra handling 'userland' queries (i.e. ones ran as a result of a user action, e.g. an API call, scheduled Pulse, etc.). This includes recording QueryExecution entries and returning the results in an FE-client-friendly format.

(defn process-userland-query
  [qp]
  (fn [query rff {:keys [raisef], :as context}]
    (let [query          (assoc-in query [:info :query-hash] (qp.util/query-hash query))
          execution-info (query-execution-info query)]
      (letfn [(rff* [metadata]
                (add-and-save-execution-info-xform! execution-info (rff metadata)))
              (raisef* [^Throwable e context]
                (save-failed-query-execution!
                  execution-info
                  (or
                    (some-> e (.getCause) (.getMessage))
                    (.getMessage e)))
                (raisef (ex-info (.getMessage e)
                          {:query-execution execution-info}
                          e)
                        context))]
        (try
          (qp query rff* (assoc context :raisef raisef*))
          (catch Throwable e
            (raisef* e context)))))))
 

SQL places restrictions when using a GROUP BY clause (MBQL :breakout) in combination with an ORDER BY clause (MBQL :order-by) -- columns that appear in the ORDER BY must appear in the GROUP BY. When we apply datetime or binning bucketing in a breakout, for example cast(x AS DATE) (:field :temporal-unit), we need to apply the same bucketing to instances of that Field in the order-by clause. In other words:

Bad:

SELECT count(*) FROM table GROUP BY CAST(x AS date) ORDER BY x ASC

(MBQL)

{:source-table 1 :breakout [[:field 1 {:temporal-unit :day}]] :order-by [[:asc [:field 1 nil]]]}

Good:

SELECT count(*) FROM table GROUP BY CAST(x AS date) ORDER BY CAST(x AS date) ASC

(MBQL)

{:source-table 1 :breakout [[:field 1 {:temporal-unit :day}]] :order-by [[:asc [:field 1 {:temporal-unit :day}]]]}

The frontend, on the rare occasion it generates a query that explicitly specifies an order-by clause, usually will generate one that directly corresponds to the bad example above. This middleware finds these cases and rewrites the query to look like the good example.

(ns metabase.query-processor.middleware.reconcile-breakout-and-order-by-bucketing
  (:require
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.util.malli :as mu]))
(mu/defn ^:private reconcile-bucketing :- mbql.s/Query
  [{{breakouts :breakout} :query, :as query} :- :map]
  ;; Look for bucketed fields in the `breakout` clause and build a map of unbucketed reference -> bucketed reference,
  ;; like:
  ;;
  ;;    {[:field 1 nil] [:field 1 {:temporal-unit :day}]}
  ;;
  ;; In causes where a Field is broken out more than once, prefer the bucketing used by the first breakout; accomplish
  ;; this by reversing the sequence of matches below, meaning the first match will get merged into the map last,
  ;; overwriting later matches
  (let [unbucketed-ref->bucketed-ref (into {} (reverse (mbql.u/match breakouts
                                                         [:field id-or-name opts]
                                                         [[:field id-or-name (not-empty (dissoc opts :temporal-unit :binning))]
                                                          &match])))]
    ;; rewrite order-by clauses as needed...
    (-> (mbql.u/replace-in query [:query :order-by]
          ;; if order by is already bucketed, nothing to do
          [:field id-or-name (_ :guard (some-fn :temporal-unit :binning))]
          &match
          ;; if we run into a field that wasn't matched by the last pattern, see if there's an unbucketed reference
          ;; -> bucketed reference from earlier
          :field
          (if-let [bucketed-reference (unbucketed-ref->bucketed-ref &match)]
            ;; if there is, replace it with the bucketed reference
            bucketed-reference
            ;; if there's not, again nothing to do.
            &match))
        ;; now remove any duplicate order-by clauses we may have introduced, as those are illegal in MBQL 2000
        (update-in [:query :order-by] (comp vec distinct)))))

Replace any unbucketed :field clauses (anything without :temporal-unit or :bucketing options) in the order-by clause with corresponding bucketed clauses used for the same Field in the breakout clause.

{:query {:breakout [[:field 1 {:temporal-unit :day}]] :order-by [[:asc [:field 1 nil]]]}} -> {:query {:breakout [[:field 1 {:temporal-unit :day}]] :order-by [[:asc [:field 1 {:temporal-unit :day}]]]}}

(defn reconcile-breakout-and-order-by-bucketing
  [{{breakouts :breakout, order-bys :order-by} :query, :as query}]
  (if (or
       ;; if there's no breakouts bucketed by a datetime-field or binning-strategy...
       (empty? (mbql.u/match breakouts [:field _ (_ :guard (some-fn :temporal-unit :binning))]))
       ;; or if there's no order-bys that are *not* bucketed...
       (empty? (mbql.u/match order-bys
                 [:field _ (_ :guard (some-fn :temporal-unit :binning))]
                 nil
                 :field
                 &match)))
    ;; return query as is
    query
    ;; otherwise, time to bucket
    (reconcile-bucketing query)))
 
(ns metabase.query-processor.middleware.resolve-database-and-driver
  (:require
   [metabase.driver :as driver]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.lib.util :as lib.util]
   [metabase.models.setting :as setting]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.store :as qp.store]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu]
   #_{:clj-kondo/ignore [:discouraged-namespace]}
   [toucan2.core :as t2]))
(declare resolve-database-id)
(defn- bootstrap-metadata-provider []
  (if (qp.store/initialized?)
    (qp.store/metadata-provider)
    (reify lib.metadata.protocols/MetadataProvider
      (card [_this card-id]
        (t2/select-one-fn
         (fn [card]
           {:lib/type    :metadata/card
            :database-id (:database_id card)})
         [:model/Card :database_id]
         :id card-id)))))
(mu/defn ^:private resolve-database-id-for-source-card :- ::lib.schema.id/database
  [source-card-id :- ::lib.schema.id/card]
  (let [card (or (lib.metadata.protocols/card (bootstrap-metadata-provider) source-card-id)
                 (throw (ex-info (tru "Card {0} does not exist." source-card-id)
                                 {:card-id source-card-id, :type qp.error-type/invalid-query, :status-code 404})))]
    (:database-id card)))
(mu/defn resolve-database-id :- ::lib.schema.id/database
  "Return the *actual* `:database` ID for a query, even if it is using
  the [[metabase.lib.schema.id/saved-questions-virtual-database-id]]."
  [{database-id :database, :as query}]
  (or
   (when (pos-int? database-id)
     database-id)
   ;; MLv2 query
   (when (= (:lib/type query) :mbql/query)
     (when-let [source-card-id (lib.util/source-card-id query)]
       (resolve-database-id-for-source-card source-card-id)))
   ;; legacy query
   (when (= (:type query) :query)
     (let [most-deeply-nested-source-query (last (take-while some? (iterate :source-query (:query query))))]
       (when-let [card-id (lib.util/legacy-string-table-id->card-id (:source-table most-deeply-nested-source-query))]
         (resolve-database-id-for-source-card card-id))))))

If query :database ID is the [[metabase.lib.schema.id/saved-questions-virtual-database-id]], resolve it to the actual Database ID. We need to do this before initializing the QP Store/metadata provider.

(defn resolve-database
  [qp]
  (fn [query rff context]
    (let [query' (assoc query :database (resolve-database-id query))]
      (qp query' rff context))))

Middleware that resolves the Database referenced by the query under that :database key and stores it in the QP Store.

(defn resolve-driver-and-database-local-values
  [qp]
  (fn [query rff context]
    (let [{:keys [settings], driver :engine} (lib.metadata/database (qp.store/metadata-provider))]
      ;; make sure the driver is initialized.
      (try
        (driver/the-initialized-driver driver)
        (catch Throwable e
          (throw (ex-info (tru "Unable to resolve driver for query")
                          {:type qp.error-type/invalid-query}
                          e))))
      (binding [setting/*database-local-values* settings]
        (driver/with-driver driver
          (qp query rff context))))))
 

Middleware that resolves the Fields referenced by a query.

(ns metabase.query-processor.middleware.resolve-fields
  (:require
   [metabase.lib.metadata :as lib.metadata]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.store :as qp.store]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]))
(defn- resolve-fields-with-ids!
  [field-ids]
  (qp.store/bulk-metadata :metadata/column field-ids)
  (when-let [parent-ids (not-empty
                         (into []
                               (comp (map (fn [field-id]
                                            (:parent-id (lib.metadata/field (qp.store/metadata-provider) field-id))))
                                     (filter some?))
                               field-ids))]
    (recur parent-ids)))

Resolve all field referenced in the query, and store them in the QP Store.

(defn resolve-fields
  [query]
  (let [ids (into (set (mbql.u/match (:query query) [:field (id :guard integer?) _] id))
                  (comp cat (keep :id))
                  (mbql.u/match (:query query) {:source-metadata source-metadata} source-metadata))]
    (try
      (u/prog1 query
        (resolve-fields-with-ids! ids))
      (catch Throwable e
        (throw (ex-info (tru "Error resolving Fields in query: {0}" (ex-message e))
                        {:field-ids ids
                         :query     query
                         :type      qp.error-type/qp}
                        e))))))
 

Middleware that adds :join-alias info to :field clauses where needed.

(ns metabase.query-processor.middleware.resolve-joined-fields
  (:require
   [clojure.data :as data]
   [malli.core :as mc]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.store :as qp.store]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]))
(def ^:private InnerQuery
  [:and
   :map
   [:fn
    {:error/message "Must have :source-table, :source-query, or :joins"}
    (some-fn :source-table :source-query :joins)]
   [:fn
    {:error/message "Should not have :condition"}
    (complement :condition)]])
(mu/defn ^:private add-join-alias
  [{:keys [table-id], field-id :id, :as field}
   {:keys [joins source-query]}   :- InnerQuery
   [_ id-or-name opts :as clause] :- mbql.s/field:id]
  (let [candidate-tables (filter (fn [join]
                                   (when-let [source-table-id (mbql.u/join->source-table-id join)]
                                     (= source-table-id table-id)))
                                 joins)]
    (case (count candidate-tables)
      1
      [:field
       (if (string? id-or-name) field-id id-or-name)
       (assoc opts :join-alias (-> candidate-tables first :alias))]
      ;; if there are no candidates, try looking for one in the source query if we have a source query. Otherwise we
      ;; can't do anything, so return field as-is
      0
      (if (empty? source-query)
        clause
        (recur field source-query clause))
      ;; if there are multiple candidates, try ignoring the implicit ones
      ;; presence of `:fk-field-id` indicates that the join was implicit, as the result of an `fk->` form
      (let [explicit-joins (remove :fk-field-id joins)]
        (if (= (count explicit-joins) 1)
          (recur field {:joins explicit-joins} clause)
          (let [{:keys [_id name]} (lib.metadata/table (qp.store/metadata-provider) table-id)]
            (throw (ex-info (tru "Cannot resolve joined field due to ambiguous joins: table {0} (ID {1}) joined multiple times. You need to specify an explicit `:join-alias` in the field reference."
                                 name field-id)
                            {:field      field
                             :error      qp.error-type/invalid-query
                             :joins      joins
                             :candidates candidate-tables}))))))))

Get the ID of the 'primary' table towards which this query is pointing at: either the :source-table or indirectly thru some number of :source-querys.

(defn- primary-source-table-id
  [{:keys [source-table source-query]}]
  (or source-table
      (when source-query
        (recur source-query))))

Wrap Field clauses in a form that has :joins.

(mu/defn ^:private add-join-alias-to-fields-if-needed*
  [{:keys [source-query joins], :as form} :- InnerQuery]
  ;; don't replace stuff in child `:join` or `:source-query` forms -- remove these from `form` when we call `replace`
  (let [source-table (primary-source-table-id form)
        form         (mbql.u/replace (dissoc form :joins :source-query)
                       ;; don't add `:join-alias` to anything that already has one
                       [:field _ (_ :guard :join-alias)]
                       &match
                       ;; otherwise for any other `:field` whose table isn't the source Table, attempt to wrap it.
                       [:field
                        (field-id :guard (every-pred integer?
                                                     (fn [field-id]
                                                       (not= (:table-id (lib.metadata/field (qp.store/metadata-provider) field-id))
                                                             source-table))))
                        _]
                       (add-join-alias (lib.metadata/field (qp.store/metadata-provider) field-id) form &match))
        ;; add :joins and :source-query back which we removed above.
        form (cond-> form
               (seq joins)  (assoc :joins joins)
               source-query (assoc :source-query source-query))]
    ;; now deduplicate :fields clauses
    (mbql.u/replace form
      (m :guard (every-pred map? :fields))
      (update m :fields distinct))))
(defn- add-join-alias-to-fields-if-needed
  [form]
  ;; look for any form that has `:joins`, then wrap stuff as needed
  (mbql.u/replace form
    (m :guard (every-pred map? (mc/validator InnerQuery)))
    (cond-> m
      ;; recursively wrap stuff in nested joins or source queries in the form
      (:source-query m)
      (update :source-query add-join-alias-to-fields-if-needed)
      (seq (:joins m))
      (update :joins (partial mapv add-join-alias-to-fields-if-needed))
      ;; now call `add-join-alias-to-fields-if-needed*` which actually does the wrapping.
      true
      add-join-alias-to-fields-if-needed*)))

Add :join-alias info to :field clauses where needed.

(defn resolve-joined-fields
  [query]
  (let [query' (add-join-alias-to-fields-if-needed query)]
    (when-not (= query query')
      (let [[before after] (data/diff query query')]
        (log/tracef "Inferred :field :join-alias info: %s -> %s" (u/pprint-to-str 'yellow before) (u/pprint-to-str 'cyan after))))
    query'))
 

Middleware that fetches tables that will need to be joined, referred to by :field clauses with :source-field options, and adds information to the query about what joins should be done and how they should be performed.

(ns metabase.query-processor.middleware.resolve-joins
  (:refer-clojure :exclude [alias])
  (:require
   [medley.core :as m]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.middleware.add-implicit-clauses
    :as qp.add-implicit-clauses]
   [metabase.query-processor.store :as qp.store]
   [metabase.query-processor.util.add-alias-info :as add]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu]))

Schema for a non-empty sequence of Joins. Unlike [[mbql.s/Joins]], this does not enforce the constraint that all join aliases be unique; that is handled by the [[metabase.query-processor.middleware.escape-join-aliases]] middleware.

(def ^:private Joins
  [:sequential {:min 1} mbql.s/Join])

Schema for the parts of the query we're modifying. For use in the various intermediate transformations in the middleware.

(def ^:private UnresolvedMBQLQuery
  [:map
   [:joins [:sequential mbql.s/Join]]
   [:fields {:optional true} mbql.s/Fields]])

Schema for the final results of this middleware.

(def ^:private ResolvedMBQLQuery
  [:and
   UnresolvedMBQLQuery
   [:fn
    {:error/message "Valid MBQL query where `:joins` `:fields` is sequence of Fields or removed"}
    (fn [{:keys [joins]}]
      (every?
       (fn [{:keys [fields]}]
         (or
          (empty? fields)
          (sequential? fields)))
       joins))]])

+----------------------------------------------------------------------------------------------------------------+ | Resolving Tables & Fields / Saving in QP Store | +----------------------------------------------------------------------------------------------------------------+

(mu/defn ^:private resolve-fields! :- :nil
  [joins :- Joins]
  (qp.store/bulk-metadata :metadata/column (mbql.u/match joins [:field (id :guard integer?) _] id))
  nil)
(mu/defn ^:private resolve-tables! :- :nil
  "Add Tables referenced by `:joins` to the Query Processor Store. This is only really needed for implicit joins,
  because their Table references are added after `resolve-source-tables` runs."
  [joins :- Joins]
  (qp.store/bulk-metadata :metadata/table (remove nil? (map :source-table joins)))
  nil)

+----------------------------------------------------------------------------------------------------------------+ | :Joins Transformations | +----------------------------------------------------------------------------------------------------------------+

(def ^:private default-join-alias "__join")
(mu/defn ^:private merge-defaults :- mbql.s/Join
  [join]
  (merge {:alias default-join-alias, :strategy :left-join} join))
(defn- source-metadata->fields [{:keys [alias], :as join} source-metadata]
  (when-not (seq source-metadata)
    (throw (ex-info (tru "Cannot use :fields :all in join against source query unless it has :source-metadata.")
                    {:join join})))
  (let [duplicate-ids (into #{}
                            (keep (fn [[item freq]]
                                    (when (> freq 1)
                                      item)))
                            (frequencies (map :id source-metadata)))]
    (for [{field-name :name, base-type :base_type, field-id :id} source-metadata]
      (if (and field-id (not (contains? duplicate-ids field-id)))
        ;; field-id is a unique reference, use it
        [:field field-id   {:join-alias alias}]
        [:field field-name {:base-type base-type, :join-alias alias}]))))
(mu/defn ^:private handle-all-fields :- mbql.s/Join
  "Replace `:fields :all` in a join with an appropriate list of Fields."
  [{:keys [source-table source-query alias fields source-metadata], :as join} :- mbql.s/Join]
  (merge
   join
   (when (= fields :all)
     {:fields (if source-query
                (source-metadata->fields join source-metadata)
                (for [[_ id-or-name opts] (qp.add-implicit-clauses/sorted-implicit-fields-for-table source-table)]
                  [:field id-or-name (assoc opts :join-alias alias)]))})))
(mu/defn ^:private resolve-references :- Joins
  [joins :- Joins]
  (resolve-tables! joins)
  (u/prog1 (into []
                 (comp (map merge-defaults)
                       (map handle-all-fields))
                 joins)
    (resolve-fields! <>)))
(declare resolve-joins-in-mbql-query-all-levels)
(mu/defn ^:private resolve-join-source-queries :- Joins
  [joins :- Joins]
  (for [{:keys [source-query], :as join} joins]
    (cond-> join
      source-query resolve-joins-in-mbql-query-all-levels)))

+----------------------------------------------------------------------------------------------------------------+ | MBQL-Query Transformations | +----------------------------------------------------------------------------------------------------------------+

Return a flattened list of all :fields referenced in joins.

(defn- joins->fields
  [joins]
  (into []
        (comp (map :fields)
              (filter sequential?)
              cat)
        joins))

Should we append the :fields from :joins to the parent-level query's :fields? True unless the parent-level query has breakouts or aggregations.

(defn- should-add-join-fields?
  [{breakouts :breakout, aggregations :aggregation}]
  (every? empty? [aggregations breakouts]))
(defn- append-join-fields [fields join-fields]
  (into []
        (comp cat
              (m/distinct-by (fn [clause]
                               (-> clause
                                   ;; remove namespaced options and other things that are definitely irrelevant
                                   add/normalize-clause
                                   ;; we shouldn't consider different type info to mean two Fields are different even if
                                   ;; everything else is the same. So give everything `:base-type` of `:type/*` (it will
                                   ;; complain if we remove `:base-type` entirely from fields with a string name)
                                   (mbql.u/update-field-options (fn [opts]
                                                                  (-> opts
                                                                      (assoc :base-type :type/*)
                                                                      (dissoc :effective-type))))))))
        [fields join-fields]))

Add the fields from join :fields, if any, to the parent-level :fields.

(defn append-join-fields-to-fields
  [inner-query join-fields]
  (cond-> inner-query
    (seq join-fields) (update :fields append-join-fields join-fields)))
(mu/defn ^:private merge-joins-fields :- UnresolvedMBQLQuery
  "Append the `:fields` from `:joins` into their parent level as appropriate so joined columns appear in the final
  query results, and remove the `:fields` entry for all joins.
  If the parent-level query has breakouts and/or aggregations, this function won't append the joins fields to the
  parent level, because we should only be returning the ones from the ags and breakouts in the final results."
  [{:keys [joins], :as inner-query} :- UnresolvedMBQLQuery]
  (let [join-fields (when (should-add-join-fields? inner-query)
                      (joins->fields joins))
        ;; remove remaining keyword `:fields` like `:none` from joins
        inner-query (update inner-query :joins (fn [joins]
                                                 (mapv (fn [{:keys [fields], :as join}]
                                                         (cond-> join
                                                           (keyword? fields) (dissoc :fields)))
                                                       joins)))]
    (append-join-fields-to-fields inner-query join-fields)))
(mu/defn ^:private resolve-joins-in-mbql-query :- ResolvedMBQLQuery
  [query :- mbql.s/MBQLQuery]
  (-> query
      (update :joins (comp resolve-join-source-queries resolve-references))
      merge-joins-fields))

+----------------------------------------------------------------------------------------------------------------+ | Middleware & Boring Recursive Application Stuff | +----------------------------------------------------------------------------------------------------------------+

(defn- resolve-joins-in-mbql-query-all-levels
  [{:keys [joins source-query], :as query}]
  (cond-> query
    (seq joins)  resolve-joins-in-mbql-query
    source-query (update :source-query resolve-joins-in-mbql-query-all-levels)))

Add any Tables and Fields referenced by the :joins clause to the QP store.

(defn resolve-joins
  [{inner-query :query, :as outer-query}]
  (cond-> outer-query
    inner-query (update :query resolve-joins-in-mbql-query-all-levels)))
 
(ns metabase.query-processor.middleware.resolve-referenced
  (:require
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.query-processor.middleware.fetch-source-query
    :as fetch-source-query]
   [metabase.query-processor.middleware.resolve-fields
    :as qp.resolve-fields]
   [metabase.query-processor.middleware.resolve-source-table
    :as qp.resolve-source-table]
   [metabase.query-processor.store :as qp.store]
   [metabase.query-processor.util.tag-referenced-cards
    :as qp.u.tag-referenced-cards]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu]
   [weavejester.dependency :as dep])
  (:import
   (clojure.lang ExceptionInfo)))
(defn- check-query-database-id=
  [query database-id]
  (when-not (= (:database query) database-id)
    (throw (ex-info (tru "Referenced query is from a different database")
                    {:referenced-query     query
                     :expected-database-id database-id}))))
(mu/defn ^:private resolve-referenced-card-resources* :- :map
  [query]
  (doseq [referenced-card (qp.u.tag-referenced-cards/tags-referenced-cards query)
          :let            [referenced-query (:dataset-query referenced-card)
                           resolved-query (fetch-source-query/resolve-card-id-source-tables* referenced-query)]]
    (check-query-database-id= referenced-query (:database query))
    (qp.resolve-source-table/resolve-source-tables resolved-query)
    (qp.resolve-fields/resolve-fields resolved-query))
  query)
(defn- card-subquery-graph
  [graph card-id]
  (let [card-query (:dataset-query (lib.metadata.protocols/card (qp.store/metadata-provider) card-id))]
    (reduce
     (fn [g sub-card-id]
       (card-subquery-graph (dep/depend g card-id sub-card-id)
                            sub-card-id))
     graph
     (qp.u.tag-referenced-cards/query->tag-card-ids card-query))))
(mu/defn ^:private circular-ref-error :- ::lib.schema.common/non-blank-string
  [from-card :- ::lib.schema.id/card
   to-card   :- ::lib.schema.id/card]
  (let [cards               (into {}
                                  (map (juxt :id :name))
                                  (qp.store/bulk-metadata :metadata/card #{from-card to-card}))
        from-name           (get cards from-card)
        to-name             (get cards to-card)]
    (str
     (tru "This query has circular referencing sub-queries. ")
     (tru "These questions seem to be part of the problem: \"{0}\" and \"{1}\"." from-name to-name))))
(defn- check-for-circular-references
  [query]
  (try
   ;; `card-subquery-graph` will throw if there are circular references
   (reduce card-subquery-graph (dep/graph) (qp.u.tag-referenced-cards/query->tag-card-ids query))
   (catch ExceptionInfo e
     (let [{:keys [reason node dependency]} (ex-data e)]
       (if (= reason :weavejester.dependency/circular-dependency)
         (throw (ex-info (circular-ref-error node dependency) {:original-exception e}))
         (throw e)))))
  query)

Resolves tables and fields referenced in card query template tags.

(defn resolve-referenced-card-resources
  [query]
  (-> query check-for-circular-references resolve-referenced-card-resources*))
 

Fetches Tables corresponding to any :source-table IDs anywhere in the query.

(ns metabase.query-processor.middleware.resolve-source-table
  (:require
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.store :as qp.store]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]))

Sanity check: Any non-positive-integer value of :source-table should have been resolved by now. The resolve-card-id-source-tables middleware should have already taken care of it.

(defn- check-all-source-table-ids-are-valid
  [query]
  (mbql.u/match-one query
    (m :guard (every-pred map? :source-table #(string? (:source-table %))))
    (throw
      (ex-info
        (tru "Invalid :source-table ''{0}'': should be resolved to a Table ID by now." (:source-table m))
        {:form m}))))
(mu/defn ^:private query->source-table-ids :- [:maybe [:set {:min 1} ms/PositiveInt]]
  "Fetch a set of all `:source-table` IDs anywhere in `query`."
  [query]
  (some->
   (mbql.u/match query
     (m :guard (every-pred map? :source-table #(integer? (:source-table %))))
     ;; Recursively look in the rest of `m` for any other source tables
     (cons
      (:source-table m)
      (filter some? (recur (dissoc m :source-table)))))
   flatten
   set))

Middleware that will take any :source-tables (integer IDs) anywhere in the query and fetch and save the corresponding Table in the Query Processor Store.

(defn resolve-source-tables
  [query]
  (check-all-source-table-ids-are-valid query)
  (qp.store/bulk-metadata :metadata/table (query->source-table-ids query))
  query)
 

Middleware that stores metadata about results column types after running a query for a Card, and returns that metadata (which can be passed back to the backend when saving a Card) as well as a checksum in the API response.

(ns metabase.query-processor.middleware.results-metadata
  (:require
   [metabase.driver :as driver]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.query-processor.reducible :as qp.reducible]
   [metabase.query-processor.store :as qp.store]
   [metabase.sync.analyze.query-results :as qr]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   #_{:clj-kondo/ignore [:discouraged-namespace]}
   [toucan2.core :as t2]))

+----------------------------------------------------------------------------------------------------------------+ | Middleware | +----------------------------------------------------------------------------------------------------------------+

TODO -

  1. Is there some way we could avoid doing this every single time a Card is ran? Perhaps by passing the current Card metadata as part of the query context so we can compare for changes

  2. Consider whether the actual save operation should be async as with [[metabase.query-processor.middleware.process-userland-query]]

(defn- record-metadata! [{{:keys [card-id]} :info, {:keys [source-card-id]} :query} metadata]
  (try
    ;; At the very least we can skip the Extra DB call to update this Card's metadata results
    ;; if its DB doesn't support nested queries in the first place
    (when (and metadata
               driver/*driver*
               (driver/database-supports? driver/*driver* :nested-queries (lib.metadata/database (qp.store/metadata-provider)))
               card-id
               (not source-card-id))
      (t2/update! :model/Card card-id {:result_metadata metadata}))
    ;; if for some reason we weren't able to record results metadata for this query then just proceed as normal
    ;; rather than failing the entire query
    (catch Throwable e
      (log/error e (tru "Error recording results metadata for query")))))

Because insights are generated by reducing functions, they start working before the entire query metadata is in its final form. Some columns come back without type information, and thus get an initial base type of :type/* (unknown type); in this case, the annotate middleware scans the first few values and infers a base type, adding that information to the column metadata in the final result.

This function merges inferred column base types added by annotate into the metadata generated by insights.

(defn- merge-final-column-metadata
  [final-col-metadata insights-col-metadata]
  ;; the two metadatas will both be in order that matches the column order of the results
  (mapv
   (fn [{final-base-type :base_type, :as final-col} {our-base-type :base_type, :as insights-col}]
     (merge
      (select-keys final-col [:id :description :display_name :semantic_type :fk_target_field_id
                              :settings :field_ref :name :base_type :effective_type
                              :coercion_strategy :visibility_type])
      insights-col
      (when (= our-base-type :type/*)
        {:base_type final-base-type})))
   final-col-metadata
   insights-col-metadata))
(defn- insights-xform [orig-metadata record! rf]
  (qp.reducible/combine-additional-reducing-fns
   rf
   [(qr/insights-rf orig-metadata)]
   (fn combine [result {:keys [metadata insights]}]
     (let [metadata (merge-final-column-metadata (-> result :data :cols) metadata)]
       (record! metadata)
       (rf (cond-> result
             (map? result)
             (update :data
                     assoc
                     :results_metadata {:columns metadata}
                     :insights         insights)))))))

Post-processing middleware that records metadata about the columns returned when running the query.

(defn record-and-return-metadata!
  [{{:keys [skip-results-metadata?]} :middleware, :as query} rff]
  (if skip-results-metadata?
    rff
    (let [record! (partial record-metadata! query)]
      (fn record-and-return-metadata!-rff* [metadata]
        (insights-xform metadata record! (rff metadata))))))
 
(ns metabase.query-processor.middleware.splice-params-in-response
  (:require
   [metabase.driver :as driver]))
(defn- splice-params-in-metadata [{{:keys [params]} :native_form, :as metadata}]
  ;; no need to i18n this since this message is something only developers who break the QP by changing middleware
  ;; order will see
  (assert driver/*driver*
    "Middleware order error: splice-params-in-response must run *after* driver is resolved.")
  (if (empty? params)
    metadata
    (update metadata :native_form (partial driver/splice-parameters-into-native-query driver/*driver*))))

Middleware that manipulates query response. Splice prepared statement (or equivalent) parameters directly into the native query returned as part of successful query results. (This :native_form is ultimately what powers the 'Convert this Question to SQL' feature in the Query Processor.) E.g.:

{:data {:native_form {:query "SELECT * FROM birds WHERE name = ?", :params ["Reggae"]}}}

-> splice params in response ->

{:data {:native_form {:query "SELECT * FROM birds WHERE name = 'Reggae'"}}}

Note that this step happens after a query is executed; we do not want to execute the query with literals spliced in, so as to avoid SQL injection attacks.

This feature is ultimately powered by the metabase.driver/splice-parameters-into-native-query method. For native queries without :params (which will be all of them for drivers that don't support the equivalent of prepared statement parameters, like Druid), this middleware does nothing.

(defn splice-params-in-response
  [_query rff]
  (fn splice-params-in-response-rff* [metadata]
    (rff (splice-params-in-metadata metadata))))
 

The store middleware is responsible for initializing a fresh QP Store, which caches resolved objects for the duration of a query execution. See metabase.query-processor.store for more details.

(ns metabase.query-processor.middleware.store
  (:require
   [metabase.query-processor.store :as qp.store]))

Initialize the QP Store (resolved objects cache) for this query execution.

(defn initialize-store
  [qp]
  (fn [query rff context]
    (assert (pos-int? (:database query))
            "Query :database ID should have resolved by now by the metabase.query-processor.middleware.resolve-database-and-driver middleware")
    (qp.store/with-metadata-provider (:database query)
      (qp query rff context))))
 
(ns metabase.query-processor.middleware.upgrade-field-literals
  (:require
   [clojure.walk :as walk]
   [medley.core :as m]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.middleware.resolve-fields
    :as qp.resolve-fields]
   [metabase.query-processor.store :as qp.store]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]))

Log only one warning per QP run (regardless of message).

(defn- warn-once
  [message]
  ;; Make sure QP store is available since we use caching below (it may not be in some unit tests)
  (when (qp.store/initialized?)
    ;; by caching the block below, the warning will only get trigger a maximum of one time per query run. We don't need
    ;; to blow up the logs with a million warnings.
    (qp.store/cached ::bad-clause-warning
      (log/warn (u/colorize :red message)))))

Check if the field-id and the (possibly missing) join-alias of field-clause result in an unambiguous reference to one of the columns The join-alias of columns is taken from their field_ref property.

(defn- unique-reference?
  [field-clause columns]
  (let [[_ field-id {:keys [join-alias]}] field-clause
        matches-by-id (filter #(= (:id %) field-id) columns)]
    (or (nil? (next matches-by-id))
        (->> matches-by-id (filter #(= (get-in % [:field-ref 2 :join-alias]) join-alias)) count (= 1)))))
(defn- fix-clause [{:keys [source-aliases field-name->field]} [_ field-name options :as field-clause]]
  ;; attempt to find a corresponding Field ref from the source metadata.
  (let [field-ref (:field_ref (get field-name->field field-name))
        ;; the map contains duplicate columns to support lowercase lookup
        columns (set (vals field-name->field))]
    (cond
      field-ref
      (mbql.u/match-one field-ref
        ;; If the matching Field ref is an integer `:field` clause then replace it with the corrected clause.
        [:field (id :guard integer?) new-options]
        (let [new-clause [:field id (merge new-options (dissoc options :base-type))]]
          (if (unique-reference? new-clause columns)
            new-clause
            (u/prog1 field-clause
              (warn-once
               (format "Warning: upgrading field literal %s would result in an ambiguous reference. Not upgrading."
                       (pr-str field-clause))))))
        ;; Otherwise the Field clause in the source query uses a string Field name as well, but that name differs from
        ;; the one in `source-aliases`. Will this work? Not sure whether or not we need to log something about this.
        [:field (field-name :guard string?) new-options]
        (u/prog1 [:field field-name (merge new-options (dissoc options :base-type))]
          (warn-once
           (trs "Warning: clause {0} does not match a column in the source query. Attempting to correct this to {1}"
                (pr-str field-clause)
                (pr-str <>)))))
      ;; If the field name exists in the ACTUAL names returned by the source query then we're g2g and don't need to
      ;; complain about anything.
      (contains? source-aliases field-name)
      field-clause
      ;; no matching Field ref means there's no column with this name in the source query. The query may not work, so
      ;; log a warning about it. This query is probably not going to work so we should let everyone know why.
      :else
      (do
        (warn-once
         (trs "Warning: clause {0} refers to a Field that may not be present in the source query. Query may not work as expected. Found: {1}"
              (pr-str field-clause) (pr-str (or (not-empty source-aliases)
                                                (set (keys field-name->field))))))
        field-clause))))
(defn- upgrade-field-literals-one-level [{:keys [source-metadata], :as inner-query}]
  (let [source-aliases    (into #{} (keep :source_alias) source-metadata)
        field-name->field (merge (m/index-by :name source-metadata)
                                 (m/index-by (comp u/lower-case-en :name) source-metadata))]
    (mbql.u/replace inner-query
      ;; don't upgrade anything inside `source-query` or `source-metadata`.
      (_ :guard (constantly (some (set &parents) [:source-query :source-metadata])))
      &match
      ;; look for `field` clauses that use a string name that doesn't appear in `source-aliases` (the ACTUAL names that
      ;; are returned by the source query)
      [:field (field-name :guard (every-pred string? (complement source-aliases))) options]
      (or (fix-clause {:inner-query inner-query, :source-aliases source-aliases, :field-name->field field-name->field}
                      &match)
          &match))))

Look for usage of :field (name) forms where field (ID) would have been the correct thing to use, and fix it, so the resulting query doesn't end up being broken.

(defn upgrade-field-literals
  [query]
  (-> (walk/postwalk
       (fn [form]
         ;; find maps that have `source-query` and `source-metadata`, but whose source query is an MBQL source query
         ;; rather than an native one
         (if (and (map? form)
                  (:source-query form)
                  (seq (:source-metadata form))
                  ;; we probably shouldn't upgrade things at all if we have a source MBQL query whose source is a native
                  ;; query at ANY level, since `[:field <name>]` might mean `source.<name>` or it might mean
                  ;; `some_join.<name>`. But we'll probably break more things than we fix if turn off this middleware in
                  ;; that case. See #19757 for more info
                  (not (get-in form [:source-query :native])))
           (upgrade-field-literals-one-level form)
           form))
       (qp.resolve-fields/resolve-fields query))
      qp.resolve-fields/resolve-fields))
 

Middleware for checking that a normalized query is valid.

(ns metabase.query-processor.middleware.validate
  (:require
   [metabase.mbql.schema :as mbql.s]))

Middleware that validates a query immediately after normalization.

(defn validate-query
  [query]
  (mbql.s/validate-query query)
  query)
 
(ns metabase.query-processor.middleware.validate-temporal-bucketing
  (:require
   [clojure.set :as set]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.store :as qp.store]
   [metabase.util.i18n :refer [tru]]))
(def ^:private valid-date-units
  #{:default :day :day-of-week :day-of-month :day-of-year
    :week :week-of-year :month :month-of-year :quarter :quarter-of-year :year})
(def ^:private valid-time-units
  #{:default :millisecond :second :minute :minute-of-hour :hour :hour-of-day})
(def ^:private valid-datetime-units (set/union valid-date-units valid-time-units))

TODO -- this should be changed to :effective-type once we finish the metadata changes.

(defmulti ^:private valid-units-for-base-type
  {:arglists '([base-type])}
  keyword)

for stuff like UNIX timestamps -- skip validation for now. (UNIX timestamp should be bucketable with any unit anyway). Once :effective-type is in place, we can actually check those Fields here.

(defmethod valid-units-for-base-type :type/*        [_] valid-datetime-units)
(defmethod valid-units-for-base-type :type/Date     [_] valid-date-units)
(defmethod valid-units-for-base-type :type/Time     [_] valid-time-units)
(defmethod valid-units-for-base-type :type/DateTime [_] valid-datetime-units)

Make sure temporal bucketing of Fields (i.e., :datetime-field clauses) in this query is valid given the combination of Field base-type and unit. For example, you should not be allowed to bucket a :type/Date Field by :minute.

(defn validate-temporal-bucketing
  [query]
  (doseq [[_ id-or-name {:keys [temporal-unit base-type]} :as clause] (mbql.u/match (:query query) [:field _ (_ :guard :temporal-unit)])]
    (let [base-type (if (integer? id-or-name)
                      (:base-type (lib.metadata/field (qp.store/metadata-provider) id-or-name))
                      base-type)
          valid-units (valid-units-for-base-type base-type)]
      (when-not (valid-units temporal-unit)
        (throw (ex-info (tru "Unsupported temporal bucketing: You can''t bucket a {0} Field by {1}."
                             base-type temporal-unit)
                        {:type        qp.error-type/invalid-query
                         :field       clause
                         :base-type   base-type
                         :unit        temporal-unit
                         :valid-units valid-units})))))
  query)
 
(ns metabase.query-processor.middleware.visualization-settings
  (:require
   [medley.core :as m]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.public-settings :as public-settings]
   [metabase.query-processor.store :as qp.store]
   [metabase.shared.models.visualization-settings :as mb.viz]))
(defn- normalize-field-settings
  [id settings]
  (let [db-form   {(mb.viz/norm->db-column-ref {::mb.viz/field-id id}) settings}
        norm-form (mb.viz/db->norm-column-settings db-form)]
    (get norm-form {::mb.viz/field-id id})))

For each field, fetch its settings from the QP store, convert the settings into the normalized form for visualization settings, and then merge in the card-level column settings.

(defn- update-card-viz-settings
  [column-viz-settings field-ids]
  ;; Retrieve field-level settings
  (let [field-id->settings      (reduce
                                  (fn [m field-id]
                                    (let [field-settings      (:settings (lib.metadata/field (qp.store/metadata-provider) field-id))
                                          norm-field-settings (normalize-field-settings field-id field-settings)]
                                      (cond-> m
                                        (seq norm-field-settings)
                                        (assoc field-id norm-field-settings))))
                                  {}
                                  field-ids)
        ;; For each column viz setting, if there is a match on the field settings, merge it in,
        ;; with the column viz settings being the default in the event of conflicts.
        merged-settings         (reduce-kv
                                  (fn [coll {field-id ::mb.viz/field-id :as k} column-viz-setting]
                                    (assoc coll k (merge (get field-id->settings field-id {}) column-viz-setting)))
                                  {}
                                  column-viz-settings)
        ;; The field-ids that are in the merged settings
        viz-field-ids           (set (map ::mb.viz/field-id (keys merged-settings)))
        ;; Keep any field settings that aren't in the merged settings and have settings
        distinct-field-settings (update-keys
                                  (remove (comp viz-field-ids first) field-id->settings)
                                  (fn [k] {::mb.viz/field-id k}))]
    (merge merged-settings distinct-field-settings)))

Pull viz settings from either the query map or the DB

(defn- viz-settings
  [query]
  (or (let [viz (-> query :viz-settings)]
        (when (seq viz) viz))
      (when-let [card-id (-> query :info :card-id)]
        (mb.viz/db->norm (:visualization-settings (lib.metadata.protocols/card (qp.store/metadata-provider) card-id))))))

Middleware for fetching and processing a table's visualization settings so that they can be incorporated into an export.

Card-level visualization settings are either fetched from the DB (for saved cards) or passed from the frontend in the API call (for unsaved cards). These are merged with the base viz settings for each field that are fetched from the QP store (and defined in the data model settings).

For native queries, viz settings passed from the frontend are used, without modification.

Processed viz settings are added to the metadata under the key :viz-settings.

(defn update-viz-settings
  [{{:keys [process-viz-settings?]} :middleware, :as query} rff]
  (if process-viz-settings?
    (let [card-viz-settings            (viz-settings query)
          normalized-card-viz-settings (mb.viz/db->norm card-viz-settings)
          column-viz-settings          (::mb.viz/column-settings card-viz-settings)
          fields                       (or (-> query :query :fields)
                                           (-> query :query :source-query :fields))
          field-ids                    (filter int? (map second fields))
          updated-column-viz-settings  (if (= (:type query) :query)
                                         (update-card-viz-settings column-viz-settings field-ids)
                                         column-viz-settings)
          global-settings              (m/map-vals mb.viz/db->norm-column-settings-entries
                                                   (public-settings/custom-formatting))
          updated-card-viz-settings    (-> normalized-card-viz-settings
                                           (assoc ::mb.viz/column-settings updated-column-viz-settings)
                                           (assoc ::mb.viz/global-column-settings global-settings))]
      (fn update-viz-settings-rff* [metadata]
        (rff (assoc metadata :viz-settings updated-card-viz-settings))))
    rff))
 

Middleware that wraps value literals in value/absolute-datetime/etc. clauses containing relevant type information; parses datetime string literals when appropriate.

(ns metabase.query-processor.middleware.wrap-value-literals
  (:require
   [metabase.lib.metadata :as lib.metadata]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.store :as qp.store]
   [metabase.query-processor.timezone :as qp.timezone]
   [metabase.types :as types]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date])
  (:import
   (java.time LocalDate LocalDateTime LocalTime OffsetDateTime OffsetTime ZonedDateTime)))

--------------------------------------------------- Type Info ----------------------------------------------------

Get information about database, base, and semantic types for an object. This is passed to along to various ->honeysql method implementations so drivers have the information they need to handle raw values like Strings, which may need to be parsed as a certain type.

(defmulti ^:private type-info
  {:arglists '([field-clause])}
  mbql.u/dispatch-by-clause-name-or-class)
(defmethod type-info :default [_] nil)
(defmethod type-info :metadata/column
  [field]
  (let [field-info (-> (select-keys field [:base-type :effective-type :coercion-strategy :semantic-type :database-type :name])
                       (update-keys u/->snake_case_en))]
    (merge
     field-info
     ;; add in a default unit for this Field so we know to wrap datetime strings in `absolute-datetime` below based on
     ;; its presence. Its unit will get replaced by the`:temporal-unit` in `:field` options in the method below if
     ;; present
     (when (types/temporal-field? field-info)
       {:unit :default}))))
(defmethod type-info :field [[_ id-or-name opts]]
  (merge
   (when (integer? id-or-name)
     (type-info (lib.metadata/field (qp.store/metadata-provider) id-or-name)))
   (when (:temporal-unit opts)
     {:unit (:temporal-unit opts)})
   (when (:base-type opts)
     {:base_type (:base-type opts)})))

------------------------------------------------- add-type-info --------------------------------------------------

Wraps value literals in :value clauses that includes base type info about the Field they're being compared against for easy driver QP implementation. Temporal literals (e.g., ISO-8601 strings) get wrapped in :time or :absolute-datetime instead which includes unit as well; temporal strings get parsed and converted to

TODO -- parsing the temporal string literals should be moved into auto-parse-filter-values, it's really a separate transformation from just wrapping the value

(defmulti ^:private add-type-info
  {:arglists '([x info & {:keys [parse-datetime-strings?]}])}
  (fn [x & _] (class x)))
(defmethod add-type-info nil
  [_ info & _]
  [:value nil info])
(defmethod add-type-info Object
  [this info & _]
  [:value this info])
(defmethod add-type-info LocalDate
  [this info & _]
  [:absolute-datetime this (get info :unit :default)])
(defmethod add-type-info LocalDateTime
  [this info & _]
  [:absolute-datetime this (get info :unit :default)])
(defmethod add-type-info LocalTime
  [this info & _]
  [:time this (get info :unit :default)])
(defmethod add-type-info OffsetDateTime
  [this info & _]
  [:absolute-datetime this (get info :unit :default)])
(defmethod add-type-info OffsetTime
  [this info & _]
  [:time this (get info :unit :default)])
(defmethod add-type-info ZonedDateTime
  [this info & _]
  [:absolute-datetime this (get info :unit :default)])
(defmethod add-type-info String
  [this {:keys [unit], :as info} & {:keys [parse-datetime-strings?]
                                    :or   {parse-datetime-strings? true}}]
  (if-let [temporal-value (when (and unit
                                     parse-datetime-strings?
                                     (string? this))
                            ;; TIMEZONE FIXME - I think this should actually use
                            ;; (qp.timezone/report-timezone-id-if-supported) instead ?
                            (u.date/parse this (qp.timezone/results-timezone-id)))]
    (if (some #(instance? % temporal-value) [LocalTime OffsetTime])
      [:time temporal-value unit]
      [:absolute-datetime temporal-value unit])
    [:value this info]))

-------------------------------------------- wrap-literals-in-clause ---------------------------------------------

(def ^:private raw-value? (complement mbql.u/mbql-clause?))

Given a normalized mbql query (important to desugar forms like [:does-not-contain ...] -> `[:not [:contains ...]]`), walks over the clause and annotates literals with type information.

eg:

[:not [:contains [:field 13 {:base_type :type/Text}] "foo"]] -> [:not [:contains [:field 13 {:base_type :type/Text}] [:value "foo" {:base_type :type/Text, :semantic_type nil, :database_type "VARCHAR", :name "description"}]]]

(defn wrap-value-literals-in-mbql
  [mbql]
  (mbql.u/replace mbql
    [(clause :guard #{:= :!= :< :> :<= :>=}) field (x :guard raw-value?)]
    [clause field (add-type-info x (type-info field))]
    [:datetime-diff (x :guard string?) (y :guard string?) unit]
    [:datetime-diff (add-type-info (u.date/parse x) nil) (add-type-info (u.date/parse y) nil) unit]
    [(clause :guard #{:datetime-add :datetime-subtract :convert-timezone :temporal-extract}) (field :guard string?) & args]
    (into [clause (add-type-info (u.date/parse field) nil)] args)
    [:between field (min-val :guard raw-value?) (max-val :guard raw-value?)]
    [:between
     field
     (add-type-info min-val (type-info field))
     (add-type-info max-val (type-info field))]
    [(clause :guard #{:starts-with :ends-with :contains}) field (s :guard string?) & more]
    (let [s (add-type-info s (type-info field), :parse-datetime-strings? false)]
      (into [clause field s] more))))

Extract value literal from :value form or returns form as is if not a :value form.

(defn unwrap-value-literal
  [maybe-value-form]
  (mbql.u/match-one maybe-value-form
    [:value x & _] x
    _              &match))
(defn ^:private wrap-value-literals-in-mbql-query
  [{:keys [source-query], :as inner-query} options]
  (let [inner-query (cond-> inner-query
                      source-query (update :source-query wrap-value-literals-in-mbql-query options))]
    (wrap-value-literals-in-mbql inner-query)))

Middleware that wraps ran value literals in :value (for integers, strings, etc.) or :absolute-datetime (for datetime strings, etc.) clauses which include info about the Field they are being compared to. This is done mostly to make it easier for drivers to write implementations that rely on multimethod dispatch (by clause name) -- they can dispatch directly off of these clauses.

(defn wrap-value-literals
  [{query-type :type, :as query}]
  (if-not (= query-type :query)
    query
    (mbql.s/validate-query
     (update query :query wrap-value-literals-in-mbql-query nil))))
 

Pivot table actions for the query processor

(ns metabase.query-processor.pivot
  (:require
   [clojure.core.async :as a]
   [metabase.lib.core :as lib]
   [metabase.lib.equality :as lib.equality]
   [metabase.lib.metadata.jvm :as lib.metadata.jvm]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.query-processor :as qp]
   [metabase.query-processor.context :as qp.context]
   [metabase.query-processor.context.default :as context.default]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.middleware.permissions :as qp.perms]
   [metabase.query-processor.middleware.resolve-database-and-driver
    :as qp.resolve-database-and-driver]
   [metabase.query-processor.reducible :as qp.reducible]
   [metabase.query-processor.store :as qp.store]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]))
(set! *warn-on-reflection* true)

Generate a powerset while maintaining the original ordering as much as possible

(defn powerset
  [xs]
  (for [combo (reverse (range (int (Math/pow 2 (count xs)))))]
    (for [item  (range 0 (count xs))
          :when (not (zero? (bit-and (bit-shift-left 1 item) combo)))]
      (nth xs item))))

Come up with a display name given a combination of breakout indices e.g.

This is basically a bitmask of which breakout indices we're excluding, but reversed. Why? This is how Postgres and other DBs determine group numbers. This implements basically what PostgreSQL does for grouping -- look at the original set of groups - if that column is part of this group, then set the appropriate bit (entry 1 sets bit 1, etc)

(group-bitmask 3 [1]) ; -> [_ 1 _] -> 101 -> 101 -> 5 (group-bitmask 3 [1 2]) ; -> [_ 1 2] -> 100 -> 011 -> 1

(defn- group-bitmask
  [num-breakouts indices]
  (transduce
   (map (partial bit-shift-left 1))
   (completing bit-xor)
   (int (dec (Math/pow 2 num-breakouts)))
   indices))

Return a sequence of all breakout combinations (by index) we should generate queries for.

(breakout-combinations 3 [1 2] nil) ;; -> [[0 1 2] [] [1 2] [2] [1]]

(defn- breakout-combinations
  [num-breakouts pivot-rows pivot-cols]
  ;; validate pivot-rows/pivot-cols
  (doseq [[k pivots] {:pivot-rows pivot-rows, :pivot-cols pivot-cols}
          i          pivots]
    (when (>= i num-breakouts)
      (throw (ex-info (tru "Invalid {0}: specified breakout at index {1}, but we only have {2} breakouts"
                           (name k) i num-breakouts)
                      {:type          qp.error-type/invalid-query
                       :num-breakouts num-breakouts
                       :pivot-rows    pivot-rows
                       :pivot-cols    pivot-cols}))))
  (sort-by
   (partial group-bitmask num-breakouts)
   (distinct
    (map
     vec
     ;; this can happen for the public/embed endpoints, where we aren't given a pivot-rows / pivot-cols parameter, so
     ;; we'll just generate everything
     (if (empty? (concat pivot-rows pivot-cols))
       (powerset (range 0 num-breakouts))
       (concat
        ;; e.g. given num-breakouts = 4; pivot-rows = [0 1 2]; pivot-cols = [3]
        ;; primary data: return all breakouts
        ;; => [0 1 2 3] => 0000 => Group #15
        [(range num-breakouts)]
        ;; subtotal rows
        ;; _.range(1, pivotRows.length).map(i => [...pivotRow.slice(0, i), ...pivotCols])
        ;;  => [0 _ _ 3] [0 1 _ 3] => 0110 0100 => Group #6, #4
        (for [i (range 1 (count pivot-rows))]
          (concat (take i pivot-rows) pivot-cols))
        ;; “row totals” on the right
        ;; pivotRows
        ;; => [0 1 2 _] => 1000 => Group #8
        [pivot-rows]
        ;; subtotal rows within “row totals”
        ;; _.range(1, pivotRows.length).map(i => pivotRow.slice(0, i))
        ;; => [0 _ _ _] [0 1 _ _] => 1110 1100 => Group #14, #12
        (for [i (range 1 (count pivot-rows))]
          (take i pivot-rows))
        ;; “grand totals” row
        ;; pivotCols
        ;; => [_ _ _ 3] => 0111 => Group #7
        [pivot-cols]
        ;; bottom right corner [_ _ _ _] => 1111 => Group #15
        [[]]))))))

Add the grouping field and expression to the query

(defn- add-grouping-field
  [query breakout bitmask]
  (as-> query query
    ;;TODO: replace this value with a bitmask or something to indicate the source better
    (update-in query [:query :expressions] assoc :pivot-grouping [:abs bitmask])
    ;; in PostgreSQL and most other databases, all the expressions must be present in the breakouts. Add a pivot
    ;; grouping expression ref to the breakouts
    (assoc-in query [:query :breakout] (concat breakout [[:expression "pivot-grouping"]]))
    (do
      (log/tracef "Added pivot-grouping expression to query\n%s" (u/pprint-to-str 'yellow query))
      query)))

Only keep existing aggregations in :order-by clauses from the query. Since we're adding our own breakouts (i.e. GROUP BY and ORDER BY clauses) to do the pivot table stuff, existing :order-by clauses probably won't work -- ORDER BY isn't allowed for fields that don't appear in GROUP BY.

(defn- remove-non-aggregation-order-bys
  [outer-query]
  (update
    outer-query
    :query
    (fn [query]
      (if-let [new-order-by (not-empty (filterv (comp #(= :aggregation %) first second) (:order-by query)))]
        (assoc query :order-by new-order-by)
        (dissoc query :order-by)))))

Generate the additional queries to perform a generic pivot table

(defn- generate-queries
  [{{all-breakouts :breakout} :query, :keys [query], :as outer-query}
   {:keys [pivot-rows pivot-cols], :as _pivot-options}]
  (try
    (for [breakout-indices (u/prog1 (breakout-combinations (count all-breakouts) pivot-rows pivot-cols)
                             (log/tracef "Using breakout combinations: %s" (pr-str <>)))
          :let             [group-bitmask (group-bitmask (count all-breakouts) breakout-indices)
                            new-breakouts (for [i breakout-indices]
                                            (nth all-breakouts i))]]
      (-> outer-query
          remove-non-aggregation-order-bys
          (add-grouping-field new-breakouts group-bitmask)))
    (catch Throwable e
      (throw (ex-info (tru "Error generating pivot queries")
                      {:type qp.error-type/qp, :query query}
                      e)))))

Reduce the results of a single query using rf and initial value init.

(defn- process-query-append-results
  [query rf init info context]
  (if (a/poll! (qp.context/canceled-chan context))
    (ensure-reduced init)
    (let [rff (fn [_]
                (fn
                  ([]        init)
                  ([acc]     acc)
                  ([acc row] (rf acc ((:row-mapping-fn context) row context)))))
          context {:canceled-chan (qp.context/canceled-chan context)}]
      (try
        (if info
          (qp/process-userland-query-sync (assoc query :info info) rff context)
          (qp/process-query-sync (dissoc query :info) rff context))
        (catch Throwable e
          (log/error e (trs "Error processing additional pivot table query"))
          (throw e))))))

Reduce the results of a sequence of queries using rf and initial value init.

(defn- process-queries-append-results
  [init queries rf info context]
  (reduce
   (fn [acc query]
     (process-query-append-results query rf acc info (assoc context
                                                            :pivot-column-mapping ((:column-mapping-fn context) query))))
   init
   queries))

Update Query Processor context so it appends the rows fetched when running more-queries.

(defn- append-queries-rff-and-context
  [info rff context more-queries]
  (let [vrf (volatile! nil)]
    {:rff     (fn [metadata]
                (u/prog1 (rff metadata)
                  ;; this captures the reducing function before composed with limit and other middleware
                  (vreset! vrf <>)))
     :context (cond-> context
                (seq more-queries)
                (-> (update :executef
                            (fn [orig]
                              ;; execute holds open a connection from [[execute-reducible-query]] so we need to manage
                              ;; connections in the reducing part reducef. The default runf is what orchestrates this
                              ;; together and we just pass the original executef to the reducing part so we can control
                              ;; our multiple connections.
                              (fn multiple-executef [driver query _context respond]
                                (respond [orig driver] query))))
                    (assoc :reducef
                           ;; signature usually has metadata in place of driver but we are hijacking
                           (fn multiple-reducing [rff context [orig-executef driver] query]
                             (let [respond (fn [metadata reducible-rows]
                                             (let [rf (rff metadata)]
                                               (assert (fn? rf))
                                               (try
                                                 (transduce identity (completing rf) reducible-rows)
                                                 (catch Throwable e
                                                   (qp.context/raisef (ex-info (tru "Error reducing result rows")
                                                                               {:type qp.error-type/qp}
                                                                               e)
                                                                      context)))))
                                   acc     (-> (orig-executef driver query context respond)
                                               (process-queries-append-results
                                                more-queries @vrf info context))]
                               ;; completion arity can't be threaded because the value is derefed too early
                               (qp.context/reducedf (@vrf acc) context))))))}))

Allows the query processor to handle multiple queries, stitched together to appear as one

(defn- process-multiple-queries
  [[first-query & more-queries] info rff context]
  (let [{:keys [rff context]} (append-queries-rff-and-context info rff context more-queries)]
    (if info
      (qp/process-query-and-save-with-max-results-constraints! first-query info rff context)
      (qp/process-query (dissoc first-query :info) rff context))))
(mu/defn ^:private pivot-options :- [:map
                                     [:pivot-rows [:maybe [:sequential [:int {:min 0}]]]]
                                     [:pivot-cols [:maybe [:sequential [:int {:min 0}]]]]]
  "Given a pivot table query and a card ID, looks at the `pivot_table.column_split` key in the card's visualization
  settings and generates pivot-rows and pivot-cols to use for generating subqueries."
  [query        :- [:map
                    [:database ::lib.schema.id/database]]
   viz-settings :- [:maybe :map]]
  (let [column-split         (:pivot_table.column_split viz-settings)
        column-split-rows    (seq (:rows column-split))
        column-split-columns (seq (:columns column-split))
        index-in-breakouts   (when (or column-split-rows
                                       column-split-columns)
                               (let [metadata-provider (or (:lib/metadata query)
                                                           (lib.metadata.jvm/application-database-metadata-provider (:database query)))
                                     mlv2-query        (lib/query metadata-provider query)
                                     breakouts         (into []
                                                             (map-indexed (fn [i col]
                                                                            (assoc col ::i i)))
                                                             (lib/breakouts-metadata mlv2-query))]
                                 (fn [legacy-ref]
                                   (try
                                     (::i (lib.equality/find-column-for-legacy-ref
                                           mlv2-query
                                           -1
                                           legacy-ref
                                           breakouts))
                                     (catch Throwable e
                                       (log/errorf e "Error finding matching column for ref %s" (pr-str legacy-ref))
                                       nil)))))
        pivot-rows (when column-split-rows
                     (into [] (keep index-in-breakouts) column-split-rows))
        pivot-cols (when column-split-columns
                     (into [] (keep index-in-breakouts) column-split-columns))]
    {:pivot-rows pivot-rows
     :pivot-cols pivot-cols}))

Run the pivot query. Unlike many query execution functions, this takes context as the first parameter to support its application via partial.

You are expected to wrap this call in [[metabase.query-processor.streaming/streaming-response]] yourself.

(defn run-pivot-query
  ([query]
   (run-pivot-query query nil))
  ([query info]
   (run-pivot-query query info nil))
  ([query info context]
   (run-pivot-query query info nil context))
  ([query info rff context]
   (binding [qp.perms/*card-id* (get info :card-id)]
     (qp.store/with-metadata-provider (qp.resolve-database-and-driver/resolve-database-id query)
       (let [context                 (merge (context.default/default-context) context)
             rff                     (or rff qp.reducible/default-rff)
             query                   (mbql.normalize/normalize query)
             pivot-options           (or
                                      (not-empty (select-keys query [:pivot-rows :pivot-cols]))
                                      (pivot-options query (get info :visualization-settings)))
             main-breakout           (:breakout (:query query))
             col-determination-query (add-grouping-field query main-breakout 0)
             all-expected-cols       (qp/query->expected-cols col-determination-query)
             all-queries             (generate-queries query pivot-options)]
         (process-multiple-queries
          all-queries
          info
          rff
          (assoc context
                 ;; this function needs to be executed at the start of every new query to
                 ;; determine the mapping for maintaining query shape
                 :column-mapping-fn (fn [query]
                                      (let [query-cols (map-indexed vector (qp/query->expected-cols query))]
                                        (map (fn [item]
                                               (some #(when (= (:name item) (:name (second %)))
                                                        (first %)) query-cols))
                                             all-expected-cols)))
                 ;; this function needs to be called for each row so that it can actually
                 ;; shape the row according to the `:column-mapping-fn` above
                 :row-mapping-fn (fn [row context]
                                   ;; the first query doesn't need any special mapping, it already has all the columns
                                   (if-let [col-mapping (:pivot-column-mapping context)]
                                     (map (fn [mapping]
                                            (when mapping
                                              (nth row mapping)))
                                          col-mapping)
                                     row)))))))))
 
(ns metabase.query-processor.reducible
  (:require
   [clojure.core.async :as a]
   [metabase.async.util :as async.u]
   [metabase.query-processor.context :as qp.context]
   [metabase.query-processor.context.default :as context.default]
   [metabase.util :as u]
   [metabase.util.log :as log]))
(set! *warn-on-reflection* true)

Default function returning a reducing function. Results are returned in the 'standard' map format e.g.

{:data {:cols [...], :rows [...]}, :row_count ...}

(defn default-rff
  [metadata]
  (let [row-count (volatile! 0)
        rows      (volatile! [])]
    (fn default-rf
      ([]
       {:data metadata})
      ([result]
       {:pre [(map? (unreduced result))]}
       ;; if the result is a clojure.lang.Reduced, unwrap it so we always get back the standard-format map
       (-> (unreduced result)
           (assoc :row_count @row-count
                  :status :completed)
           (assoc-in [:data :rows] @rows)))
      ([result row]
       (vswap! row-count inc)
       (vswap! rows conj row)
       result))))

The initial value of qp passed to QP middleware.

(defn identity-qp
  [query rff context]
  (qp.context/runf query rff context))

Combine a collection of QP middleware into a single QP function. The QP function, like the middleware, will have the signature:

(qp query rff context)

(defn combine-middleware
  ([middleware]
   (combine-middleware middleware identity-qp))
  ([middleware qp]
   (reduce
    (fn [qp middleware]
      (when (var? middleware)
        (assert (not (:private (meta middleware))) (format "%s is private" (pr-str middleware))))
      (if (some? middleware)
        (middleware qp)
        qp))
    qp
    middleware)))

Wire up the core.async channels in a QP context

  1. If query doesn't complete by [[qp.context/timeout]], call [[qp.context/timeoutf]], which should raise an Exception.

  2. When [[qp.context/out-chan]] is closed prematurely, send a message to [[qp.context/canceled-chan]].

  3. When [[qp.context/out-chan]] is closed or gets a result, close both [[qp.context/out-chan]] and [[qp.context/canceled-chan]].

Why isn't this just done automatically when we create the context in [[context.default/default-context]]? The timeout could be subject to change so it makes sense to wait until we actually run the query to wire stuff up. Also, since we're doing

(merge (context.default/default-context) context)

all over the place, it probably reduces overhead a bit to not run around adding a bunch of timeouts to channels we don't end up using.

(defn- wire-up-context-channels!
  [context]
  (let [out-chan      (qp.context/out-chan context)
        canceled-chan (qp.context/canceled-chan context)
        timeout       (qp.context/timeout context)]
    (a/go
      (let [[val port] (a/alts! [out-chan (a/timeout timeout)] :priority true)]
        (log/tracef "Port %s got %s"
                    (if (= port out-chan) "out-chan" (format "[timeout after %s]" (u/format-milliseconds timeout)))
                    val)
        (cond
          (not= port out-chan) (qp.context/timeoutf context)
          (nil? val)           (a/>!! canceled-chan ::cancel))
        (log/tracef "Closing out-chan.")
        (a/close! out-chan)
        (a/close! canceled-chan)))
    nil))

Whether to run the query on a separate thread. When running a query asynchronously (i.e., with [[async-qp]]), this is normally true, meaning the out-chan is returned immediately. When running a query synchronously (i.e., with sync-qp), this is normally false, becuase we are blocking while waiting for results.

(def ^:dynamic *run-on-separate-thread?*
  true)

Wrap a QP function (middleware or a composition of middleware created with [[combine-middleware]]) with the signature:

(qp query rff context)

And return a function with the signatures:

(qp query) (qp query context)

While you can use a 3-arg QP function directly, this makes the function more user-friendly by providing a base rff and a default context,

(defn async-qp
  [qp]
  (fn qp*
    ([query]
     (qp* query nil))
    ([query context]
     (qp* query nil context))
    ([query rff context]
     {:pre [(map? query) ((some-fn nil? map?) context)]}
     (let [context (doto (merge (context.default/default-context) context)
                     wire-up-context-channels!)
           rff     (or rff default-rff)
           thunk   (fn [] (try
                            (qp query rff context)
                            (catch Throwable e
                              (qp.context/raisef e context))))]
       (log/tracef "Running on separate thread? %s" *run-on-separate-thread?*)
       (if *run-on-separate-thread?*
         (future (thunk))
         (thunk))
       (qp.context/out-chan context)))))
(defn- wait-for-async-result [out-chan]
  {:pre [(async.u/promise-chan? out-chan)]}
  (let [result (a/<!! out-chan)]
    (if (instance? Throwable result)
      (throw result)
      result)))

Wraps a QP function created by [[async-qp]] into one that synchronously waits for query results and rethrows any Exceptions thrown. Resulting QP has the signatures

(qp query) (qp query context) (qp query rff context)

(defn sync-qp
  [qp]
  {:pre [(fn? qp)]}
  (fn qp* [& args]
    (binding [*run-on-separate-thread?* false]
      (wait-for-async-result (apply qp args)))))

------------------------------------------------- Other Util Fns -------------------------------------------------

Utility function for generating reducible rows when implementing [[metabase.driver/execute-reducible-query]].

row-thunk is a function that, when called, should return the next row in the results, or falsey if no more rows exist.

(defn reducible-rows
  [row-thunk canceled-chan]
  (reify
    clojure.lang.IReduceInit
    (reduce [_ rf init]
      (loop [acc init]
        (cond
          (reduced? acc)
          @acc
          (a/poll! canceled-chan)
          acc
          :else
          (if-let [row (row-thunk)]
            (recur (rf acc row))
            (do
              (log/trace "All rows consumed.")
              acc)))))))

Utility function for creating a reducing function that reduces results using primary-rf and some number of additional-rfs, then combines them into a final result with combine.

(fn my-xform [rf] (combine-additional-reducing-fns rf [((take 100) conj)] (fn combine [result first-100-values] (rf (assoc result :first-100 first-100-values)))))

This is useful for post-processing steps that need to reduce the result rows to provide some metadata that can be added to the final result.

This is conceptually similar to a combination of [[redux.core/juxt]] and [[redux.core/post-complete]], with these differences:

  1. The accumulators of the additional reducing functions are maintained separately in a volatile!, so any transducers applied to the result of this function will work normally, exactly as if they were applied directly to primary-rf. Because juxt changes the accumulator itself, its use can break the behavior of other transducers.

  2. Since only the acc from primary-rf is exposed, the result will be reduced when the accumulator of the primary reducing function is reduced, rather than when the accumulators of all reducing functions are reduced. In other words, the reduced behavior will be exactly the same way as if you used primary-rf on its own.

  3. combine is like [[redux.core/post-complete]], but called with separate args, one for each reducing function.

  4. The completing arity of the primary reducing function is not applied automatically, so be sure to apply it yourself in the appropriate place in the body of your combine function.

(defn combine-additional-reducing-fns
  [primary-rf additional-rfs combine]
  {:pre [(fn? primary-rf) (sequential? additional-rfs) (every? fn? additional-rfs) (fn? combine)]}
  (let [additional-accs (volatile! (mapv (fn [rf] (rf))
                                         additional-rfs))]
    (fn combine-additional-reducing-fns-rf*
      ([] (primary-rf))
      ([acc]
       (let [additional-results (map (fn [rf acc]
                                       (rf (unreduced acc)))
                                     additional-rfs
                                     @additional-accs)]
         (apply combine acc additional-results)))
      ([acc x]
       (vswap! additional-accs (fn [accs]
                                 (mapv (fn [rf acc]
                                         (if (reduced? acc)
                                           acc
                                           (rf acc x)))
                                       additional-rfs
                                       accs)))
       (primary-rf acc x)))))
 

The Query Processor Store caches resolved Tables and Fields for the duration of a query execution. Certain middleware handles resolving things like the query's source Table and any Fields that are referenced in a query, and saves the referenced objects in the store; other middleware and driver-specific query processor implementations use functions in the store to fetch those objects as needed.

For example, a driver might be converting a Field ID clause (e.g. [:field-id 10]) to its native query language. It can fetch the underlying Metabase FieldInstance by calling field:

(qp.store/field 10) ;; get Field 10

Of course, it would be entirely possible to call (t2/select-one Field :id 10) every time you needed information about that Field, but fetching all Fields in a single pass and storing them for reuse is dramatically more efficient than fetching those Fields potentially dozens of times in a single query execution.

(ns metabase.query-processor.store
  (:require
   [medley.core :as m]
   [metabase.lib.convert :as lib.convert]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.jvm :as lib.metadata.jvm]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]))
(set! *warn-on-reflection* true)
(def ^:private uninitialized-store
  (reify
    clojure.lang.IDeref
    (deref [_this]
      (throw (ex-info "Error: Query Processor store is not initialized. Initialize it with qp.store/with-metadata-provider"
                      {})))))

Dynamic var used as the QP store for a given query execution.

(def ^:private ^:dynamic *store*
  uninitialized-store)

This is only for tests! When enabled, [[with-metadata-provider]] can completely replace the current metadata provider (and cache) with a new one. This is reset to false after the QP store is replaced the first time.

(def ^:dynamic *TESTS-ONLY-allow-replacing-metadata-provider*
  false)

Is the QP store currently initialized?

TODO -- rename this to something like store-bound? because the store is not really initialized until the Database ID is set.

(defn initialized?
  []
  (not (identical? *store* uninitialized-store)))

Store a miscellaneous value in a the cache. Persists for the life of this QP invocation, including for recursive calls.

(mu/defn store-miscellaneous-value!
  [ks v]
  (swap! *store* assoc-in ks v))

Fetch a miscellaneous value from the cache. Unlike other Store functions, does not throw if value is not found.

(mu/defn miscellaneous-value
  ([ks]
   (miscellaneous-value ks nil))
  ([ks not-found]
   (get-in @*store* ks not-found)))

Attempt to fetch a miscellaneous value from the cache using key sequence ks; if not found, runs thunk to get the value, stores it in the cache, and returns the value. You can use this to ensure a given function is only ran once during the duration of a QP execution.

See also cached macro.

(defn cached-fn
  [ks thunk]
  (let [cached-value (miscellaneous-value ks ::not-found)]
    (if-not (= cached-value ::not-found)
      cached-value
      (let [v (thunk)]
        (store-miscellaneous-value! ks v)
        v))))

Cache the value of body for key(s) for the duration of this QP execution. (Body is only evaluated the once per QP run; subsequent calls return the cached result.)

Note that each use of cached generates its own unique first key for cache keyseq; thus while it is not possible to share values between multiple cached forms, you do not need to worry about conflicts with other places using this macro.

;; cache lookups of Card.dataset_query (qp.store/cached card-id (t2/select-one-fn :dataset_query Card :id card-id))

(defmacro cached
  {:style/indent 1}
  [k-or-ks & body]
  ;; for the unique key use a gensym prefixed by the namespace to make for easier store debugging if needed
  (let [ks (into [(list 'quote (gensym (str (name (ns-name *ns*)) "/misc-cache-")))] (u/one-or-many k-or-ks))]
    `(cached-fn ~ks (fn [] ~@body))))
(mu/defn metadata-provider :- lib.metadata/MetadataProvider
  "Get the [[metabase.lib.metadata.protocols/MetadataProvider]] that should be used inside the QP. "
  []
  (or (miscellaneous-value [::metadata-provider])
      (throw (ex-info "QP Store Metadata Provider is not initialized yet; initialize it with `qp.store/with-metadata-provider`."
                      {}))))
(mu/defn ^:private ->metadata-provider :- lib.metadata/MetadataProvider
  [database-id-or-metadata-provider :- [:or
                                        ::lib.schema.id/database
                                        lib.metadata/MetadataProvider]]
  (if (integer? database-id-or-metadata-provider)
    (lib.metadata.jvm/application-database-metadata-provider database-id-or-metadata-provider)
    database-id-or-metadata-provider))

Impl for [[with-metadata-provider]]; if there's already a provider, just make sure we're not trying to change the Database. We don't need to replace it.

(mu/defn ^:private validate-existing-provider
  [database-id-or-metadata-provider :- [:or
                                        ::lib.schema.id/database
                                        lib.metadata/MetadataProvider]]
  (let [old-provider (miscellaneous-value [::metadata-provider])]
    (when-not (identical? old-provider database-id-or-metadata-provider)
      (let [new-database-id      (if (integer? database-id-or-metadata-provider)
                                   database-id-or-metadata-provider
                                   (throw (ex-info "Cannot replace MetadataProvider with another one after it has been bound"
                                                   {:old-provider old-provider, :new-provider database-id-or-metadata-provider})))
            existing-database-id (u/the-id (lib.metadata/database old-provider))]
        (when-not (= new-database-id existing-database-id)
          (throw (ex-info (tru "Attempting to initialize metadata provider with new Database {0}. Queries can only reference one Database. Already referencing: {1}"
                               (pr-str new-database-id)
                               (pr-str existing-database-id))
                          {:existing-id existing-database-id
                           :new-id      new-database-id
                           :type        qp.error-type/invalid-query})))))))

Create a new metadata provider and save it.

(mu/defn ^:private set-metadata-provider!
  [database-id-or-metadata-provider :- [:or
                                        ::lib.schema.id/database
                                        lib.metadata/MetadataProvider]]
  (let [new-provider (->metadata-provider database-id-or-metadata-provider)]
    ;; validate the new provider.
    (try
      (lib.metadata/database new-provider)
      (catch Throwable e
        (throw (ex-info (format "Invalid MetadataProvider, failed to return valid Database: %s" (ex-message e))
                        {:metadata-provider new-provider}
                        e))))
    (store-miscellaneous-value! [::metadata-provider] new-provider)))

Implementation for [[with-metadata-provider]].

(defn do-with-metadata-provider
  [database-id-or-metadata-provider thunk]
  (cond
    (or (not (initialized?))
        *TESTS-ONLY-allow-replacing-metadata-provider*)
    (binding [*store*                                        (atom {})
              *TESTS-ONLY-allow-replacing-metadata-provider* false]
      (do-with-metadata-provider database-id-or-metadata-provider thunk))
    ;; existing provider
    (miscellaneous-value [::metadata-provider])
    (do
      (validate-existing-provider database-id-or-metadata-provider)
      (thunk))
    :else
    (do
      (set-metadata-provider! database-id-or-metadata-provider)
      (thunk))))

Execute body with an initialized QP store and metadata provider bound. You can either pass a [[metabase.lib.metadata.protocols/MetadataProvider]] directly, or pass a Database ID, for which we will create a [[metabase.lib.metadata.jvm/application-database-metadata-provider]].

If a MetadataProvider is already bound, this is a no-op.

(defmacro with-metadata-provider
  {:style/indent [:defn]}
  [database-id-or-metadata-provider & body]
  `(do-with-metadata-provider ~database-id-or-metadata-provider (^:once fn* [] ~@body)))
(defn- missing-bulk-metadata-error [metadata-type id]
  (ex-info (tru "Failed to fetch {0} {1}" (pr-str metadata-type) (pr-str id))
           {:status-code       400
            :type              qp.error-type/invalid-query
            :metadata-provider (metadata-provider)
            :metadata-type     metadata-type
            :id                id}))
(mu/defn bulk-metadata :- [:maybe [:sequential [:map
                                                [:lib/type :keyword]
                                                [:id ::lib.schema.common/positive-int]]]]
  "Fetch multiple objects in bulk. If our metadata provider is a bulk provider (e.g., the application database metadata
  provider), does a single fetch with [[lib.metadata.protocols/bulk-metadata]] if not (i.e., if this is a mock
  provider), fetches them with repeated calls to the appropriate single-object method,
  e.g. [[lib.metadata.protocols/field]].
  The order of the returned objects will match the order of `ids`, and the response is guaranteed to contain every
  object referred to by `ids`. Throws an exception if any objects could not be fetched.
  This can also be called for side-effects to warm the cache."
  [metadata-type :- [:enum :metadata/card :metadata/column :metadata/metric :metadata/segment :metadata/table]
   ids           :- [:maybe
                     [:or
                      [:set ::lib.schema.common/positive-int]
                      [:sequential ::lib.schema.common/positive-int]]]]
  (when-let [ids-set (not-empty (set ids))]
    (let [provider   (metadata-provider)
          objects    (vec (if (satisfies? lib.metadata.protocols/BulkMetadataProvider provider)
                            (filter some? (lib.metadata.protocols/bulk-metadata provider metadata-type ids-set))
                            (let [f (case metadata-type
                                      :metadata/card    lib.metadata.protocols/card
                                      :metadata/column  lib.metadata.protocols/field
                                      :metadata/metric  lib.metadata.protocols/metric
                                      :metadata/segment lib.metadata.protocols/segment
                                      :metadata/table   lib.metadata.protocols/table)]
                              (for [id ids-set]
                                (f provider id)))))
          id->object (m/index-by :id objects)]
      (mapv (fn [id]
              (or (get id->object id)
                  (throw (missing-bulk-metadata-error metadata-type id))))
            ids))))

DEPRECATED STUFF

(def ^:private ^{:deprecated "0.48.0"} LegacyDatabaseMetadata
  [:map
   [:id       ::lib.schema.id/database]
   [:engine   :keyword]
   [:name     ms/NonBlankString]
   [:details  :map]
   [:settings [:maybe :map]]])
(def ^:private ^{:deprecated "0.48.0"} LegacyTableMetadata
  [:map
   [:schema [:maybe :string]]
   [:name   ms/NonBlankString]])
(def ^:private ^{:deprecated "0.48.0"} LegacyFieldMetadata
  [:map
   [:name          ms/NonBlankString]
   [:table_id      ::lib.schema.id/table]
   [:display_name  ms/NonBlankString]
   [:description   [:maybe :string]]
   [:database_type ms/NonBlankString]
   [:base_type     ms/FieldType]
   [:semantic_type [:maybe ms/FieldSemanticOrRelationType]]
   [:fingerprint   [:maybe :map]]
   [:parent_id     [:maybe ::lib.schema.id/field]]
   [:nfc_path      [:maybe [:sequential ms/NonBlankString]]]
   ;; there's a tension as we sometimes store fields from the db, and sometimes store computed fields. ideally we
   ;; would make everything just use base_type.
   [:effective_type    {:optional true} [:maybe ms/FieldType]]
   [:coercion_strategy {:optional true} [:maybe ms/CoercionStrategy]]])

For compatibility: convert MLv2-style metadata as returned by [[metabase.lib.metadata.protocols]] or [[metabase.lib.metadata]] functions (with kebab-case keys and :lib/type) to legacy QP/application database style metadata (with snake_case keys and Toucan 2 model :type metadata).

Try to avoid using this, we would like to remove this in the near future.

(defn ->legacy-metadata
  {:deprecated "0.48.0"}
  [mlv2-metadata]
  (let [model (case (:lib/type mlv2-metadata)
                :metadata/database :model/Database
                :metadata/table :model/Table
                :metadata/column :model/Field)]
    (-> mlv2-metadata
        (dissoc :lib/type)
        (update-keys u/->snake_case_en)
        (vary-meta assoc :type model)
        (m/update-existing :field_ref lib.convert/->legacy-MBQL))))
#_{:clj-kondo/ignore [:deprecated-var]}
(mu/defn database :- LegacyDatabaseMetadata
  "Fetch the Database referenced by the current query from the QP Store. Throws an Exception if valid item is not
  returned.
  Deprecated in favor of [[metabase.lib.metadata/database]] + [[metadata-provider]]."
  {:deprecated "0.48.0"}
  []
  (->legacy-metadata (lib.metadata/database (metadata-provider))))
#_{:clj-kondo/ignore [:deprecated-var]}
(mu/defn ^:deprecated table :- LegacyTableMetadata
  "Fetch Table with `table-id` from the QP Store. Throws an Exception if valid item is not returned.
  Deprecated in favor of [[metabase.lib.metadata/table]] + [[metadata-provider]]."
  {:deprecated "0.48.0"}
  [table-id :- ::lib.schema.id/table]
  (-> (or (lib.metadata.protocols/table (metadata-provider) table-id)
          (throw (ex-info (tru "Failed to fetch Table {0}: Table does not exist, or belongs to a different Database."
                               (pr-str table-id))
                          {:status-code 404
                           :type        qp.error-type/invalid-query
                           :table-id    table-id})))
      ->legacy-metadata))
#_{:clj-kondo/ignore [:deprecated-var]}
(mu/defn ^:deprecated field :- LegacyFieldMetadata
  "Fetch Field with `field-id` from the QP Store. Throws an Exception if valid item is not returned.
  Deprecated in favor of [[metabase.lib.metadata/field]] + [[metadata-provider]]."
  {:deprecated "0.48.0"}
  [field-id :- ::lib.schema.id/field]
  (-> (or (lib.metadata.protocols/field (metadata-provider) field-id)
          (throw (ex-info (tru "Failed to fetch Field {0}: Field does not exist, or belongs to a different Database."
                               (pr-str field-id))
                          {:status-code 404
                           :type        qp.error-type/invalid-query
                           :field-id    field-id})))
      ->legacy-metadata))
 
(ns metabase.query-processor.streaming
  (:require
   [clojure.core.async :as a]
   [metabase.async.streaming-response :as streaming-response]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.context :as qp.context]
   [metabase.query-processor.context.default :as context.default]
   [metabase.query-processor.streaming.csv :as qp.csv]
   [metabase.query-processor.streaming.interface :as qp.si]
   [metabase.query-processor.streaming.json :as qp.json]
   [metabase.query-processor.streaming.xlsx :as qp.xlsx]
   [metabase.shared.models.visualization-settings :as mb.viz]
   [metabase.util :as u])
  (:import
   (clojure.core.async.impl.channels ManyToManyChannel)
   (java.io OutputStream)
   (metabase.async.streaming_response StreamingResponse)))
(set! *warn-on-reflection* true)

these are loaded for side-effects so their impls of qp.si/results-writer will be available TODO - consider whether we should lazy-load these!

(comment qp.csv/keep-me
         qp.json/keep-me
         qp.xlsx/keep-me)

Deduplicate column names that would otherwise conflict.

TODO: This function includes logic that is normally is done by the annotate middleware, but hasn't been run yet at this point in the code. We should eventually refactor this (#17195)

(defn- deduplicate-col-names
  [cols]
  (map (fn [col unique-name]
         (let [col-with-display-name (if (:display_name col)
                                       col
                                       (assoc col :display_name (:name col)))]
           (assoc col-with-display-name :name unique-name)))
       cols
       (mbql.u/uniquify-names (map :name cols))))

Validate that all of the columns in table-columns correspond to actual columns in cols, correlating them by field ref or name. Returns nil if any do not, so that we fall back to using cols directly for the export (#19465). Otherwise returns table-columns.

(defn- validate-table-columms
  [table-columns cols]
  (let [col-field-refs (set (remove nil? (map :field_ref cols)))
        col-names      (set (remove nil? (map :name cols)))]
    (when (every? (fn [table-col] (or (col-field-refs (::mb.viz/table-column-field-ref table-col))
                                      (col-names (::mb.viz/table-column-name table-col))))
                  table-columns)
      table-columns)))

For each entry in table-columns that is enabled, finds the index of the corresponding entry in cols by name or id. If a col has been remapped, uses the index of the new column.

The resulting list of indices determines the order of column names and data in exports.

(defn- export-column-order
  [cols table-columns]
  (let [table-columns'     (or (validate-table-columms table-columns cols)
                               ;; If table-columns is not provided (e.g. for saved cards), we can construct a fake one
                               ;; that retains the original column ordering in `cols`
                               (for [col cols]
                                 (let [col-name   (:name col)
                                       id-or-name (or (:id col) col-name)
                                       field-ref  (:field_ref col)]
                                   {::mb.viz/table-column-field-ref (or field-ref [:field id-or-name nil])
                                    ::mb.viz/table-column-enabled true
                                    ::mb.viz/table-column-name col-name})))
        enabled-table-cols (filter ::mb.viz/table-column-enabled table-columns')
        cols-vector        (into [] cols)
        ;; cols-index is a map from keys representing fields to their indices into `cols`
        cols-index         (reduce-kv (fn [m i col]
                                        ;; Always add col-name as a key, so that native queries and remapped fields work correctly
                                        (let [m' (assoc m (:name col) i)]
                                          (if-let [field-ref (:field_ref col)]
                                            ;; Add a map key based on the column's field-ref, if available
                                            (assoc m' field-ref i)
                                            m')))
                                      {}
                                      cols-vector)]
    (->> (map
          (fn [{field-ref ::mb.viz/table-column-field-ref, col-name ::mb.viz/table-column-name}]
            (let [index              (or (get cols-index field-ref)
                                         (get cols-index col-name))
                  col                (get cols-vector index)
                  remapped-to-name   (:remapped_to col)
                  remapped-from-name (:remapped_from col)]
              (cond
                remapped-to-name
                (get cols-index remapped-to-name)
                (not remapped-from-name)
                index)))
          enabled-table-cols)
         (remove nil?))))

Dedups and orders cols based on the contents of table-columns in the provided viz settings. Also returns a list of indices which map the new order to the original order, and is used to reorder individual rows.

(defn order-cols
  [cols viz-settings]
  (let [deduped-cols  (deduplicate-col-names cols)
        output-order  (export-column-order deduped-cols (::mb.viz/table-columns viz-settings))
        ordered-cols  (if output-order
                        (let [v (into [] deduped-cols)]
                          (for [i output-order] (v i)))
                        deduped-cols)]
    [ordered-cols output-order]))
(defn- streaming-rff [results-writer]
  (fn [{:keys [cols viz-settings] :as initial-metadata}]
    (let [[ordered-cols output-order] (order-cols cols viz-settings)
          viz-settings'               (assoc viz-settings :output-order output-order)
          row-count                   (volatile! 0)]
      (fn
        ([]
         (qp.si/begin! results-writer
                       {:data (assoc initial-metadata :ordered-cols ordered-cols)}
                       viz-settings')
         {:data initial-metadata})
        ([metadata]
         (assoc metadata
                :row_count @row-count
                :status :completed))
        ([metadata row]
         (qp.si/write-row! results-writer row (dec (vswap! row-count inc)) ordered-cols viz-settings')
         metadata)))))
(defn- streaming-reducedf [results-writer ^OutputStream os]
  (fn [final-metadata context]
    (qp.si/finish! results-writer final-metadata)
    (u/ignore-exceptions
      (.flush os)
      (.close os))
    (qp.context/resultf final-metadata context)))

Context to pass to the QP to streaming results as export-format to an output stream. Can be used independently of the normal streaming-response macro, which is geared toward Ring responses.

(with-open [os ...] (let [{:keys [rff context]} (qp.streaming/streaming-context-and-rff :csv os canceled-chan)] (qp/process-query query rff context)))

(defn streaming-context-and-rff
  ([export-format os]
   (let [results-writer (qp.si/streaming-results-writer export-format os)]
     {:context (merge (context.default/default-context)
                      {:reducedf (streaming-reducedf results-writer os)})
      :rff     (streaming-rff results-writer)}))
  ([export-format os canceled-chan]
   (assoc-in (streaming-context-and-rff export-format os) [:context :canceled-chan] canceled-chan)))
(defn- await-async-result [out-chan canceled-chan]
  ;; if we get a cancel message, close `out-chan` so the query will be canceled
  (a/go
    (when (a/<! canceled-chan)
      (a/close! out-chan)))
  ;; block until `out-chan` closes or gets a result
  (a/<!! out-chan))

Impl for streaming-response.

(defn streaming-response*
  ^StreamingResponse [export-format filename-prefix f]
  (streaming-response/streaming-response (qp.si/stream-options export-format filename-prefix) [os canceled-chan]
    (let [{:keys [rff context]} (streaming-context-and-rff export-format os canceled-chan)
          result                (try
                                  (f {:rff rff, :context context})
                                  (catch Throwable e
                                    e))
          result                (if (instance? ManyToManyChannel result)
                                  (await-async-result result canceled-chan)
                                  result)]
      (when (or (instance? Throwable result)
                (= (:status result) :failed))
        (streaming-response/write-error! os result)))))

Return results of processing a query as a streaming response. This response implements the appropriate Ring/Compojure protocols, so return or respond with it directly. Pass the provided context to your query processor function of choice. export-format is one of :api (for normal JSON API responses), :json, :csv, or :xlsx (for downloads).

Typical example:

(api/defendpoint-schema GET "/whatever" [] (qp.streaming/streaming-response [{:keys [rff context]} :json] (qp/process-query-and-save-with-max-results-constraints! (assoc query :async true) rff context)))

Handles either async or sync QP results, but you should prefer returning sync results so we can handle query cancelations properly.

(defmacro streaming-response
  {:style/indent 1}
  [[map-binding export-format filename-prefix] & body]
  `(streaming-response* ~export-format ~filename-prefix (bound-fn [~map-binding] ~@body)))

Set of valid streaming response formats. Currently, :json, :csv, :xlsx, and :api (normal JSON API results with extra metadata), but other types may be available if plugins are installed. (The interface is extensible.)

(defn export-formats
  []
  (set (keys (methods qp.si/stream-options))))
 

Shared util fns for various export (download) streaming formats.

(ns metabase.query-processor.streaming.common
  (:require
   [clojure.string :as str]
   [java-time.api :as t]
   [medley.core :as m]
   [metabase.public-settings :as public-settings]
   [metabase.query-processor.store :as qp.store]
   [metabase.query-processor.timezone :as qp.timezone]
   [metabase.shared.models.visualization-settings :as mb.viz]
   [metabase.shared.util.currency :as currency]
   [metabase.util.date-2 :as u.date])
  (:import
   (clojure.lang ISeq)
   (java.time LocalDate LocalDateTime LocalTime OffsetDateTime OffsetTime ZonedDateTime)))

Set the time zone of a temporal value t to result timezone without changing the actual moment in time. e.g.

;; if result timezone is US/Pacific (apply-timezone #t "2021-03-30T20:06:00Z") -> #t "2021-03-30T13:06:00-07:00"

(defn in-result-time-zone
  [t]
  (u.date/with-time-zone-same-instant
   t
   (qp.store/cached ::results-timezone (t/zone-id (qp.timezone/results-timezone-id)))))

Protocol for specifying how objects of various classes in QP result rows should be formatted in various download results formats (e.g. CSV, as opposed to the 'normal' API response format, which doesn't use this logic).

(defprotocol FormatValue
  (format-value [this]
    "Format this value in a QP result row appropriately for a results download, such as CSV."))
(extend-protocol FormatValue
  nil
  (format-value [_] nil)

  Object
  (format-value [this] this)

  ISeq
  (format-value [this]
    (mapv format-value this))

  LocalDate
  (format-value [t]
    (u.date/format t))

  LocalDateTime
  (format-value [t]
    (if (= (t/local-time t) (t/local-time 0))
      (format-value (t/local-date t))
      (u.date/format t)))

  LocalTime
  (format-value [t]
    (u.date/format t))

  OffsetTime
  (format-value [t]
    (u.date/format (in-result-time-zone t)))

  OffsetDateTime
  (format-value [t]
    (u.date/format (in-result-time-zone t)))

  ZonedDateTime
  (format-value [t]
    (format-value (t/offset-date-time t))))

Merge format settings defined in the localization preferences into the format settings for a single column.

(defn merge-global-settings
  [format-settings global-settings-key]
  (let [global-settings (get (public-settings/custom-formatting) global-settings-key)
        normalized      (mb.viz/db->norm-column-settings-entries global-settings)]
    (merge normalized format-settings)))

Given the format settings for a currency column, returns the symbol, code or name for the appropriate currency.

(defn currency-identifier
  [format-settings]
  (let [currency-code (::mb.viz/currency format-settings "USD")]
    (condp = (::mb.viz/currency-style format-settings "symbol")
      "symbol"
      (if (currency/supports-symbol? currency-code)
        (get-in currency/currency [(keyword currency-code) :symbol])
        ;; Fall back to using code if symbol isn't supported on the Metabase frontend
        currency-code)
      "code"
      currency-code
      "name"
      (get-in currency/currency [(keyword currency-code) :name_plural]))))

Generates the column titles that should be used in the export, taking into account viz settings.

(defn column-titles
  [ordered-cols col-settings]
  (for [col ordered-cols]
    (let [id-or-name      (or (and (:remapped_from col) (:fk_field_id col))
                              (:id col)
                              (:name col))
          col-settings'   (update-keys col-settings #(select-keys % [::mb.viz/field-id ::mb.viz/column-name]))
          format-settings (or (get col-settings' {::mb.viz/field-id id-or-name})
                              (get col-settings' {::mb.viz/column-name id-or-name}))
          is-currency?    (or (isa? (:semantic_type col) :type/Currency)
                              (= (::mb.viz/number-style format-settings) "currency"))
          merged-settings (if is-currency?
                            (merge-global-settings format-settings :type/Currency)
                            format-settings)
          column-title    (or (::mb.viz/column-title merged-settings)
                              (:display_name col)
                              (:name col))]
      (if (and is-currency? (::mb.viz/currency-in-header merged-settings true))
        (str column-title " (" (currency-identifier merged-settings) ")")
        column-title))))

Update map keys to remove namespaces from keywords and convert from snake to kebab case.

(defn normalize-keys
  [m]
  (update-keys m (fn [k] (-> k name (str/replace #"_" "-") keyword))))

The dispatch function logic for format format-timestring. Find the highest type of the object.

(def col-type
  (some-fn :semantic_type :effective_type :base_type))

Look up the global viz settings based on the type of the column. A multimethod is used because they match well against type hierarchies.

(defmulti global-type-settings
  (fn [col _viz-settings] (col-type col)))
(defmethod global-type-settings :type/Temporal [_ {::mb.viz/keys [global-column-settings] :as _viz-settings}]
  (:type/Temporal global-column-settings {}))
(defmethod global-type-settings :type/Date [_ {::mb.viz/keys [global-column-settings] :as _viz-settings}]
  (merge
    (:type/Temporal global-column-settings {})
    {::mb.viz/time-enabled nil}))
(defmethod global-type-settings :type/Time [_ {::mb.viz/keys [global-column-settings] :as _viz-settings}]
  (merge
    (:type/Temporal global-column-settings {::mb.viz/time-style "h:mm A"})
    {::mb.viz/date-style ""}))
(defmethod global-type-settings :type/DateTime [_ {::mb.viz/keys [global-column-settings] :as _viz-settings}]
  (:type/Temporal global-column-settings {}))
(defmethod global-type-settings :type/Number [_ {::mb.viz/keys [global-column-settings] :as _viz-settings}]
  (:type/Number global-column-settings {}))
(defmethod global-type-settings :type/Currency [_ {::mb.viz/keys [global-column-settings] :as _viz-settings}]
  (merge
    {::mb.viz/number-style "currency"}
    (:type/Currency global-column-settings)))
(defmethod global-type-settings :default [_ _viz-settings]
  {})

Look up the setting defaults based on any information in the column-settings. This is the case when a column has no special type (e.g. a number) but the user has specified that the type is currency. We prefer the currency defaults to the number defaults.

(defn- column-setting-defaults
  [global-column-settings column-settings]
  (case (::mb.viz/number-style column-settings)
    "currency" (:type/Currency global-column-settings)
    {}))

The ::mb.viz/global-column-settings comes from (public-settings/custom-formatting) and is provided by the query processor in the metabase.query-processor.middleware.visualization-settings middleware if process-viz-settings? is truthy. This function checks to see if those settings have been provided and adds them if they are not present.

(defn- ensure-global-viz-settings
  [{::mb.viz/keys [global-column-settings] :as viz-settings}]
  (cond-> viz-settings
    (nil? global-column-settings)
    (assoc ::mb.viz/global-column-settings
           (m/map-vals mb.viz/db->norm-column-settings-entries
                       (public-settings/custom-formatting)))))

Get the unified viz settings for a column based on the column's metadata (if any) and user settings (⚙).

(defn viz-settings-for-col
  [{column-name :name metadata-column-settings :settings :keys [field_ref] :as col} viz-settings]
  (let [{::mb.viz/keys [global-column-settings] :as viz-settings} (ensure-global-viz-settings viz-settings)
        [_ field-id-or-name] field_ref
        all-cols-settings (-> viz-settings
                              ::mb.viz/column-settings
                              ;; update the keys so that they will have only the :field-id or :column-name
                              ;; and not have any metadata. Since we don't know the metadata, we can never
                              ;; match a key with metadata, even if we do have the correct name or id
                              (update-keys #(select-keys % [::mb.viz/field-id ::mb.viz/column-name])))
        column-settings (or (all-cols-settings {::mb.viz/field-id field-id-or-name})
                            (all-cols-settings {::mb.viz/column-name (or field-id-or-name column-name)}))]
    (merge
      ;; The default global settings based on the type of the column
      (global-type-settings col viz-settings)
      ;; Generally, we want to look up the default global settings based on semantic or effective type. However, if
      ;; a user has specified other settings, we should look up the base type of those settings and combine them.
      (column-setting-defaults global-column-settings column-settings)
      ;; User defined metadata -- Note that this transformation should probably go in
      ;; `metabase.query-processor.middleware.results-metadata/merge-final-column-metadata
      ;; to prevent repetition
      (mb.viz/db->norm-column-settings-entries metadata-column-settings)
      ;; Column settings coming from the user settings in the ui
      ;; (E.g. Click the ⚙️on the column)
      column-settings)))
 
(ns metabase.query-processor.streaming.csv
  (:require
   [clojure.data.csv :as csv]
   [java-time.api :as t]
   [metabase.formatter :as formatter]
   [metabase.query-processor.streaming.common :as common]
   [metabase.query-processor.streaming.interface :as qp.si]
   [metabase.shared.models.visualization-settings :as mb.viz]
   [metabase.util.date-2 :as u.date])
  (:import
   (java.io BufferedWriter OutputStream OutputStreamWriter)
   (java.nio.charset StandardCharsets)))
(set! *warn-on-reflection* true)
(defmethod qp.si/stream-options :csv
  ([_]
   (qp.si/stream-options :csv "query_result"))
  ([_ filename-prefix]
   {:content-type              "text/csv"
    :status                    200
    :headers                   {"Content-Disposition" (format "attachment; filename=\"%s_%s.csv\""
                                                              (or filename-prefix "query_result")
                                                              (u.date/format (t/zoned-date-time)))}
    :write-keepalive-newlines? false}))
(defmethod qp.si/streaming-results-writer :csv
  [_ ^OutputStream os]
  (let [writer             (BufferedWriter. (OutputStreamWriter. os StandardCharsets/UTF_8))
        ordered-formatters (volatile! nil)]
    (reify qp.si/StreamingResultsWriter
      (begin! [_ {{:keys [ordered-cols results_timezone]} :data} viz-settings]
        (let [col-names (common/column-titles ordered-cols (::mb.viz/column-settings viz-settings))]
          (vreset! ordered-formatters (mapv (fn [col]
                                              (formatter/create-formatter results_timezone col viz-settings))
                                            ordered-cols))
          (csv/write-csv writer [col-names])
          (.flush writer)))

      (write-row! [_ row _row-num _ {:keys [output-order]}]
        (let [ordered-row (if output-order
                            (let [row-v (into [] row)]
                              (for [i output-order] (row-v i)))
                            row)]
          (csv/write-csv writer [(map (fn [formatter r]
                                        (formatter (common/format-value r)))
                                      @ordered-formatters ordered-row)])
          (.flush writer)))

      (finish! [_ _]
        ;; TODO -- not sure we need to flush both
        (.flush writer)
        (.flush os)
        (.close writer)))))
 
(ns metabase.query-processor.streaming.interface
  (:require
   [potemkin.types :as p.types]))

Options for the streaming response for this specific stream type. See metabase.async.streaming-response for all available options.

(defmulti stream-options
  {:arglists '([export-format] [export-format filename-prefix])}
  (fn ([export-format & _] (keyword export-format))))

Protocol for the methods needed to write streaming QP results. This protocol is a higher-level interface to intended to have multiple implementations.

(p.types/defprotocol+ StreamingResultsWriter
  (begin! [this initial-metadata viz-settings]
    "Write anything needed before writing the first row. `initial-metadata` is incomplete metadata provided before
    rows begin reduction; some metadata such as insights won't be available until we finish.")
  (write-row! [this row row-num col viz-settings]
    "Write a row. `row` is a sequence of values in the row. `row-num` is the zero-indexed row number. `cols` is
    an ordered list of columns in the export.")
  (finish! [this final-metadata]
    "Write anything needed after writing the last row. `final-metadata` is the final, complete metadata available
    after reducing all rows. Very important: This method *must* `.close` the underlying OutputStream when it is
    finshed."))

Given a export-format and java.io.Writer, return an object that implements StreamingResultsWriter.

(defmulti streaming-results-writer
  {:arglists '(^metabase.query_processor.streaming.interface.StreamingResultsWriter [export-format ^java.io.OutputStream os])}
  (fn [export-format _os]
    (keyword export-format)))
 

Impls for JSON-based QP streaming response types. :json streams a simple array of maps as opposed to the full response with all the metadata for :api.

(ns metabase.query-processor.streaming.json
  (:require
   [cheshire.core :as json]
   [java-time.api :as t]
   [metabase.formatter :as formatter]
   [metabase.query-processor.streaming.common :as common]
   [metabase.query-processor.streaming.interface :as qp.si]
   [metabase.shared.models.visualization-settings :as mb.viz]
   [metabase.util.date-2 :as u.date])
  (:import
   (java.io BufferedWriter OutputStream OutputStreamWriter)
   (java.nio.charset StandardCharsets)))
(set! *warn-on-reflection* true)
(defmethod qp.si/stream-options :json
  ([_]
   (qp.si/stream-options :json "query_result"))
  ([_ filename-prefix]
   {:content-type "application/json; charset=utf-8"
    :status       200
    :headers      {"Content-Disposition" (format "attachment; filename=\"%s_%s.json\""
                                                 (or filename-prefix "query_result")
                                                 (u.date/format (t/zoned-date-time)))}}))
(defmethod qp.si/streaming-results-writer :json
  [_ ^OutputStream os]
  (let [writer             (BufferedWriter. (OutputStreamWriter. os StandardCharsets/UTF_8))
        col-names          (volatile! nil)
        ordered-formatters (volatile! nil)]
    (reify qp.si/StreamingResultsWriter
      (begin! [_ {{:keys [ordered-cols results_timezone]} :data} viz-settings]
        ;; TODO -- wouldn't it make more sense if the JSON downloads used `:name` preferentially? Seeing how JSON is
        ;; probably going to be parsed programmatically
        (vreset! col-names (common/column-titles ordered-cols (::mb.viz/column-settings viz-settings)))
        (vreset! ordered-formatters (mapv (fn [col]
                                            (formatter/create-formatter results_timezone col viz-settings))
                                          ordered-cols))
        (.write writer "[\n"))

      (write-row! [_ row row-num _ {:keys [output-order]}]
        (let [ordered-row (if output-order
                            (let [row-v (into [] row)]
                              (for [i output-order] (row-v i)))
                            row)]
          (when-not (zero? row-num)
            (.write writer ",\n"))
          (json/generate-stream
            (zipmap
              @col-names
              (map (fn [formatter r]
                     ;; NOTE: Stringification of formatted values ensures consistency with what is shown in the
                     ;; Metabase UI, especially numbers (e.g. percents, currencies, and rounding). However, this
                     ;; does mean that all JSON values are strings. Any other strategy requires some level of
                     ;; inference to know if we should or should not parse a string (or not stringify an object).
                     (let [res (formatter (common/format-value r))]
                       (if-some [num-str (:num-str res)]
                         num-str
                         res)))
                   @ordered-formatters ordered-row))
            writer)
          (.flush writer)))

      (finish! [_ _]
        (.write writer "\n]")
        (.flush writer)
        (.flush os)
        (.close writer)))))
(defmethod qp.si/stream-options :api
  ([_]   (qp.si/stream-options :api nil))
  ([_ _] {:content-type "application/json; charset=utf-8"}))

{:a 100, :b 200} ; -> "a":100,"b":200

(defn- map->serialized-json-kvs
  ^String [m]
  (when (seq m)
    (let [s (json/generate-string m)]
      (.substring s 1 (dec (count s))))))
(defmethod qp.si/streaming-results-writer :api
  [_ ^OutputStream os]
  (let [writer (BufferedWriter. (OutputStreamWriter. os StandardCharsets/UTF_8))]
    (reify qp.si/StreamingResultsWriter
      (begin! [_ _ _]
        (.write writer "{\"data\":{\"rows\":[\n"))

      (write-row! [_ row row-num _ _]
        (when-not (zero? row-num)
          (.write writer ",\n"))
        (json/generate-stream row writer)
        (.flush writer))

      (finish! [_ {:keys [data], :as metadata}]
        (let [data-kvs-str           (map->serialized-json-kvs data)
              other-metadata-kvs-str (map->serialized-json-kvs (dissoc metadata :data))]
          ;; close data.rows
          (.write writer "\n]")
          ;; write any remaining keys in data
          (when (seq data-kvs-str)
            (.write writer ",\n")
            (.write writer data-kvs-str))
          ;; close data
          (.write writer "}")
          ;; write any remaining top-level keys
          (when (seq other-metadata-kvs-str)
            (.write writer ",\n")
            (.write writer other-metadata-kvs-str))
          ;; close top-level map
          (.write writer "}"))
        (.flush writer)
        (.flush os)
        (.close writer)))))
 
(ns metabase.query-processor.streaming.xlsx
  (:require
   [cheshire.core :as json]
   [clojure.string :as str]
   [dk.ative.docjure.spreadsheet :as spreadsheet]
   [java-time.api :as t]
   [metabase.lib.schema.temporal-bucketing
    :as lib.schema.temporal-bucketing]
   [metabase.query-processor.streaming.common :as common]
   [metabase.query-processor.streaming.interface :as qp.si]
   [metabase.shared.models.visualization-settings :as mb.viz]
   [metabase.shared.util.currency :as currency]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date]
   [metabase.util.i18n :refer [tru]])
  (:import
   (java.io OutputStream)
   (java.time LocalDate LocalDateTime LocalTime OffsetDateTime OffsetTime ZonedDateTime)
   (org.apache.poi.ss.usermodel Cell DataFormat DateUtil Workbook)
   (org.apache.poi.ss.util CellRangeAddress)
   (org.apache.poi.xssf.streaming SXSSFRow SXSSFSheet SXSSFWorkbook)))
(set! *warn-on-reflection* true)

+----------------------------------------------------------------------------------------------------------------+ | Format string generation | +----------------------------------------------------------------------------------------------------------------+

If any of these settings are present, we should format the column as a number.

(def ^:private number-setting-keys
  #{::mb.viz/number-style
    ::mb.viz/number-separators
    ::mb.viz/currency
    ::mb.viz/currency-style
    ::mb.viz/currency-in-header
    ::mb.viz/decimals
    ::mb.viz/scale
    ::mb.viz/prefix
    ::mb.viz/suffix})

If any of these settings are present, we should format the column as a date and/or time.

(def ^:private datetime-setting-keys
  #{::mb.viz/date-style
    ::mb.viz/date-separator
    ::mb.viz/date-abbreviate
    ::mb.viz/time-enabled
    ::mb.viz/time-style})

Adds a currency to the base format string as either a suffix (for pluralized names) or prefix (for symbols or codes).

(defn- currency-format-string
  [base-string format-settings]
  (let [currency-code (::mb.viz/currency format-settings "USD")
        currency-identifier (common/currency-identifier format-settings)]
    (condp = (::mb.viz/currency-style format-settings "symbol")
      "symbol"
      (if (currency/supports-symbol? currency-code)
        (str "[$" currency-identifier "]" base-string)
        (str "[$" currency-identifier "] " base-string))
      "code"
      (str "[$" currency-identifier "] " base-string)
      "name"
      (str base-string "\" " currency-identifier "\""))))

Use default formatting for decimal number types that have no other format settings defined aside from prefix, suffix or scale.

(defn- unformatted-number?
  [format-settings]
  (and
   ;; This is a decimal or currency number (not a percentage or scientific notation)
   (or (= (::mb.viz/number-style format-settings) "decimal")
       (= (::mb.viz/number-style format-settings) "currency")
       (not (::mb.viz/number-style format-settings)))
   ;; Custom number formatting options are not set
   (not (seq (dissoc format-settings
                     ::mb.viz/number-style
                     ::mb.viz/number-separators
                     ::mb.viz/scale
                     ::mb.viz/prefix
                     ::mb.viz/suffix)))))

Returns format strings for a number column corresponding to the given settings. The first value in the returned list should be used for integers, or numbers that round to integers. The second number should be used for all other values.

(defn- number-format-strings
  [{::mb.viz/keys [prefix suffix number-style number-separators currency-in-header decimals] :as format-settings}]
  (let [format-strings
        (let [base-string     (if (= number-separators ".")
                                ;; Omit thousands separator if ommitted in the format settings. Otherwise ignore
                                ;; number separator settings, since custom separators are not supported in XLSX.
                                "###0"
                                "#,##0")
              decimals        (or decimals 2)
              base-strings    (if (unformatted-number? format-settings)
                                ;; [int-format, float-format]
                                [base-string (str base-string ".##")]
                                (repeat 2 (apply str base-string (when (> decimals 0) (apply str "." (repeat decimals "0"))))))]
          (condp = number-style
            "percent"
            (map #(str % "%") base-strings)
            "scientific"
            (map #(str % "E+0") base-strings)
            "decimal"
            base-strings
            (if (and (= number-style "currency")
                     (false? currency-in-header))
              (map #(currency-format-string % format-settings) base-strings)
              base-strings)))]
    (map
     (fn [format-string]
      (str
        (when prefix (str "\"" prefix "\""))
        format-string
        (when suffix (str "\"" suffix "\""))))
     format-strings)))
(defn- abbreviate-date-names
  [format-settings format-string]
  (if (::mb.viz/date-abbreviate format-settings false)
    (-> format-string
        (str/replace "mmmm" "mmm")
        (str/replace "dddd" "ddd"))
    format-string))
(defn- replace-date-separators
  [format-settings format-string]
  (let [separator (::mb.viz/date-separator format-settings "/")]
    (str/replace format-string "/" separator)))
(defn- time-format
  [format-settings]
  (let [base-time-format (condp = (::mb.viz/time-enabled format-settings "minutes")
                               "minutes"
                               "h:mm"
                               "seconds"
                               "h:mm:ss"
                               "milliseconds"
                               "h:mm:ss.000"
                               ;; {::mb.viz/time-enabled nil} indicates that time is explicitly disabled, rather than
                               ;; defaulting to "minutes"
                               nil
                               nil)]
    (when base-time-format
      (condp = (::mb.viz/time-style format-settings "h:mm A")
        "HH:mm"
        (str "h" base-time-format)
        ;; Deprecated time style which should be already converted to HH:mm when viz settings are
        ;; normalized, but we'll handle it here too just in case. (#18112)
        "k:mm"
        (str "h" base-time-format)
        "h:mm A"
        (str base-time-format " am/pm")
        "h A"
        "h am/pm"))))

Adds the appropriate time setting to a date format string if necessary, producing a datetime format string.

(defn- add-time-format
  [format-settings unit format-string]
  (if (or (not unit)
          (lib.schema.temporal-bucketing/time-bucketing-units unit)
          (= :default unit))
    (if-let [time-format (time-format format-settings)]
      (cond->> time-format
               (seq format-string)
               (str format-string ", "))
      format-string)
    format-string))

For a given date format, returns the format to use in exports if :unit is :month

(defn- month-style
  [date-format]
  (case date-format
    "m/d/yyyy" "m/yyyy"
    "yyyy/m/d" "yyyy/m"
    ;; Default for all other styles
    "mmmm, yyyy"))
(defn- date-format
  [format-settings unit]
  (let [base-style (u/lower-case-en (::mb.viz/date-style format-settings "mmmm d, yyyy"))
        unit-style (case unit
                     :month (month-style base-style)
                     :year "yyyy"
                     base-style)]
    (->> unit-style
         (abbreviate-date-names format-settings)
         (replace-date-separators format-settings))))
(defn- datetime-format-string
  ([format-settings]
   (datetime-format-string format-settings nil))
  ([format-settings unit]
   (->> (date-format format-settings unit)
        (add-time-format format-settings unit))))

Returns a vector of format strings for a datetime column or number column, corresponding to the provided format settings.

(defn- format-settings->format-strings
  [format-settings {semantic-type  :semantic_type
                    effective-type :effective_type
                    base-type      :base_type
                    unit           :unit :as col}]
  (let [col-type (common/col-type col)]
    (u/one-or-many
      (cond
        ;; Primary key or foreign key
        (isa? col-type :Relation/*)
        "0"
        ;; This logic is a guard against someone setting the semantic type of a non-temporal value like 1.0 to temporal.
        ;; It will not apply formatting to the value in this case.
        (and (or (some #(contains? datetime-setting-keys %) (keys format-settings))
                 (isa? semantic-type :type/Temporal))
             (or (isa? effective-type :type/Temporal)
                 (isa? base-type :type/Temporal)))
        (datetime-format-string format-settings unit)
        (or (some #(contains? number-setting-keys %) (keys format-settings))
            (isa? col-type :type/Currency))
        (number-format-strings format-settings)))))

+----------------------------------------------------------------------------------------------------------------+ | XLSX export logic | +----------------------------------------------------------------------------------------------------------------+

(defmethod qp.si/stream-options :xlsx
  ([_]
   (qp.si/stream-options :xlsx "query_result"))
  ([_ filename-prefix]
   {:content-type              "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
    :write-keepalive-newlines? false
    :status                    200
    :headers                   {"Content-Disposition" (format "attachment; filename=\"%s_%s.xlsx\""
                                                              (or filename-prefix "query_result")
                                                              (u.date/format (t/zoned-date-time)))}}))
(defn- cell-string-format-style
  [^Workbook workbook ^DataFormat data-format format-string]
  (doto (.createCellStyle workbook)
    (.setDataFormat (. data-format getFormat ^String format-string))))

Compute a sequence of cell styles for each column

(defn- compute-column-cell-styles
  [^Workbook workbook ^DataFormat data-format viz-settings cols]
  (for [col cols]
    (let [settings       (common/viz-settings-for-col col viz-settings)
          format-strings (format-settings->format-strings settings col)]
      (when (seq format-strings)
        (map
          (partial cell-string-format-style workbook data-format)
          format-strings)))))

Default strings to use for datetime and number fields if custom format settings are not set.

(defn- default-format-strings
  []
  {:datetime (datetime-format-string (common/merge-global-settings {} :type/Temporal))
   :date     (datetime-format-string (common/merge-global-settings {::mb.viz/time-enabled nil} :type/Temporal))
   ;; Use a fixed format for time fields since time formatting isn't currently supported (#17357)
   :time     "h:mm am/pm"
   :integer  "#,##0"
   :float    "#,##0.##"})

Compute default cell styles based on column types

(defn- compute-typed-cell-styles
  ;; These are tested, but does this happen IRL?
  [^Workbook workbook ^DataFormat data-format]
  (update-vals
    (default-format-strings)
    (partial cell-string-format-style workbook data-format)))

Returns whether a number should be formatted as an integer after being rounded to 2 decimal places.

(defn- rounds-to-int?
  [value]
  (let [rounded (.setScale (bigdec value) 2 java.math.RoundingMode/HALF_UP)]
    (== (bigint rounded) rounded)))

Sets a cell to the provided value, with an appropriate style if necessary.

This is based on the equivalent multimethod in Docjure, but adapted to support Metabase viz settings.

(defmulti ^:private set-cell!
  (fn [^Cell _cell value _styles _typed-styles]
    (type value)))

Temporal values in Excel are just NUMERIC cells that are stored in a floating-point format and have some cell styles applied that dictate how to format them

(defmethod set-cell! LocalDate
  [^Cell cell ^LocalDate t styles typed-styles]
  (.setCellValue cell t)
  (.setCellStyle cell (or (first styles) (typed-styles :date))))
(defmethod set-cell! LocalDateTime
  [^Cell cell ^LocalDateTime t styles typed-styles]
  (.setCellValue cell t)
  (.setCellStyle cell (or (first styles) (typed-styles :datetime))))
(defmethod set-cell! LocalTime
  [^Cell cell t styles typed-styles]
  ;; there's no `.setCellValue` for a `LocalTime` -- but all the built-in impls for `LocalDate` and `LocalDateTime` do
  ;; anyway is convert the date(time) to an Excel datetime floating-point number and then set that.
  ;;
  ;; `DateUtil/convertTime` will convert a *time* string to an Excel number; after that we can set the numeric value
  ;; directly.
  ;;
  ;; See https://poi.apache.org/apidocs/4.1/org/apache/poi/ss/usermodel/DateUtil.html#convertTime-java.lang.String-
  (.setCellValue cell (DateUtil/convertTime (u.date/format "HH:mm:ss" t)))
  (.setCellStyle cell (or (first styles) (typed-styles :time))))
(defmethod set-cell! OffsetTime
  [^Cell cell t styles typed-styles]
  (set-cell! cell (t/local-time (common/in-result-time-zone t)) styles typed-styles))
(defmethod set-cell! OffsetDateTime
  [^Cell cell t styles typed-styles]
  (set-cell! cell (t/local-date-time (common/in-result-time-zone t)) styles typed-styles))
(defmethod set-cell! ZonedDateTime
  [^Cell cell t styles typed-styles]
  (set-cell! cell (t/offset-date-time t) styles typed-styles))
(defmethod set-cell! String
  [^Cell cell value _styles _typed-styles]
  (.setCellValue cell ^String value))
(defmethod set-cell! Number
  [^Cell cell value styles typed-styles]
  (let [v (double value)]
    (.setCellValue cell v)
    ;; Do not set formatting for ##NaN, ##Inf, or ##-Inf
    (when (u/real-number? v)
      (let [[int-style float-style] styles]
        (if (rounds-to-int? v)
          (.setCellStyle cell (or int-style (typed-styles :integer)))
          (.setCellStyle cell (or float-style (typed-styles :float))))))))
(defmethod set-cell! Boolean
  [^Cell cell value _styles _typed-styles]
  (.setCellValue cell ^Boolean value))

add a generic implementation for the method that writes values to XLSX cells that just piggybacks off the implementations we've already defined for encoding things as JSON. These implementations live in metabase.server.middleware.

(defmethod set-cell! Object
  [^Cell cell value _styles _typed-styles]
  ;; stick the object in a JSON map and encode it, which will force conversion to a string. Then unparse that JSON and
  ;; use the resulting value as the cell's new String value.  There might be some more efficient way of doing this but
  ;; I'm not sure what it is.
  (.setCellValue cell (str (-> (json/generate-string {:v value})
                               (json/parse-string keyword)
                               :v))))
(defmethod set-cell! nil [^Cell cell _value _styles _typed-styles]
  (.setBlank cell))

When true, XLSX exports will attempt to parse string values into corresponding java.time classes so that formatting can be applied. This should be enabled for generation of pulse/dashboard subscription attachments.

(def ^:dynamic *parse-temporal-string-values*
  false)

Adds a row of values to the spreadsheet. Values with the scaled viz setting are scaled prior to being added.

This is based on the equivalent function in Docjure, but adapted to support Metabase viz settings.

(defn- maybe-parse-temporal-value
  [value col]
  (when (and *parse-temporal-string-values*
             (isa? (:effective_type col) :type/Temporal)
             (string? value))
    (try (u.date/parse value)
         ;; Fallback to plain string value if it couldn't be parsed
         (catch Exception _ value
                value))))
(defn- add-row!
  [^SXSSFSheet sheet values cols col-settings cell-styles typed-cell-styles]
  (let [row-num (if (= 0 (.getPhysicalNumberOfRows sheet))
                  0
                  (inc (.getLastRowNum sheet)))
        row     (.createRow sheet row-num)]
    (doseq [[value col styles index] (map vector values cols cell-styles (range (count values)))]
      (let [id-or-name   (or (:id col) (:name col))
            settings     (or (get col-settings {::mb.viz/field-id id-or-name})
                             (get col-settings {::mb.viz/column-name id-or-name}))
            scaled-val   (if (and value (::mb.viz/scale settings))
                           (* value (::mb.viz/scale settings))
                           value)
            ;; Temporal values are converted into strings in the format-rows QP middleware, which is enabled during
            ;; dashboard subscription/pulse generation. If so, we should parse them here so that formatting is applied.
            parsed-value (or
                           (maybe-parse-temporal-value value col)
                           scaled-val)]
        (set-cell! (.createCell ^SXSSFRow row ^Integer index) parsed-value styles typed-cell-styles)))
    row))

The maximum number of rows we should use for auto-sizing. If this number is too large, exports of large datasets will be prohibitively slow.

(def ^:dynamic *auto-sizing-threshold*
  100)

The extra width applied to columns after they have been auto-sized, in units of 1/256 of a character width. This ensures the cells in the header row have enough room for the filter dropdown icon.

(def ^:private extra-column-width
  (* 4 256))

Cap column widths at 255 characters

(def ^:private max-column-width
  (* 255 256))

Adjusts each column to fit its largest value, plus a constant amount of extra padding.

(defn- autosize-columns!
  [sheet]
  (doseq [i (.getTrackedColumnsForAutoSizing ^SXSSFSheet sheet)]
    (.autoSizeColumn ^SXSSFSheet sheet i)
    (.setColumnWidth ^SXSSFSheet sheet i (min max-column-width
                                              (+ (.getColumnWidth ^SXSSFSheet sheet i) extra-column-width)))
    (.untrackColumnForAutoSizing ^SXSSFSheet sheet i)))

Turns on auto-filter for the header row, which adds a button to each header cell that allows columns to be filtered and sorted. Also freezes the header row so that it floats above the data.

(defn- setup-header-row!
  [sheet col-count]
  (when (> col-count 0)
    (.setAutoFilter ^SXSSFSheet sheet (new CellRangeAddress 0 0 0 (dec col-count)))
    (.createFreezePane ^SXSSFSheet sheet 0 1)))
(defmethod qp.si/streaming-results-writer :xlsx
  [_ ^OutputStream os]
  (let [workbook    (SXSSFWorkbook.)
        sheet       (spreadsheet/add-sheet! workbook (tru "Query result"))
        data-format (. workbook createDataFormat)
        cell-styles (volatile! nil)
        typed-cell-styles (volatile! nil)]
    (reify qp.si/StreamingResultsWriter
      (begin! [_ {{:keys [ordered-cols]} :data} {col-settings ::mb.viz/column-settings :as viz-settings}]
        (vreset! cell-styles (compute-column-cell-styles workbook data-format viz-settings ordered-cols))
        (vreset! typed-cell-styles (compute-typed-cell-styles workbook data-format))
        (doseq [i (range (count ordered-cols))]
          (.trackColumnForAutoSizing ^SXSSFSheet sheet i))
        (setup-header-row! sheet (count ordered-cols))
        (spreadsheet/add-row! sheet (common/column-titles ordered-cols col-settings)))

      (write-row! [_ row row-num ordered-cols {:keys [output-order] :as viz-settings}]
        (let [ordered-row  (if output-order
                             (let [row-v (into [] row)]
                               (for [i output-order] (row-v i)))
                             row)
              col-settings (::mb.viz/column-settings viz-settings)]
          (add-row! sheet ordered-row ordered-cols col-settings @cell-styles @typed-cell-styles)
          (when (= (inc row-num) *auto-sizing-threshold*)
            (autosize-columns! sheet))))

      (finish! [_ {:keys [row_count]}]
        (when (or (nil? row_count) (< row_count *auto-sizing-threshold*))
          ;; Auto-size columns if we never hit the row threshold, or a final row count was not provided
          (autosize-columns! sheet))
        (try
          (spreadsheet/save-workbook-into-stream! os workbook)
          (finally
            (.dispose workbook)
            (.close os)))))))
 

Functions for fetching the timezone for the current query.

(ns metabase.query-processor.timezone
  (:require
   [java-time.api :as t]
   [metabase.config :as config]
   [metabase.driver :as driver]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.query-processor.store :as qp.store]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log])
  (:import
   (java.time ZonedDateTime)))
(set! *warn-on-reflection* true)
(def ^:private ^:dynamic *report-timezone-id-override* nil)
(def ^:private ^:dynamic *database-timezone-id-override* nil)
(def ^:private ^:dynamic *results-timezone-id-override* nil)

TODO - consider making this metabase.util.date-2/the-timezone-id

(defn- valid-timezone-id [timezone-id]
  (when (and (string? timezone-id)
             (seq timezone-id))
    (try
      (t/zone-id timezone-id)
      timezone-id
      (catch Throwable _
        (log/warn (tru "Invalid timezone ID ''{0}''" timezone-id))
        nil))))
(defn- report-timezone-id* []
  (or *report-timezone-id-override*
      (driver/report-timezone)))

+----------------------------------------------------------------------------------------------------------------+ | Public Interface | +----------------------------------------------------------------------------------------------------------------+

Timezone ID for the report timezone, if the current driver and database supports it. (If the current driver supports it, this is bound by the bind-effective-timezone middleware.)

(defn report-timezone-id-if-supported
  (^String []
   (report-timezone-id-if-supported driver/*driver* (lib.metadata/database (qp.store/metadata-provider))))
  (^String [driver database]
   (when (driver/database-supports? driver :set-timezone database)
     (valid-timezone-id (report-timezone-id*)))))

The timezone that the current database is in, as determined by the most recent sync.

(defn database-timezone-id
  (^String []
   (database-timezone-id ::db-from-store))
  (^String [database]
   (valid-timezone-id
    (or *database-timezone-id-override*
        (let [database (if (= database ::db-from-store)
                         (lib.metadata/database (qp.store/metadata-provider))
                         database)]
          (:timezone database))))))

The system timezone of this Metabase instance.

(defn system-timezone-id
  ^String []
  (.. (t/system-clock) getZone getId))

The timezone that we would like to run a query in, regardless of whether we are actually able to do so. This is always equal to the value of the report-timezone Setting (if it is set), otherwise the database timezone (if known), otherwise the system timezone.

(defn requested-timezone-id
  ^String []
  (valid-timezone-id (report-timezone-id*)))

The timezone that a query is actually ran in ­ report timezone, if set and supported by the current driver; otherwise the timezone of the database (if known), otherwise the system timezone. Guaranteed to always return a timezone ID ­ never returns nil.

(defn results-timezone-id
  (^String []
   (results-timezone-id driver/*driver* ::db-from-store))
  (^String [database]
   (results-timezone-id (:engine database) database))
  (^String [driver database & {:keys [use-report-timezone-id-if-unsupported?]
                               :or   {use-report-timezone-id-if-unsupported? false}}]
   (valid-timezone-id
    (or *results-timezone-id-override*
        (if use-report-timezone-id-if-unsupported?
          (valid-timezone-id (report-timezone-id*))
          (report-timezone-id-if-supported driver database))
        ;; don't actually fetch DB from store unless needed — that way if `*results-timezone-id-override*` is set we
        ;; don't need to init a store during tests
        (database-timezone-id database)
        ;; NOTE: if we don't have an explicit report-timezone then use the JVM timezone
        ;;       this ensures alignment between the way dates are processed by JDBC and our returned data
        ;;       GH issues: #2282, #2035
        (system-timezone-id)))))

Get the current moment in time adjusted to the results timezone ID, e.g. for relative datetime calculations.

(def ^ZonedDateTime now
  (comp (fn [timezone-id]
          (t/with-zone-same-instant (t/zoned-date-time) (t/zone-id timezone-id)))
        results-timezone-id))

normally I'd do this inline with the def form above but it busts Eastwood

(when config/is-dev?
  (alter-meta! #'now assoc :arglists (:arglists (meta #'results-timezone-id))))
 

Utility functions used by the global query processor and middleware functions.

(ns metabase.query-processor.util
  (:require
   [buddy.core.codecs :as codecs]
   [buddy.core.hash :as buddy-hash]
   [cheshire.core :as json]
   [clojure.string :as str]
   [medley.core :as m]
   [metabase.driver :as driver]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.util :as u]
   [metabase.util.malli :as mu]))
(set! *warn-on-reflection* true)

TODO - I think most of the functions in this namespace that we don't remove could be moved to [[metabase.mbql.util]]

Is the given query an MBQL query without a :limit, :aggregation, or :page clause?

(defn query-without-aggregations-or-limits?
  [{{aggregations :aggregation, :keys [limit page]} :query}]
  (and (not limit)
       (not page)
       (empty? aggregations)))

Generates the default query remark. Exists as a separate function so that overrides of the query->remark multimethod can access the default value.

(defn default-query->remark
  [{{:keys [executed-by query-hash], :as _info} :info, query-type :type}]
  (str "Metabase" (when executed-by
                    (assert (instance? (Class/forName "[B") query-hash))
                    (format ":: userID: %s queryType: %s queryHash: %s"
                            executed-by
                            (case (keyword query-type)
                              :query  "MBQL"
                              :native "native")
                            (codecs/bytes->hex query-hash)))))

Generate an appropriate remark ^String to be prepended to a query to give DBAs additional information about the query being executed. See documentation for [[metabase.driver/mbql->native]] and #2386. for more information.

So this turns your average 10, 20, 30 character query into a 110, 120, 130 etc character query. One leaky-abstraction part of this is that this will confuse the bejeezus out of people who first encounter their passed-through RDBMS error messages.

'Hey, this is a 20 character query! What's it talking about, error at position 120?' This gets fixed, but in a spooky-action-at-a-distance way, in frontend/src/metabase/query_builder/components/VisualizationError.jsx

(defmulti query->remark
  {:arglists '(^String [driver query])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
(defmethod query->remark :default
  [_ query]
  (default-query->remark query))

------------------------------------------------- Normalization --------------------------------------------------

TODO - this has been moved to metabase.mbql.util; use that implementation instead.

(mu/defn ^:deprecated normalize-token :- :keyword
  "Convert a string or keyword in various cases (`lisp-case`, `snake_case`, or `SCREAMING_SNAKE_CASE`) to a lisp-cased
  keyword."
  [token :- [:or :keyword :string]]
  (-> (name token)
      u/lower-case-en
      (str/replace #"_" "-")
      keyword))

---------------------------------------------------- Hashing -----------------------------------------------------

Return query with only the keys relevant to hashing kept. (This is done so irrelevant info or options that don't affect query results doesn't result in the same query producing different hashes.)

(mu/defn ^:private select-keys-for-hashing
  [query :- :map]
  (let [{:keys [constraints parameters], :as query} (select-keys query [:database :type :query :native :parameters
                                                                        :constraints])]
    (cond-> query
      (empty? constraints) (dissoc :constraints)
      (empty? parameters)  (dissoc :parameters))))
#_{:clj-kondo/ignore [:non-arg-vec-return-type-hint]}
(mu/defn ^"[B" query-hash :- bytes?
  "Return a 256-bit SHA3 hash of `query` as a key for the cache. (This is returned as a byte array.)"
  [query :- :map]
  (buddy-hash/sha3-256 (json/generate-string (select-keys-for-hashing query))))

--------------------------------------------- Query Source Card IDs ----------------------------------------------

Return the ID of the Card used as the "source" query of this query, if applicable; otherwise return nil.

(defn query->source-card-id
  ^Integer [outer-query]
  (let [source-table (get-in outer-query [:query :source-table])]
    (when (string? source-table)
      (when-let [[_ card-id-str] (re-matches #"^card__(\d+$)" source-table)]
        (Integer/parseInt card-id-str)))))

------------------------------------------- Metadata Combination Utils --------------------------------------------

A standard and repeatable way to address a column. Names can collide and sometimes are not unique. Field refs should be stable, except we have to exclude the last part as extra information can be tucked in there. Names can be non-unique at times, numeric ids are not guaranteed.

(defn field-ref->key
  [[tyype identifier]]
  [tyype identifier])

Set of FieldOptions that only mattered for identification purposes.

(def field-options-for-identification
   ;; base-type is required for field that use name instead of id
  #{:source-field :join-alias :base-type})
(defn- field-normalizer
  [field]
  (let [[type id-or-name options ] (mbql.normalize/normalize-tokens field)]
    [type id-or-name (select-keys options field-options-for-identification)]))

Given a field and resultmetadata, return a map of information about the field if resultmetadata contains a matched field.

(defn field->field-info
  [field result-metadata]
  (let [[_ttype id-or-name options :as field] (field-normalizer field)]
    (or
      ;; try match field_ref first
      (first (filter (fn [field-info]
                       (= field
                          (-> field-info
                              :field_ref
                              field-normalizer)))
                     result-metadata))
      ;; if not match name and base type for aggregation or field with string id
      (first (filter (fn [field-info]
                       (and (= (:name field-info)
                               id-or-name)
                            (= (:base-type options)
                               (:base_type field-info))))
                     result-metadata)))))

Keys that can survive merging metadata from the database onto metadata computed from the query. When merging metadata, the types returned should be authoritative. But things like semantictype, displayname, and description can be merged on top.

(def preserved-keys
  ;; TODO: ideally we don't preserve :id but some notion of :user-entered-id or :identified-id
  [:id :description :display_name :semantic_type
   :fk_target_field_id :settings :visibility_type])

Blend saved metadata from previous runs into fresh metadata from an actual run of the query.

Ensure that saved metadata from datasets or source queries can remain in the results metadata. We always recompute metadata in general, so need to blend the saved metadata on top of the computed metadata. First argument should be the metadata from a run from the query, and pre-existing should be the metadata from the database we wish to ensure survives.

(defn combine-metadata
  [fresh pre-existing]
  (let [by-key (m/index-by (comp field-ref->key :field_ref) pre-existing)]
    (for [{:keys [field_ref source] :as col} fresh]
      (if-let [existing (and (not= :aggregation source)
                             (get by-key (field-ref->key field_ref)))]
        (merge col (select-keys existing preserved-keys))
        col))))
 

Walks query and generates appropriate aliases for every selected column; and adds extra keys to the corresponding MBQL clauses with this information. Deduplicates aliases and calls [[metabase.driver/escape-alias]] with the generated aliases. Adds information about the aliases in source queries and joins that correspond to columns in the parent level.

This code is currently opt-in, and is currently only used by SQL drivers ([[metabase.driver.sql.query-processor]] manually calls [[add-alias-info]] inside of [[metabase.driver.sql.query-processor/mbql->native]] and [[metabase.driver.mongo.query-processor/mbql->native]]) but at some point in the future this may become general QP middleware that can't be opted out of.

[[add-alias-info]] adds some or all of the following keys to every :field clause, :expression reference, and :aggregation reference:

`::source-table`

String name, integer Table ID, the keyword ::source, or the keyword ::none. Use this alias to qualify the clause during compilation.

  • String names are aliases for joins. This name should be used literally.

  • An integer Table ID means this comes from the :source-table; use the Table's schema and name to qualify the clause. (Some databases also need to qualify Fields with the Database name.)

  • ::source means this clause comes from the :source-query; the alias to use is theoretically driver-specific but in practice is source (see [[metabase.driver.sql.query-processor/source-query-alias]]).

  • ::none means this clause SHOULD NOT be qualified at all. ::none is currently only used in some very special circumstances, specially by the Spark SQL driver when compiling Field Filter replacement snippets. But it's here for those sorts of cases where we need it.

TODO -- consider allowing vectors of multiple qualifiers e.g. [schema table] or [database schema table] as well -- so drivers that need to modify these can rewrite this info appropriately.

`::source-alias`

String name to use to refer to this clause during compilation.

`::desired-alias`

If this clause is 'selected' (i.e., appears in :fields, :aggregation, or :breakout), select the clause AS this alias. This alias is guaranteed to be unique.

`::position`

If this clause is 'selected', this is the position the clause will appear in the results (i.e. the corresponding column index).

(ns metabase.query-processor.util.add-alias-info
  (:require
   [clojure.walk :as walk]
   [medley.core :as m]
   [metabase.driver :as driver]
   [metabase.driver.sql.query-processor.deprecated :as sql.qp.deprecated]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.store :as qp.store]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.malli :as mu]))

Generate a field alias by applying prefix to field-alias. This is used for automatically-generated aliases for columns that are the result of joins.

(defn prefix-field-alias
  [prefix field-alias]
  (driver/escape-alias driver/*driver* (str prefix "__" field-alias)))

Creates a function with the signature

(unique-alias position original-alias)

To return a uniquified version of original-alias. Memoized by position, so duplicate calls will result in the same unique alias.

(defn- make-unique-alias-fn
  []
  (let [unique-name-fn (mbql.u/unique-name-generator
                        ;; some databases treat aliases as case-insensitive so make sure the generated aliases are
                        ;; unique regardless of case
                        :name-key-fn u/lower-case-en
                        ;; TODO -- we should probably limit the length somehow like we do in
                        ;; [[metabase.query-processor.middleware.add-implicit-joins/join-alias]], and also update this
                        ;; function and that one to append a short suffix if we are limited by length. See also
                        ;; [[driver/escape-alias]]
                        :unique-alias-fn (fn [original suffix]
                                           (driver/escape-alias driver/*driver* (str original \_ suffix))))]
    (fn unique-alias-fn [position original-alias]
      (unique-name-fn position (driver/escape-alias driver/*driver* original-alias)))))

TODO -- this should probably limit the resulting alias, and suffix a short hash as well if it gets too long. See also [[unique-alias-fn]] below.

(defn- remove-namespaced-options [options]
  (when options
    (not-empty (into {}
                     (remove (fn [[k _]]
                               (when (keyword? k)
                                 (namespace k))))
                     options))))

Normalize a :field/:expression/:aggregation clause by removing extra info so it can serve as a key for :qp/refs. This removes :source-field if it is present -- don't use the output of this for anything but internal key/distinct comparison purposes.

(defn normalize-clause
  [clause]
  (mbql.u/match-one clause
    ;; optimization: don't need to rewrite a `:field` clause without any options
    [:field _ nil]
    &match
    [:field id-or-name opts]
    ;; this doesn't use [[mbql.u/update-field-options]] because this gets called a lot and the overhead actually adds up
    ;; a bit
    [:field id-or-name (remove-namespaced-options (cond-> (dissoc opts :source-field :effective-type)
                                                    (integer? id-or-name) (dissoc :base-type)))]
    ;; for `:expression` and `:aggregation` references, remove the options map if they are empty.
    [:expression expression-name opts]
    (if-let [opts (remove-namespaced-options opts)]
      [:expression expression-name opts]
      [:expression expression-name])
    [:aggregation index opts]
    (if-let [opts (remove-namespaced-options opts)]
      [:aggregation index opts]
      [:aggregation index])
    _
    &match))

Get all the clauses that are returned by this level of the query as a map of normalized-clause -> index of that column in the results.

(defn- selected-clauses
  [{:keys [fields breakout aggregation], :as query}]
  ;; this is cached for the duration of the QP run because it's a little expensive to calculate and caching this speeds
  ;; up this namespace A LOT
  (qp.store/cached (select-keys query [:fields :breakout :aggregation])
    (into
     {}
     (comp cat
           (map-indexed
            (fn [i clause]
              [(normalize-clause clause) i])))
     [breakout
      (map-indexed
       (fn [i ag]
         (mbql.u/replace ag
           [:aggregation-options wrapped opts]
           [:aggregation i]
           ;; aggregation clause should be preprocessed into an `:aggregation-options` clause by now.
           _
           (throw (ex-info (tru "Expected :aggregation-options clause, got {0}" (pr-str ag))
                           {:type qp.error-type/qp, :clause ag}))))
       aggregation)
      fields])))

Get the position (i.e., column index) clause is returned as, if it is returned (i.e. if it is in :breakout, :aggregation, or :fields). Not all clauses are returned.

(defn- clause->position
  [inner-query clause]
  ((selected-clauses inner-query) (normalize-clause clause)))
(defn- this-level-join-aliases [{:keys [joins]}]
  (into #{} (map :alias) joins))
(defn- field-is-from-join-in-this-level? [inner-query [_field _id-or-name {:keys [join-alias]}]]
  (when join-alias
    ((this-level-join-aliases inner-query) join-alias)))
(mu/defn ^:private field-instance :- [:maybe lib.metadata/ColumnMetadata]
  [[_ id-or-name :as _field-clause] :- mbql.s/field]
  (when (integer? id-or-name)
    (lib.metadata/field (qp.store/metadata-provider) id-or-name)))
(defn- field-table-id [field-clause]
  (:table-id (field-instance field-clause)))
(mu/defn ^:private field-source-table-alias :- [:or
                                                ::lib.schema.common/non-blank-string
                                                ::lib.schema.id/table
                                                [:= ::source]]
  "Determine the appropriate `::source-table` alias for a `field-clause`."
  [{:keys [source-table source-query], :as inner-query} [_ _id-or-name {:keys [join-alias]}, :as field-clause]]
  (let [table-id            (field-table-id field-clause)
        join-is-this-level? (field-is-from-join-in-this-level? inner-query field-clause)]
    (cond
      join-is-this-level?                      join-alias
      (and table-id (= table-id source-table)) table-id
      source-query                             ::source
      :else
      (throw (ex-info (trs "Cannot determine the source table or query for Field clause {0}" (pr-str field-clause))
                      {:type   qp.error-type/invalid-query
                       :clause field-clause
                       :query  inner-query})))))
(defn- exports [query]
  (into #{} (mbql.u/match (dissoc query :source-query :source-metadata :joins)
              [(_ :guard #{:field :expression :aggregation-options}) _ (_ :guard (every-pred map? ::position))])))
(defn- join-with-alias [{:keys [joins]} join-alias]
  (some (fn [join]
          (when (= (:alias join) join-alias)
            join))
        joins))
(defn- fuzzify [clause]
  (mbql.u/update-field-options clause dissoc :temporal-unit :binning))
(defn- field-signature
  [field-clause]
  [(second field-clause) (get-in field-clause [2 :join-alias])])
(defn- matching-field-in-source-query*
  [source-query source-metadata field-clause & {:keys [normalize-fn]
                                                :or   {normalize-fn normalize-clause}}]
  (let [normalized    (normalize-fn field-clause)
        all-exports   (exports source-query)
        field-exports (filter (partial mbql.u/is-clause? :field)
                              all-exports)]
    ;; first look for an EXACT match in the `exports`
    (or (m/find-first (fn [a-clause]
                        (= (normalize-fn a-clause) normalized))
                      field-exports)
        ;; if there is no EXACT match, attempt a 'fuzzy' match by disregarding the `:temporal-unit` and `:binning`
        (let [fuzzy-normalized (fuzzify normalized)]
          (m/find-first (fn [a-clause]
                          (= (fuzzify (normalize-fn a-clause)) fuzzy-normalized))
                        field-exports))
        ;; if still no match try looking based for a matching Field based on ID.
        (let [[_field id-or-name _opts] field-clause]
          (when (integer? id-or-name)
            (m/find-first (fn [[_field an-id-or-name _opts]]
                            (= an-id-or-name id-or-name))
                          field-exports)))
        ;; look for a matching expression clause with the same name if still no match
        (when-let [field-name (let [[_ id-or-name] field-clause]
                                (when (string? id-or-name)
                                  id-or-name))]
          (or (m/find-first (fn [[_ expression-name :as _expression-clause]]
                              (= expression-name field-name))
                            (filter (partial mbql.u/is-clause? :expression) all-exports))
              (m/find-first (fn [[_ _ opts :as _aggregation-options-clause]]
                              (= (::source-alias opts) field-name))
                            (filter (partial mbql.u/is-clause? :aggregation-options) all-exports))))
        ;; look for a field referenced by the name in source-metadata
        (let [field-name (second field-clause)]
          (when (string? field-name)
            (when-let [column (m/find-first #(= (:name %) field-name) source-metadata)]
              (let [signature (field-signature (:field_ref column))]
                (m/find-first #(= (field-signature %) signature) field-exports))))))))

If field-clause is the result of a join at this level with a :source-query, return the 'source' :field clause from that source query.

(defn- matching-field-in-join-at-this-level
  [inner-query [_ _ {:keys [join-alias]} :as field-clause]]
  (when join-alias
    (let [{:keys [source-query source-metadata]} (join-with-alias inner-query join-alias)]
      (when source-query
        (matching-field-in-source-query*
         source-query
         source-metadata
         field-clause
         :normalize-fn #(mbql.u/update-field-options (normalize-clause %) dissoc :join-alias))))))

If field-clause is the result of a join at this level, return the ::desired-alias from that join (where the Field is introduced). This is the appropriate ::source-alias for such a Field.

(defn- field-alias-in-join-at-this-level
  [inner-query field-clause]
  (when-let [[_ _ {::keys [desired-alias]}] (matching-field-in-join-at-this-level inner-query field-clause)]
    desired-alias))
(defn- matching-field-in-source-query
  [{:keys [source-query source-metadata], :as inner-query} field-clause]
  (when (and source-query
             (= (field-source-table-alias inner-query field-clause) ::source))
    (matching-field-in-source-query* source-query source-metadata field-clause)))
(defn- field-alias-in-source-query
  [inner-query field-clause]
  (when-let [[_ _ {::keys [desired-alias]}] (matching-field-in-source-query inner-query field-clause)]
    desired-alias))

Generate a reference for the field instance field-inst appropriate for the driver driver. By default this is just the name of the field, but it can be more complicated, e.g., take parent fields into account.

DEPRECATED: Implement [[field-reference-mlv2]] instead, which accepts a kebab-case Field metadata rather than snake_case metadata.

(defmulti ^String field-reference
  {:added "0.46.0", :arglists '([driver field-inst]), :deprecated "0.48.0"}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)

Generate a reference for the field instance field-inst appropriate for the driver driver. By default this is just the name of the field, but it can be more complicated, e.g., take parent fields into account.

(defmulti ^String field-reference-mlv2
  {:added "0.48.0", :arglists '([driver field-inst])}
  driver/dispatch-on-initialized-driver
  :hierarchy #'driver/hierarchy)
(mu/defmethod field-reference-mlv2 ::driver/driver
  [driver :- :keyword
   field  :- lib.metadata/ColumnMetadata]
  #_{:clj-kondo/ignore [:deprecated-var]}
  (if (get-method field-reference driver)
    (do
      (sql.qp.deprecated/log-deprecation-warning
       driver
       `field-reference
       "0.48.0")
      (field-reference driver
                       #_{:clj-kondo/ignore [:deprecated-var]}
                       (qp.store/->legacy-metadata field)))
    (:name field)))

Actual name of a :field from the database or source query (for Field literals).

(defn- field-name
  [_inner-query [_ id-or-name :as field-clause]]
  (or (some->> field-clause
               field-instance
               (field-reference-mlv2 driver/*driver*))
      (when (string? id-or-name)
        id-or-name)))

Calculate extra stuff about field-clause that's a little expensive to calculate. This is done once so we can pass it around instead of recalculating it a bunch of times.

(defn- expensive-field-info
  [inner-query field-clause]
  {:field-name              (field-name inner-query field-clause)
   :join-is-this-level?     (field-is-from-join-in-this-level? inner-query field-clause)
   :alias-from-join         (field-alias-in-join-at-this-level inner-query field-clause)
   :alias-from-source-query (field-alias-in-source-query inner-query field-clause)})

Determine the appropriate ::source-alias for a field-clause.

(defn- field-source-alias
  {:arglists '([inner-query field-clause expensive-field-info])}
  [{:keys [_source-table], :as _inner-query}
   [_ _id-or-name {:keys [join-alias]}, :as _field-clause]
   {:keys [field-name join-is-this-level? alias-from-join alias-from-source-query]}]
  (cond
    ;; TODO -- this just recalculates the info instead of actually finding the Field in the join and getting its desired
    ;; alias there... this seems like a clear bug since it doesn't go thru the uniquify logic. Something will
    ;; potentially break by doing this. I haven't been able to reproduce it yet however.
    ;;
    ;; This will only be triggered if the join somehow exposes duplicate columns or columns that have the same escaped
    ;; name after going thru [[driver/escape-alias]]. I think the only way this could happen is if we escape them
    ;; aggressively but the escape logic produces duplicate columns (i.e., there is overlap between the unique hashes we
    ;; suffix to escaped identifiers.)
    ;;
    ;; We'll have to look into this more in the future. For now, it seems to work for everything we try it with.
    (and join-is-this-level? alias-from-join)  alias-from-join
    alias-from-source-query                    alias-from-source-query
    (and join-alias (not join-is-this-level?)) (prefix-field-alias join-alias field-name)
    :else                                      field-name))

Determine the appropriate ::desired-alias for a field-clause.

(defn- field-desired-alias
  {:arglists '([inner-query field-clause expensive-field-info])}
  [_inner-query
   [_ _id-or-name {:keys [join-alias]} :as _field-clause]
   {:keys [field-name alias-from-join alias-from-source-query]}]
  (cond
    join-alias              (prefix-field-alias join-alias (or alias-from-join field-name))
    alias-from-source-query alias-from-source-query
    :else                   field-name))
(defmulti ^:private clause-alias-info
  {:arglists '([inner-query unique-alias-fn clause])}
  (fn [_ _ [clause-type]]
    clause-type))
(defmethod clause-alias-info :field
  [inner-query unique-alias-fn field-clause]
  (let [expensive-info (expensive-field-info inner-query field-clause)]
    (merge {::source-table (field-source-table-alias inner-query field-clause)
            ::source-alias (field-source-alias inner-query field-clause expensive-info)}
           (when-let [position (clause->position inner-query field-clause)]
             {::desired-alias (unique-alias-fn position (field-desired-alias inner-query field-clause expensive-info))
              ::position      position}))))
(defmethod clause-alias-info :aggregation
  [{aggregations :aggregation, :as inner-query} unique-alias-fn [_ index _opts :as ag-ref-clause]]
  (let [position (clause->position inner-query ag-ref-clause)]
    ;; an aggregation is ALWAYS returned, so it HAS to have a `position`. If it does not, the aggregation reference
    ;; is busted.
    (when-not position
      (throw (ex-info (tru "Aggregation does not exist at index {0}" index)
                      {:type   qp.error-type/invalid-query
                       :clause ag-ref-clause
                       :query  inner-query})))
    (let [[_ _ {ag-name :name} :as matching-ag] (nth aggregations index)]
      ;; make sure we have an `:aggregation-options` clause like we expect. This is mostly a precondition check
      ;; since we should never be running this code on not-preprocessed queries, so it's not i18n'ed
      (when-not (mbql.u/is-clause? :aggregation-options matching-ag)
        (throw (ex-info (format "Expected :aggregation-options, got %s. (Query must be fully preprocessed.)"
                                (pr-str matching-ag))
                        {:clause ag-ref-clause, :query inner-query})))
      {::desired-alias (unique-alias-fn position ag-name)
       ::position      position})))
(defmethod clause-alias-info :expression
  [inner-query unique-alias-fn [_ expression-name :as expression-ref-clause]]
  (when-let [position (clause->position inner-query expression-ref-clause)]
    {::desired-alias (unique-alias-fn position expression-name)
     ::position      position}))
(defn- add-info-to-aggregation-definition
  [inner-query unique-alias-fn [_ wrapped-ag-clause {original-ag-name :name, :as opts}, :as _ag-clause] ag-index]
  (let [position     (clause->position inner-query [:aggregation ag-index])
        unique-alias (unique-alias-fn position original-ag-name)]
    [:aggregation-options wrapped-ag-clause (assoc opts
                                                   :name           unique-alias
                                                   ::source-alias  original-ag-name
                                                   ::position      position
                                                   ::desired-alias unique-alias)]))
(defn- add-info-to-aggregation-definitions [{aggregations :aggregation, :as inner-query} unique-alias-fn]
  (cond-> inner-query
    (seq aggregations)
    (update :aggregation (fn [aggregations]
                           (into
                            []
                            (map-indexed (fn [i aggregation]
                                           (add-info-to-aggregation-definition inner-query unique-alias-fn aggregation i)))
                            aggregations)))))
(defn- add-alias-info* [inner-query]
  (assert (not (:strategy inner-query)) "add-alias-info* should not be called on a join") ; not user-facing
  (let [unique-alias-fn (make-unique-alias-fn)]
    (-> (mbql.u/replace inner-query
          ;; don't rewrite anything inside any source queries or source metadata.
          (_ :guard (constantly (some (partial contains? (set &parents))
                                      [:source-query :source-metadata])))
          &match
          #{:field :aggregation :expression}
          (mbql.u/update-field-options &match merge (clause-alias-info inner-query unique-alias-fn &match)))
        (add-info-to-aggregation-definitions unique-alias-fn))))

Add extra info to :field clauses, :expression references, and :aggregation references in query. query must be fully preprocessed.

Adds some or all of the following keys:

`::source-table`

String name, integer Table ID, or the keyword ::source. Use this alias to qualify the clause during compilation. String names are aliases for joins. ::source means this clause comes from the :source-query; the alias to use is theoretically driver-specific but in practice is source (see [[metabase.driver.sql.query-processor/source-query-alias]]). An integer Table ID means this comes from the :source-table (either directly or indirectly via one or more :source-querys; use the Table's schema and name to qualify the clause.

`::source-alias`

String name to use to refer to this clause during compilation.

`::desired-alias`

If this clause is 'selected' (i.e., appears in :fields, :aggregation, or :breakout), select the clause AS this alias. This alias is guaranteed to be unique.

`::position`

If this clause is 'selected', this is the position the clause will appear in the results (i.e. the corresponding column index).

(defn add-alias-info
  [query-or-inner-query]
  (walk/postwalk
   (fn [form]
     (if (and (map? form)
              ((some-fn :source-query :source-table) form)
              (not (:strategy form)))
       (vary-meta (add-alias-info* form) assoc ::transformed true)
       form))
   query-or-inner-query))
 

Utility functions for raising/nesting parts of MBQL queries. Currently, this only has [[nest-expressions]], but in the future hopefully we can generalize this a bit so we can do more things that require us to introduce another level of nesting, e.g. support window functions.

(This namespace is here rather than in the shared MBQL lib because it relies on other QP-land utils like the QP refs stuff.)

(ns metabase.query-processor.util.nest-query
  (:require
   [clojure.walk :as walk]
   [medley.core :as m]
   [metabase.api.common :as api]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.mbql.util :as mbql.u]
   [metabase.plugins.classloader :as classloader]
   [metabase.query-processor.middleware.annotate :as annotate]
   [metabase.query-processor.middleware.resolve-joins
    :as qp.middleware.resolve-joins]
   [metabase.query-processor.store :as qp.store]
   [metabase.query-processor.util.add-alias-info :as add]
   [metabase.util :as u]))
(defn- joined-fields [inner-query]
  (m/distinct-by
   add/normalize-clause
   (mbql.u/match (walk/prewalk (fn [x]
                                 (if (map? x)
                                   (dissoc x :source-query :source-metadata)
                                   x))
                               inner-query)
     [:field _ (_ :guard :join-alias)]
     &match)))
(defn- keep-source+alias-props [field]
  (update field 2 select-keys [::add/source-alias ::add/source-table :join-alias]))
(defn- nfc-root [[_ field-id]]
  (when-let [field (and (int? field-id)
                        (lib.metadata/field (qp.store/metadata-provider) field-id))]
    (when-let [nfc-root (first (:nfc-path field))]
      {:table_id (:table-id field)
       :name nfc-root})))
(defn- field-id-props [[_ field-id]]
  (when-let [field (and (int? field-id)
                        (lib.metadata/field (qp.store/metadata-provider) field-id))]
    {:table_id (:table-id field)
     :name     (:name field)}))
(defn- remove-unused-fields [inner-query source]
  (let [used-fields (-> #{}
                        (into (map keep-source+alias-props) (mbql.u/match inner-query :field))
                        (into (map keep-source+alias-props) (mbql.u/match inner-query :expression)))
        nfc-roots (into #{} (keep nfc-root) used-fields)]
    (update source :fields (fn [fields]
                             (filterv #(or (-> % keep-source+alias-props used-fields)
                                           (-> % field-id-props nfc-roots))
                                      fields)))))
(defn- nest-source [inner-query]
  (classloader/require 'metabase.query-processor)
  (let [filter-clause (:filter inner-query)
        keep-filter? (nil? (mbql.u/match-one filter-clause :expression))
        source (as-> (select-keys inner-query [:source-table :source-query :source-metadata :joins :expressions]) source
                 ;; preprocess this without a current user context so it's not subject to permissions checks. To get
                 ;; here in the first place we already had to do perms checks to make sure the query we're transforming
                 ;; is itself ok, so we don't need to run another check
                 (binding [api/*current-user-id* nil]
                   ((resolve 'metabase.query-processor/preprocess)
                    {:database (u/the-id (lib.metadata/database (qp.store/metadata-provider)))
                     :type     :query
                     :query    source}))
                 (add/add-alias-info source)
                 (:query source)
                 (dissoc source :limit)
                 (qp.middleware.resolve-joins/append-join-fields-to-fields source (joined-fields inner-query))
                 (remove-unused-fields inner-query source)
                 (cond-> source
                   keep-filter? (assoc :filter filter-clause)))]
    (-> inner-query
        (dissoc :source-table :source-metadata :joins)
        (assoc :source-query source)
        (cond-> keep-filter? (dissoc :filter)))))

Convert an :expression reference from a source query into an appropriate :field clause for use in the surrounding query.

(defn- raise-source-query-expression-ref
  [{:keys [source-query], :as query} [_ expression-name opts :as _clause]]
  (let [expression-definition        (mbql.u/expression-with-name query expression-name)
        {base-type :base_type}       (some-> expression-definition annotate/infer-expression-type)
        {::add/keys [desired-alias]} (mbql.u/match-one source-query
                                       [:expression (_ :guard (partial = expression-name)) source-opts]
                                       source-opts)]
    [:field
     (or desired-alias expression-name)
     (assoc opts :base-type (or base-type :type/*))]))
(defn- rewrite-fields-and-expressions [query]
  (mbql.u/replace query
    ;; don't rewrite anything inside any source queries or source metadata.
    (_ :guard (constantly (some (partial contains? (set &parents))
                                [:source-query :source-metadata])))
    &match
    :expression
    (raise-source-query-expression-ref query &match)
    ;; mark all Fields at the new top level as `::outer-select` so QP implementations know not to apply coercion or
    ;; whatever to them a second time.
    [:field _id-or-name (_opts :guard (every-pred :temporal-unit (complement ::outer-select)))]
    (recur (mbql.u/update-field-options &match assoc ::outer-select true))
    [:field id-or-name (opts :guard :join-alias)]
    (let [{::add/keys [desired-alias]} (mbql.u/match-one (:source-query query)
                                         [:field
                                          (_ :guard (partial = id-or-name))
                                          (matching-opts :guard #(= (:join-alias %) (:join-alias opts)))]
                                         matching-opts)]
      [:field id-or-name (cond-> opts
                           desired-alias (assoc ::add/source-alias desired-alias
                                                ::add/desired-alias desired-alias))])
    ;; when recursing into joins use the refs from the parent level.
    (m :guard (every-pred map? :joins))
    (let [{:keys [joins]} m]
      (-> (dissoc m :joins)
          rewrite-fields-and-expressions
          (assoc :joins (mapv (fn [join]
                                (assoc join :qp/refs (:qp/refs query)))
                              joins))))))

Pushes the :source-table/:source-query, :expressions, and :joins in the top-level of the query into a :source-query and updates :expression references and :field clauses with :join-aliases accordingly. See tests for examples. This is used by the SQL QP to make sure expressions happen in a subselect.

(defn nest-expressions
  [query]
  (let [{:keys [expressions], :as query} (m/update-existing query :source-query nest-expressions)]
    (if (empty? expressions)
      query
      (let [{:keys [source-query], :as query} (nest-source query)
            query                             (rewrite-fields-and-expressions query)
            source-query                      (assoc source-query :expressions expressions)]
        (-> query
            (dissoc :source-query :expressions)
            (assoc :source-query source-query)
            add/add-alias-info)))))
 
(ns metabase.query-processor.util.persisted-cache
  (:require
   [metabase.driver :as driver]
   [metabase.driver.ddl.interface :as ddl.i]
   [metabase.driver.sql.util :as sql.u]
   [metabase.driver.util :as driver.u]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.models.persisted-info :as persisted-info]
   [metabase.public-settings :as public-settings]
   [metabase.util.malli :as mu]))

Taking a card and a persisted-info record (possibly nil), returns whether the card's query can be substituted for a persisted version.

(mu/defn can-substitute?
  [card           :- ::lib.schema.metadata/card
   persisted-info :- [:maybe ::lib.schema.metadata/persisted-info]]
  (and persisted-info
       persisted-info/*allow-persisted-substitution*
       (:active persisted-info)
       (= (:state persisted-info) "persisted")
       (:definition persisted-info)
       (:query-hash persisted-info)
       (= (:query-hash persisted-info) (persisted-info/query-hash (:dataset-query card)))
       (= (:definition persisted-info)
          (persisted-info/metadata->definition (:result-metadata card)
                                               (:table-name persisted-info)))))

Returns a native query that selects from the persisted cached table from persisted-info. Does not check if persistence is appropriate. Use [[can-substitute?]] for that check.

(mu/defn persisted-info-native-query
  [database-id                              :- ::lib.schema.id/database
   {:keys [table-name] :as _persisted-info} :- ::lib.schema.metadata/persisted-info]
  (let [driver (or driver/*driver* (driver.u/database->driver database-id))]
    ;; select * because we don't actually know the name of the fields when in the actual query. See #28902
    (format "select * from %s.%s"
            (sql.u/quote-name
             driver
             :table
             (ddl.i/schema-name {:id database-id} (public-settings/site-uuid)))
            (sql.u/quote-name
             driver
             :table
             table-name))))
 
(ns metabase.query-processor.util.tag-referenced-cards
  (:require
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.query-processor.store :as qp.store]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu]))
(defn- query->template-tags
  [query]
  (vals (get-in query [:native :template-tags])))

Returns the card IDs from the template tags of the native query of query.

(defn query->tag-card-ids
  [query]
  (keep :card-id (query->template-tags query)))
(mu/defn tags-referenced-cards :- [:maybe [:sequential lib.metadata/CardMetadata]]
  "Returns Card instances referenced by the given native `query`."
  [query]
  (mapv
   (fn [card-id]
     (if-let [card (lib.metadata.protocols/card (qp.store/metadata-provider) card-id)]
       card
       (throw (ex-info (tru "Referenced question #{0} could not be found" (str card-id))
                       {:card-id card-id}))))
   (query->tag-card-ids query)))
 

Code for executing writeback queries.

(ns metabase.query-processor.writeback
  (:require
   [metabase.driver :as driver]
   [metabase.query-processor :as qp]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.middleware.parameters :as parameters]
   [metabase.query-processor.middleware.permissions :as qp.perms]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]))

Middleware that happens after compilation, AROUND query execution itself. Has the form

(f (f query rff context)) -> (f query rff context)

(def ^:private execution-middleware
  [#'qp.perms/check-query-action-permissions])
(defn- apply-middleware [qp middleware-fns]
  (reduce
   (fn [qp middleware]
     (if middleware
       (middleware qp)
       qp))
   qp
   middleware-fns))
(defn- writeback-qp []
  ;; `rff` and `context` are not currently used by the writeback QP stuff, so these parameters can be ignored; we pass
  ;; in `nil` for these below.
  (letfn [(qp* [query _rff _context]
            (let [query (parameters/substitute-parameters query)]
              ;; ok, now execute the query.
              (log/debugf "Executing query\n\n%s" (u/pprint-to-str query))
              (driver/execute-write-query! driver/*driver* query)))]
    (apply-middleware qp* (concat execution-middleware qp/around-middleware))))

Execute an writeback query from an action.

(defn execute-write-query!
  [{query-type :type, :as query}]
  ;; make sure this is a native query.
  (when-not (= query-type :native)
    (throw (ex-info (tru "Only native queries can be executed as write queries.")
                    {:type qp.error-type/invalid-query, :status-code 400, :query query})))
  ((writeback-qp) query nil nil))

Execute a write query in SQL against a database given by db-id.

(defn execute-write-sql!
  [db-id sql-or-sql+params]
  (if (sequential? sql-or-sql+params)
    (let [[sql & params] sql-or-sql+params]
      (execute-write-query! {:type     :native
                             :database db-id
                             :native   {:query  sql
                                        :params params}}))
    (execute-write-query! {:type     :native
                           :database db-id
                           :native   {:query sql-or-sql+params}})))
 

Related entities recommendations.

(ns metabase.related
  (:require
   [clojure.set :as set]
   [medley.core :as m]
   [metabase.api.common :as api]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.models.card :refer [Card]]
   [metabase.models.collection :refer [Collection]]
   [metabase.models.dashboard :refer [Dashboard]]
   [metabase.models.dashboard-card :refer [DashboardCard]]
   [metabase.models.field :refer [Field]]
   [metabase.models.interface :as mi]
   [metabase.models.metric :refer [Metric]]
   [metabase.models.query :refer [Query]]
   [metabase.models.segment :refer [Segment]]
   [metabase.models.table :refer [Table]]
   [metabase.query-processor.util :as qp.util]
   [schema.core :as s]
   [toucan2.core :as t2]))
(def ^:private ^Long max-best-matches        3)
(def ^:private ^Long max-serendipity-matches 2)
(def ^:private ^Long max-matches             (+ max-best-matches
                                                max-serendipity-matches))
(def ^:private ContextBearingForm
  [(s/one (s/constrained (s/cond-pre s/Str s/Keyword)
                         (comp #{:field :metric :segment}
                               qp.util/normalize-token))
          "head")
   s/Any])
(defn- collect-context-bearing-forms
  [form]
  (let [form (mbql.normalize/normalize-fragment [:query :filter] form)]
    (into #{}
          (comp (remove (s/checker ContextBearingForm))
                (map #(update % 0 qp.util/normalize-token)))
          (tree-seq sequential? identity form))))

Return the relevant parts of a given entity's definition. Relevant parts are those that carry semantic meaning, and especially context-bearing forms.

(defmulti definition
  {:arglists '([instance])}
  mi/model)
(defmethod definition Card
  [card]
  (-> card
      :dataset_query
      :query
      ((juxt :breakout :aggregation :expressions :fields))))
(defmethod definition Metric
  [metric]
  (-> metric :definition ((juxt :aggregation :filter))))
(defmethod definition Segment
  [segment]
  (-> segment :definition :filter))
(defmethod definition Field
  [field]
  [[:field-id (:id field)]])

How similar are entities a and b based on a structural comparison of their definition (MBQL). For the purposes of finding related entites we are only interested in context-bearing subforms (field, segment, and metric references). We also don't care about generalizations (less context-bearing forms) and refinements (more context-bearing forms), so we just check if the less specifc form is a subset of the more specific one.

(defn- similarity
  [a b]
  (let [context-a (-> a definition collect-context-bearing-forms)
        context-b (-> b definition collect-context-bearing-forms)]
    (/ (count (set/intersection context-a context-b))
       (max (min (count context-a) (count context-b)) 1))))
(defn- rank-by-similarity
  [reference entities]
  (->> entities
       (remove #{reference})
       (map #(assoc % :similarity (similarity reference %)))
       (sort-by :similarity >)))

Create an interesting mix of matches. The idea is to have a balanced mix between close (best) matches and more diverse matches to cover a wider field of intents.

(defn- interesting-mix
  [matches]
  (let [[best rest] (split-at max-best-matches matches)]
    (concat best (->> rest shuffle (take max-serendipity-matches)))))
(def ^:private ^{:arglists '([instances])} filter-visible
  (partial filter (fn [{:keys [archived visibility_type active] :as instance}]
                    (and (some? instance)
                         (or (nil? visibility_type)
                             (= (qp.util/normalize-token visibility_type) :normal))
                         (not archived)
                         (not= active false)
                         (mi/can-read? instance)))))
(defn- metrics-for-table
  [table]
  (filter-visible (t2/select Metric
                    :table_id (:id table)
                    :archived false)))
(defn- segments-for-table
  [table]
  (filter-visible (t2/select Segment
                    :table_id (:id table)
                    :archived false)))
(defn- linking-to
  [table]
  (->> (t2/select-fn-set :fk_target_field_id Field
         :table_id           (:id table)
         :fk_target_field_id [:not= nil]
         :active             true)
       (map (comp (partial t2/select-one Table :id)
                  :table_id
                  (partial t2/select-one Field :id)))
       distinct
       filter-visible
       (take max-matches)))
(defn- linked-from
  [table]
  (if-let [fields (not-empty (t2/select-fn-set :id Field
                                               :table_id (:id table)
                                               :active   true))]
    (->> (t2/select-fn-set :table_id Field
           :fk_target_field_id [:in fields]
           :active             true)
         (map (partial t2/select-one Table :id))
         filter-visible
         (take max-matches))
    []))
(defn- cards-sharing-dashboard
  [card]
  (if-let [dashboards (not-empty (t2/select-fn-set :dashboard_id DashboardCard
                                                   :card_id (:id card)))]
    (->> (t2/select-fn-set :card_id DashboardCard
                           :dashboard_id [:in dashboards]
                           :card_id      [:not= (:id card)])
         (map (partial t2/select-one Card :id))
         filter-visible
         (take max-matches))
    []))
(defn- similar-questions
  [card]
  (->> (t2/select Card
         :table_id (:table_id card)
         :archived false)
       filter-visible
       (rank-by-similarity card)
       (filter (comp pos? :similarity))))
(defn- canonical-metric
  [card]
  (->> (t2/select Metric
         :table_id (:table_id card)
         :archived false)
       filter-visible
       (m/find-first (comp #{(-> card :dataset_query :query :aggregation)}
                           :aggregation
                           :definition))))
(defn- recently-modified-dashboards
  []
  (when-let [dashboard-ids (not-empty (t2/select-fn-set :model_id 'Revision
                                                        :model     "Dashboard"
                                                        :user_id   api/*current-user-id*
                                                        {:order-by [[:timestamp :desc]]}))]
    (->> (t2/select Dashboard :id [:in dashboard-ids])
         filter-visible
         (take max-serendipity-matches))))
(defn- recommended-dashboards
  [cards]
  (let [recent                   (recently-modified-dashboards)
        card-id->dashboard-cards (->> (apply t2/select [DashboardCard :card_id :dashboard_id]
                                             (cond-> []
                                               (seq cards)
                                               (concat [:card_id [:in (map :id cards)]])
                                               (seq recent)
                                               (concat [:dashboard_id [:not-in (map :id recent)]])))
                                      (group-by :card_id))
        dashboard-ids (->> (map :id cards)
                           (mapcat card-id->dashboard-cards)
                           (map :dashboard_id)
                           distinct)
        best          (when (seq dashboard-ids)
                        (->> (t2/select Dashboard :id [:in dashboard-ids])
                             filter-visible
                             (take max-best-matches)))]
    (concat best recent)))
(defn- recommended-collections
  [cards]
  (->> cards
       (m/distinct-by :collection_id)
       interesting-mix
       (keep (comp (partial t2/select-one Collection :id) :collection_id))
       filter-visible))

Return related entities.

(defmulti related
  {:arglists '([entity])}
  mi/model)
(defmethod related Card
  [card]
  (let [table             (t2/select-one Table :id (:table_id card))
        similar-questions (similar-questions card)]
    {:table             table
     :metrics           (->> table
                             metrics-for-table
                             (rank-by-similarity card)
                             interesting-mix)
     :segments          (->> table
                             segments-for-table
                             (rank-by-similarity card)
                             interesting-mix)
     :dashboard-mates   (cards-sharing-dashboard card)
     :similar-questions (interesting-mix similar-questions)
     :canonical-metric  (canonical-metric card)
     :dashboards        (recommended-dashboards similar-questions)
     :collections       (recommended-collections similar-questions)}))
(defmethod related Query
  [query]
  (related (mi/instance Card query)))
(defmethod related Metric
  [metric]
  (let [table (t2/select-one Table :id (:table_id metric))]
    {:table    table
     :metrics  (->> table
                    metrics-for-table
                    (rank-by-similarity metric)
                    interesting-mix)
     :segments (->> table
                    segments-for-table
                    (rank-by-similarity metric)
                    interesting-mix)}))
(defmethod related Segment
  [segment]
  (let [table (t2/select-one Table :id (:table_id segment))]
    {:table       table
     :metrics     (->> table
                       metrics-for-table
                       (rank-by-similarity segment)
                       interesting-mix)
     :segments    (->> table
                       segments-for-table
                       (rank-by-similarity segment)
                       interesting-mix)
     :linked-from (linked-from table)}))
(defmethod related Table
  [table]
  (let [linking-to  (linking-to table)
        linked-from (linked-from table)]
    {:segments    (segments-for-table table)
     :metrics     (metrics-for-table table)
     :linking-to  linking-to
     :linked-from linked-from
     :tables      (->> (t2/select Table
                         :db_id           (:db_id table)
                         :schema          (:schema table)
                         :id              [:not= (:id table)]
                         :visibility_type nil
                         :active          true)
                       (remove (set (concat linking-to linked-from)))
                       filter-visible
                       interesting-mix)}))
(defmethod related Field
  [field]
  (let [table (t2/select-one Table :id (:table_id field))]
    {:table    table
     :segments (->> table
                    segments-for-table
                    (rank-by-similarity field)
                    interesting-mix)
     :metrics  (->> table
                    metrics-for-table
                    (rank-by-similarity field)
                    (filter (comp pos? :similarity))
                    interesting-mix)
     :fields   (->> (t2/select Field
                      :table_id        (:id table)
                      :id              [:not= (:id field)]
                      :visibility_type "normal"
                      :active          true)
                    filter-visible
                    interesting-mix)}))
(defmethod related Dashboard
  [dashboard]
  (let [cards (map (partial t2/select-one Card :id) (t2/select-fn-set :card_id DashboardCard
                                                                      :dashboard_id (:id dashboard)))]
    {:cards (->> cards
                 (mapcat (comp similar-questions))
                 (remove (set cards))
                 distinct
                 filter-visible
                 interesting-mix)}))
 
(ns metabase.sample-data
  (:require
   [clojure.java.io :as io]
   [clojure.string :as str]
   [metabase.models.database :refer [Database]]
   [metabase.plugins :as plugins]
   [metabase.sync :as sync]
   [metabase.util.files :as u.files]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [ring.util.codec :as codec]
   [toucan2.core :as t2])
  (:import
   (java.net URL)))
(set! *warn-on-reflection* true)
(def ^:private ^String sample-database-name     "Sample Database")
(def ^:private ^String sample-database-filename "sample-database.db.mv.db")

Reuse the plugins directory for the destination to extract the sample database because it's pretty much guaranteed to exist and be writable.

(defn- target-path
  []
  (u.files/append-to-path (plugins/plugins-dir) sample-database-filename))
(defn- process-sample-db-path
  [base-path]
  (-> base-path
      (str/replace #"\.mv\.db$" )        ; strip the .mv.db suffix from the path
      codec/url-decode                     ; for some reason the path can get URL-encoded so we decode it here
      (str ";USER=GUEST;PASSWORD=guest"))) ; specify the GUEST user account created for the DB
(defn- jar-db-details
  [^URL resource]
  (-> (.getPath resource)
      (str/replace #"^file:" "zip:") ; to connect to an H2 DB inside a JAR just replace file: with zip: (this doesn't
                                     ;   do anything when running from the Clojure CLI, which has no `file:` prefix)
      process-sample-db-path))
(defn- extract-sample-database!
  []
  (u.files/with-open-path-to-resource [sample-db-path sample-database-filename]
    (let [dest-path (target-path)]
      (u.files/copy-file! sample-db-path dest-path)
      (-> (str "file:" dest-path)
          process-sample-db-path))))

Tries to extract the sample database out of the JAR (for performance) and then returns a db-details map containing a path to the copied database.

(defn- try-to-extract-sample-database!
  []
  (let [resource (io/resource sample-database-filename)]
    (when-not resource
      (throw (Exception. (trs "Sample database DB file ''{0}'' cannot be found."
                              sample-database-filename))))
    {:db
     (if-not (:temp (plugins/plugins-dir-info))
       (extract-sample-database!)
       (do
         ;; If the plugins directory is a temp directory, fall back to reading the DB directly from the JAR until a
         ;; working plugins directory is available. (We want to ensure the sample DB is in a stable location.)
         (log/warn (trs (str "Sample database could not be extracted to the plugins directory,"
                             "which may result in slow startup times. "
                             "Please set MB_PLUGINS_DIR to a writable directory and restart Metabase.")))
         (jar-db-details resource)))}))

Add the sample database as a Metabase DB if it doesn't already exist.

(defn add-sample-database!
  []
  (when-not (t2/exists? Database :is_sample true)
    (try
      (log/info (trs "Loading sample database"))
      (let [details (try-to-extract-sample-database!)]
        (log/debug "Syncing Sample Database...")
        (sync/sync-database! (first (t2/insert-returning-instances! Database
                                                                    :name      sample-database-name
                                                                    :details   details
                                                                    :engine    :h2
                                                                    :is_sample true))))
      (log/debug "Finished adding Sample Database.")
      (catch Throwable e
        (log/error e (trs "Failed to load sample database"))))))

Update the path to the sample database DB if it exists in case the JAR has moved.

(defn update-sample-database-if-needed!
  ([]
   (update-sample-database-if-needed! (t2/select-one Database :is_sample true)))
  ([sample-db]
   (when sample-db
     (let [intended (try-to-extract-sample-database!)]
       (when (not= (:details sample-db) intended)
         (t2/update! Database (:id sample-db) {:details intended}))))))
 
(ns metabase.search.config
  (:require
   [cheshire.core :as json]
   [clojure.string :as str]
   [flatland.ordered.map :as ordered-map]
   [malli.core :as mc]
   [metabase.models.setting :refer [defsetting]]
   [metabase.permissions.util :as perms.u]
   [metabase.public-settings :as public-settings]
   [metabase.util.i18n :refer [deferred-tru]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]))
(defsetting search-typeahead-enabled
  (deferred-tru "Enable typeahead search in the {0} navbar?"
                (public-settings/application-name-for-setting-descriptions))
  :type       :boolean
  :default    true
  :visibility :authenticated
  :audit      :getter)

Number of raw results to fetch from the database. This number is in place to prevent massive application DB load by returning tons of results; this number should probably be adjusted downward once we have UI in place to indicate that results are truncated.

Under normal situations it shouldn't be rebound, but it's dynamic to make unit testing easier.

(def ^:dynamic *db-max-results*
  1000)

Number of results to return in an API response

(def ^:const max-filtered-results
  1000)

Results older than this number of days are all considered to be equally old. In other words, there is a ranking bonus for results newer than this (scaled to just how recent they are). c.f. search.scoring/recency-score

(def ^:const stale-time-in-days
  180)

Results in more dashboards than this are all considered to be equally popular.

(def ^:const dashboard-count-ceiling
  50)

Show this many words of context before/after matches in long search results

(def ^:const surrounding-match-context
  2)

Mapping from string model to the Toucan model backing it.

(def model-to-db-model
  {"action"         {:db-model :model/Action :alias :action}
   "card"           {:db-model :model/Card :alias :card}
   "collection"     {:db-model :model/Collection :alias :collection}
   "dashboard"      {:db-model :model/Dashboard :alias :dashboard}
   "database"       {:db-model :model/Database :alias :database}
   "dataset"        {:db-model :model/Card :alias :card}
   "indexed-entity" {:db-model :model/ModelIndexValue :alias :model-index-value}
   "metric"         {:db-model :model/Metric :alias :metric}
   "segment"        {:db-model :model/Segment :alias :segment}
   "table"          {:db-model :model/Table :alias :table}})

Set of all valid models to search for.

(def all-models
  (set (keys model-to-db-model)))

The order of this list influences the order of the results: items earlier in the list will be ranked higher.

(def models-search-order
  ["dashboard" "metric" "segment" "indexed-entity" "card" "dataset" "collection" "table" "action" "database"])
(assert (= all-models (set models-search-order)) "The models search order has to include all models")

Return the apporpriate revision model given a search model.

(defn search-model->revision-model
  [model]
  (case model
    "dataset" (recur "card")
    (str/capitalize model)))

Given a model string returns the model alias

(defn model->alias
  [model]
  (-> model model-to-db-model :alias))
(mu/defn column-with-model-alias :- keyword?
  "Given a column and a model name, Return a keyword representing the column with the model alias prepended.
  (column-with-model-alias \"card\" :id) => :card.id)"
  [model-string :- ms/KeywordOrString
   column       :- ms/KeywordOrString]
  (keyword (str (name (model->alias model-string)) "." (name column))))

Schema for searchable models

(def SearchableModel
  (into [:enum] all-models))

Map with the various allowed search parameters, used to construct the SQL query.

(def SearchContext
  (mc/schema
   [:map {:closed true}
    [:search-string                                        [:maybe ms/NonBlankString]]
    [:archived?                                            :boolean]
    [:current-user-perms                                   [:set perms.u/PathSchema]]
    [:models                                               [:set SearchableModel]]
    [:filter-items-in-personal-collection {:optional true} [:enum "only" "exclude"]]
    [:created-at                          {:optional true} ms/NonBlankString]
    [:created-by                          {:optional true} [:set {:min 1} ms/PositiveInt]]
    [:last-edited-at                      {:optional true} ms/NonBlankString]
    [:last-edited-by                      {:optional true} [:set {:min 1} ms/PositiveInt]]
    [:table-db-id                         {:optional true} ms/PositiveInt]
    [:limit-int                           {:optional true} ms/Int]
    [:offset-int                          {:optional true} ms/Int]
    [:search-native-query                 {:optional true} true?]
    ;; true to search for verified items only, nil will return all items
    [:verified                            {:optional true} true?]]))

All columns that will appear in the search results, and the types of those columns. The generated search query is a UNION ALL of the queries for each different entity; it looks something like:

SELECT 'card' AS model, id, cast(NULL AS integer) AS table_id, ... FROM report_card UNION ALL SELECT 'metric' as model, id, table_id, ... FROM metric

Columns that aren't used in any individual query are replaced with SELECT cast(NULL AS <type>) statements. (These are cast to the appropriate type because Postgres will assume SELECT NULL is TEXT by default and will refuse to UNION two columns of two different types.)

(def all-search-columns
  (ordered-map/ordered-map
   ;; returned for all models. Important to be first for changing model for dataset
   :model               :text
   :id                  :integer
   :name                :text
   :display_name        :text
   :description         :text
   :archived            :boolean
   ;; returned for Card, Dashboard, and Collection
   :collection_id       :integer
   :collection_name     :text
   :collection_type     :text
   :collection_authority_level :text
   ;; returned for Card and Dashboard
   :collection_position :integer
   :creator_id          :integer
   :created_at          :timestamp
   :bookmark            :boolean
   ;; returned for everything except Collection
   :updated_at          :timestamp
   ;; returned for Card only, used for scoring
   :dashboardcard_count :integer
   :last_edited_at      :timestamp
   :last_editor_id      :integer
   :moderated_status    :text
   ;; returned for Metric and Segment
   :table_id            :integer
   :table_schema        :text
   :table_name          :text
   :table_description   :text
   ;; returned for Metric, Segment, and Action
   :database_id         :integer
   ;; returned for Database and Table
   :initial_sync_status :text
   ;; returned for Action
   :model_id            :integer
   :model_name          :text
   ;; returned for indexed-entity
   :pk_ref              :text
   :model_index_id      :integer
   ;; returned for Card and Action
   :dataset_query       :text))

All of the result components that by default are displayed by the frontend.

(def ^:const displayed-columns
  #{:name :display_name :collection_name :description})

The columns that will be searched for the query.

(defmulti searchable-columns-for-model
  {:arglists '([model])}
  (fn [model] model))
(defmethod searchable-columns-for-model :default
  [_]
  [:name])
(defmethod searchable-columns-for-model "action"
  [_]
  [:name
   :dataset_query
   :description])
(defmethod searchable-columns-for-model "card"
  [_]
  [:name
   :dataset_query
   :description])
(defmethod searchable-columns-for-model "dataset"
  [_]
  (searchable-columns-for-model "card"))
(defmethod searchable-columns-for-model "dashboard"
  [_]
  [:name
   :description])
(defmethod searchable-columns-for-model "page"
  [_]
  (searchable-columns-for-model "dashboard"))
(defmethod searchable-columns-for-model "database"
  [_]
  [:name
   :description])
(defmethod searchable-columns-for-model "table"
  [_]
  [:name
   :display_name
   :description])
(defmethod searchable-columns-for-model "indexed-entity"
  [_]
  [:name])

Columns returned for all models.

(def ^:private default-columns
  [:id :name :description :archived :created_at :updated_at])

Case statement to return boolean values of :bookmark for Card, Collection and Dashboard.

(def ^:private bookmark-col
  [[:case [:not= :bookmark.id nil] true :else false] :bookmark])

Subselect to get the count of associated DashboardCards

(def ^:private dashboardcard-count-col
   [{:select [:%count.*]
     :from   [:report_dashboardcard]
     :where  [:= :report_dashboardcard.card_id :card.id]}
    :dashboardcard_count])

Columns containing information about the Table this model references. Returned for Metrics and Segments.

(def ^:private table-columns
  [:table_id
   :created_at
   [:table.db_id       :database_id]
   [:table.schema      :table_schema]
   [:table.name        :table_name]
   [:table.description :table_description]])

The columns that will be returned by the query for model, excluding :model, which is added automatically. This is not guaranteed to be the final list of columns, new columns can be added by calling [[api.search/replace-select]]

(defmulti columns-for-model
  {:arglists '([model])}
  (fn [model] model))
(defmethod columns-for-model "action"
  [_]
  (conj default-columns :model_id
        :creator_id
        [:model.collection_id        :collection_id]
        [:model.id                   :model_id]
        [:model.name                 :model_name]
        [:query_action.database_id   :database_id]
        [:query_action.dataset_query :dataset_query]))
(defmethod columns-for-model "card"
  [_]
  (conj default-columns :collection_id :collection_position :dataset_query :creator_id
        [:collection.name :collection_name]
        [:collection.authority_level :collection_authority_level]
        bookmark-col dashboardcard-count-col))
(defmethod columns-for-model "indexed-entity" [_]
  [[:model-index-value.name     :name]
   [:model-index-value.model_pk :id]
   [:model-index.pk_ref         :pk_ref]
   [:model-index.id             :model_index_id]
   [:collection.name            :collection_name]
   [:model.collection_id        :collection_id]
   [:model.id                   :model_id]
   [:model.name                 :model_name]
   [:model.database_id          :database_id]])
(defmethod columns-for-model "dashboard"
  [_]
  (conj default-columns :collection_id :collection_position :creator_id bookmark-col
        [:collection.name :collection_name]
        [:collection.authority_level :collection_authority_level]))
(defmethod columns-for-model "database"
  [_]
  [:id :name :description :created_at :updated_at :initial_sync_status])
(defmethod columns-for-model "collection"
  [_]
  (conj (remove #{:updated_at} default-columns)
        [:collection.id :collection_id]
        [:name :collection_name]
        [:type :collection_type]
        [:authority_level :collection_authority_level]
        bookmark-col))
(defmethod columns-for-model "segment"
  [_]
  (concat default-columns table-columns [:creator_id]))
(defmethod columns-for-model "metric"
  [_]
  (concat default-columns table-columns [:creator_id]))
(defmethod columns-for-model "table"
  [_]
  [:id
   :name
   :created_at
   :display_name
   :description
   :updated_at
   :initial_sync_status
   [:id :table_id]
   [:db_id :database_id]
   [:schema :table_schema]
   [:name :table_name]
   [:description :table_description]])

Turn a complex column into a string

(defmulti column->string
  (fn [_column-value model column-name]
    [(keyword model) column-name]))
(defmethod column->string :default
  [value _ _]
  value)
(defmethod column->string [:card :dataset_query]
  [value _ _]
  (let [query (json/parse-string value true)]
    (if (= "native" (:type query))
      (-> query :native :query)
      "")))
 

Namespace that defines the filters that are applied to the search results.

There are required filters and optional filters. Archived is an required filters and is always applied, the reason because by default we want to hide archived/inactive entities.

But there are OPTIONAL FILTERS like :created-by, :created-at, when these filters are provided, the results will return only results of models that have these filters.

The multi method for optional filters should have the default implementation to throw for unsupported models, and then each model that supports the filter should define its own method for the filter.

(ns metabase.search.filter
  (:require
   [clojure.set :as set]
   [clojure.string :as str]
   [honey.sql.helpers :as sql.helpers]
   [metabase.driver.common.parameters.dates :as params.dates]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.search.config :as search.config :refer [SearchableModel SearchContext]]
   [metabase.search.util :as search.util]
   [metabase.util.date-2 :as u.date]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu])
  (:import
   (java.time LocalDate)))
(def ^:private true-clause [:inline [:= 1 1]])
(def ^:private false-clause [:inline [:= 0 1]])

------------------------------------------------------------------------------------------------;; Required Filters ; ------------------------------------------------------------------------------------------------;;

Clause to filter by the archived status of the entity.

(defmulti ^:private archived-clause
  {:arglists '([model archived?])}
  (fn [model _] model))
(defmethod archived-clause :default
  [model archived?]
  [:= (search.config/column-with-model-alias model :archived) archived?])

Databases can't be archived

(defmethod archived-clause "database"
  [_model archived?]
  (if archived?
    false-clause
    true-clause))
(defmethod archived-clause "indexed-entity"
  [_model archived?]
  (if-not archived?
    true-clause
    false-clause))

Table has an :active flag, but no :archived flag; never return inactive Tables

(defmethod archived-clause "table"
  [model archived?]
  (if archived?
    false-clause ; No tables should appear in archive searches
    [:and
     [:= (search.config/column-with-model-alias model :active) true]
     [:= (search.config/column-with-model-alias model :visibility_type) nil]]))
(mu/defn ^:private search-string-clause-for-model
  [model                :- SearchableModel
   search-context       :- SearchContext
   search-native-query? :- [:maybe :boolean]]
  (when-let [query (:search-string search-context)]
    (into
     [:or]
     (for [column           (cond->> (search.config/searchable-columns-for-model model)
                              (not search-native-query?)
                              (remove #{:dataset_query})
                              true
                              (map #(search.config/column-with-model-alias model %)))
           wildcarded-token (->> (search.util/normalize query)
                                 search.util/tokenize
                                 (map search.util/wildcard-match))]
       (cond
        (and (= model "indexed-entity") (premium-features/sandboxed-or-impersonated-user?))
        [:= 0 1]
        (and (#{"card" "dataset"} model) (= column (search.config/column-with-model-alias model :dataset_query)))
        [:and
         [:= (search.config/column-with-model-alias model :query_type) "native"]
         [:like [:lower column] wildcarded-token]]
        (and (#{"action"} model)
             (= column (search.config/column-with-model-alias model :dataset_query)))
        [:like [:lower :query_action.dataset_query] wildcarded-token]
        :else
        [:like [:lower column] wildcarded-token])))))

------------------------------------------------------------------------------------------------;; Optional filters ;; ------------------------------------------------------------------------------------------------;;

Build the query to filter by filter. Dispath with an array of [filter model-name].

(defmulti ^:private build-optional-filter-query
  {:arglists '([model fitler query filter-value])}
  (fn [filter model _query _filter-value]
    [filter model]))
(defmethod build-optional-filter-query :default
  [filter model _query _creator-id]
  (throw (ex-info (format "%s filter for %s is not supported" filter model) {:filter filter :model model})))

Created by filters

(defn- default-created-by-fitler-clause
  [model creator-ids]
  (if (= 1 (count creator-ids))
    [:= (search.config/column-with-model-alias model :creator_id) (first creator-ids)]
    [:in (search.config/column-with-model-alias model :creator_id) creator-ids]))
(doseq [model ["card" "dataset" "dashboard" "action"]]
  (defmethod build-optional-filter-query [:created-by model]
    [_filter model query creator-ids]
    (sql.helpers/where query (default-created-by-fitler-clause model creator-ids))))

Verified filters

(defmethod build-optional-filter-query [:verified "card"]
  [_filter model query verified]
  (assert (true? verified) "filter for non-verified cards is not supported")
  (if (premium-features/has-feature? :content-verification)
    (-> query
        (sql.helpers/join :moderation_review
                          [:= :moderation_review.moderated_item_id
                           (search.config/column-with-model-alias model :id)])
        (sql.helpers/where [:= :moderation_review.status "verified"]
                           [:= :moderation_review.moderated_item_type "card"]
                           [:= :moderation_review.most_recent true]))
    (sql.helpers/where query false-clause)))
(defmethod build-optional-filter-query [:verified "dataset"]
  [filter _model query verified]
  (build-optional-filter-query filter "card" query verified))

Created at filters

(defn- date-range-filter-clause
  [dt-col dt-val]
  (let [date-range (try
                    (params.dates/date-string->range dt-val {:inclusive-end? false})
                    (catch Exception _e
                      (throw (ex-info (tru "Failed to parse datetime value: {0}" dt-val) {:status-code 400}))))
        start      (some-> (:start date-range) u.date/parse)
        end        (some-> (:end date-range) u.date/parse)
        dt-col     (if (some #(instance? LocalDate %) [start end])
                     [:cast dt-col :date]
                     dt-col)]
    (cond
     (= start end)
     [:= dt-col start]
     (nil? start)
     [:< dt-col end]
     (nil? end)
     [:> dt-col start]
     :else
     [:and [:>= dt-col start] [:< dt-col end]])))
(doseq [model ["collection" "database" "table" "dashboard" "card" "dataset" "action"]]
  (defmethod build-optional-filter-query [:created-at model]
    [_filter model query created-at]
    (sql.helpers/where query (date-range-filter-clause
                              (search.config/column-with-model-alias model :created_at)
                              created-at))))

Last edited by filter

Check if the query have a join with table. Note: this does a very shallow check by only checking if the join-clause is the same. Using the same table with a different alias will return false.

(-> (sql.helpers/select :*) (sql.helpers/from [:a]) (sql.helpers/join :b [:= :a.id :b.id]) (joined-with-table? :join :b))

;; => true

(defn- joined-with-table?
  [query join-type table]
  (->> (get query join-type) (partition 2) (map first) (some #(= % table)) boolean))

Return the apporpriate revision model given a search model.

(defn search-model->revision-model
  [model]
  (case model
    "dataset" (recur "card")
    (str/capitalize model)))
(doseq [model ["dashboard" "card" "dataset" "metric"]]
  (defmethod build-optional-filter-query [:last-edited-by model]
    [_filter model query editor-ids]
    (cond-> query
      ;; both last-edited-by and last-edited-at join with revision, so we should be careful not to join twice
      (not (joined-with-table? query :join :revision))
      (-> (sql.helpers/join :revision [:= :revision.model_id (search.config/column-with-model-alias model :id)])
          (sql.helpers/where [:= :revision.most_recent true]
                             [:= :revision.model (search.config/search-model->revision-model model)]))
      (= 1 (count editor-ids))
      (sql.helpers/where [:= :revision.user_id (first editor-ids)])

      (> (count editor-ids) 1)
      (sql.helpers/where [:in :revision.user_id editor-ids]))))
(doseq [model ["dashboard" "card" "dataset" "metric"]]
  (defmethod build-optional-filter-query [:last-edited-at model]
    [_filter model query last-edited-at]
    (cond-> query
      ;; both last-edited-by and last-edited-at join with revision, so we should be careful not to join twice
      (not (joined-with-table? query :join :revision))
      (-> (sql.helpers/join :revision [:= :revision.model_id (search.config/column-with-model-alias model :id)])
          (sql.helpers/where [:= :revision.most_recent true]
                             [:= :revision.model (search.config/search-model->revision-model model)]))
      true
      ;; on UI we showed the the last edit info from revision.timestamp
      ;; not the model.updated_at column
      ;; to be consistent we use revision.timestamp to do the filtering
      (sql.helpers/where (date-range-filter-clause :revision.timestamp last-edited-at)))))

TODO: once we record revision for actions, we should update this to use the same approach with dashboard/card

(defmethod build-optional-filter-query [:last-edited-at "action"]
  [_filter model query last-edited-at]
  (sql.helpers/where query (date-range-filter-clause
                              (search.config/column-with-model-alias model :updated_at)
                              last-edited-at)))

Return A map of filter to its support models.

E.g: {:created-by #{"card" "dataset" "dashboard" "action"}}

This is function instead of a def so that optional-filter-clause can be defined anywhere in the codebase.

(defn- feature->supported-models
  []
  (merge
   ;; models support search-native-query if dataset_query is one of the searchable columns
   {:search-native-query (->> (dissoc (methods search.config/searchable-columns-for-model) :default)
                              (filter (fn [[k v]]
                                        (contains? (set (v k)) :dataset_query)))
                              (map first)
                              set)}
   (->> (dissoc (methods build-optional-filter-query) :default)
        keys
        (reduce (fn [acc [filter model]]
                  (update acc filter set/union #{model}))
                {}))))

------------------------------------------------------------------------------------------------;; Public functions ;; ------------------------------------------------------------------------------------------------;;

(mu/defn search-context->applicable-models :- [:set SearchableModel]
  "Returns a set of models that are applicable given the search context.
  If the context has optional filters, the models will be restricted for the set of supported models only."
  [search-context :- SearchContext]
  (let [{:keys [created-at
                created-by
                last-edited-at
                last-edited-by
                models
                search-native-query
                verified]}        search-context
        feature->supported-models (feature->supported-models)]
    (cond-> models
      (some? created-at)          (set/intersection (:created-at feature->supported-models))
      (some? created-by)          (set/intersection (:created-by feature->supported-models))
      (some? last-edited-at)      (set/intersection (:last-edited-at feature->supported-models))
      (some? last-edited-by)      (set/intersection (:last-edited-by feature->supported-models))
      (true? search-native-query) (set/intersection (:search-native-query feature->supported-models))
      (true? verified)            (set/intersection (:verified feature->supported-models)))))
(mu/defn build-filters :- map?
  "Build the search filters for a model."
  [honeysql-query :- :map
   model          :- SearchableModel
   search-context :- SearchContext]
  (let [{:keys [archived?
                created-at
                created-by
                last-edited-at
                last-edited-by
                search-string
                search-native-query
                verified]}    search-context]
    (cond-> honeysql-query
      (not (str/blank? search-string))
      (sql.helpers/where (search-string-clause-for-model model search-context search-native-query))
      (some? archived?)
      (sql.helpers/where (archived-clause model archived?))
      ;; build optional filters
      (some? created-at)
      (#(build-optional-filter-query :created-at model % created-at))
      (some? created-by)
      (#(build-optional-filter-query :created-by model % created-by))
      (some? last-edited-at)
      (#(build-optional-filter-query :last-edited-at model % last-edited-at))
      (some? last-edited-by)
      (#(build-optional-filter-query :last-edited-by model % last-edited-by))
      (some? verified)
      (#(build-optional-filter-query :verified model % verified)))))
 

How does search scoring work?

This was written for a success engineer, but may be helpful here, too.

Most of what you care about happens in the scoring.clj file here.

We have two sets of scorers. The first is based on the literal text matches and defined here:


(def ^:private match-based-scorers
  [{:scorer exact-match-scorer :name "exact-match" :weight 4}
   {:scorer consecutivity-scorer :name "consecutivity" :weight 2}
   {:scorer total-occurrences-scorer :name "total-occurrences" :weight 2}
   {:scorer fullness-scorer :name "fullness" :weight 1}
   {:scorer prefix-scorer :name "prefix" :weight 1}])
  • The exact-match-scorer gives points for exact matches. So if you search foo it'll score well for `foo collectionbut notmy favorite foods`. Everything else counts partial matches

  • consecutivity-scorer gives points for a sequence of matching words. So if you search four five six seven it'll score well for one two three four five six seven eight and 0 for `eight seven six five four three two one`.

  • total-occurrences-scorer gives points for the number of tokens that show up in the search result. So if you search for foo bar it'll score better for Admiral Akbar's Food Truck (2; note that akbar and food count as matches even though it's not exact) than for foo collection (1; being an exact match doesn't matter. That's why we have the exact-match-scorer).

  • fullness-scorer is sort of the opposite of that: it gives points for how much of the result is "covered" by the search query. So if you search foo bar then Barry's Food will have a perfect fullness score and `Barry's Dashboard Of Favorite Bars, Restaurants, and Food Trucks` will score poorly since only 3/9 of the dashboard's title is covered by the search query. Why 3? bar matches both Barry's and Bars.

  • prefix-scorer gives points for an exact prefix match. So if you search for foo bar then foo collection will have a good prefix score (4/24: foo matches), Food trucks I love will have a worse one (3/18), and top 10 foo bars will be zero.

These are all weighted: you can see that the exact-match scorer is responsible for 4/10 of the score, the consecutivity one is 2/10, etc.

The second set of scorers is defined lower down, here:


(defn weights-and-scores
  "Default weights and scores for a given result."
  [result]
  [{:weight 2 :score (pinned-score result) :name "pinned"}
   {:weight 2 :score (bookmarked-score result) :name "bookmarked"}
   {:weight 3/2 :score (recency-score result) :name "recency"}
   {:weight 1 :score (dashboard-count-score result) :name "dashboard"}
   {:weight 1/2 :score (model-score result) :name "model"}])

And there are two more for Enterprise here:


(premium-features/has-feature? :official-collections)
    (conj {:weight 2
            :score  (official-collection-score result)
            :name   "official collection score"})
    (premium-features/has-feature? :content-verification)
    (conj {:weight 2
           :score  (verified-score result)
           :name   "verified"})))

These are easier to explain: you get points if the search result is pinned (yes or no), bookmarked (yes or no), how recently it was updated (sliding value between 1 (edited just now) and 0 (edited 180+ days ago), how many dashboards it appears in (sliding value between 0 (zero dashboards) and 1 (50+ dashboards) and it's type (model-score): the earlier a type appears in this list the higher score it gets:

["dashboard" "metric" "segment" "indexed-entity" "card" "dataset" "collection" "table" "action" "database"]

On the EE side, we also give points if something's an official collection and if it's verified.

Finally, what we actually search is defined in the search config here, but the short answer is "the name and, if there is one, the description". We used to search raw SQL queries for cards, but that got turned off recently (but I've seen chat about turning it back on).

So, these 12 scorers are weighted and combined together, and the grand total affects search order. If this sounds a little complicated…it is! It also means that it can be tricky to give a proper answer about why the search ranking is "wrong", maybe you search for monthly revenue and are looking for a card called monthly revenue and are mad that a dashboard called company stats shows up first…but then it turns out that the dashboard's description is Stats that everyone should be aware of, such as our order count and monthly revenue. and the dashboard happens to be pinned, bookmarked, part of an official collection, verified, and edited a couple hours ago…whereas the card is none of those things.

Also, be aware that as of October 2023 there's a big epic under way to add filtering to search results, which should help people find what they're looking for (and spares us from having to make the above algorithm better).


Computes a relevancy score for search results using the weighted average of various scorers. Scores are determined by various ways of comparing the text of the search string and the item's title or description, as well as by Metabase-specific features such as how many dashboards a card appears in or whether an item is pinned.

Get the score for a result with score-and-result, and efficiently get the most relevant results with top-results.

Some of the scorers can be tweaked with configuration in [[metabase.search.config]].

(ns metabase.search.scoring
  (:require
   [cheshire.core :as json]
   [clojure.string :as str]
   [java-time.api :as t]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.search.config :as search.config]
   [metabase.search.util :as search.util]
   [metabase.util :as u]))
(defn- matches?
  [search-token match-token]
  (str/includes? match-token search-token))
(defn- matches-in?
  [search-token match-tokens]
  (some #(matches? search-token %) match-tokens))
(defn- tokens->string
  [tokens abbreviate?]
  (let [->string (partial str/join " ")
        context  search.config/surrounding-match-context]
    (if (or (not abbreviate?)
            (<= (count tokens) (* 2 context)))
      (->string tokens)
      (str
       (->string (take context tokens))
       "…"
       (->string (take-last context tokens))))))

Breaks the matched-text into match/no-match chunks and returns a seq of them in order. Each chunk is a map with keys is_match (true/false) and text

(defn- match-context
  [query-tokens match-tokens]
  (->> match-tokens
       (map (fn [match-token]
              {:text match-token
               :is_match (boolean (some #(matches? % match-token) query-tokens))}))
       (partition-by :is_match)
       (map (fn [matches-or-misses-maps]
              (let [is-match    (:is_match (first matches-or-misses-maps))
                    text-tokens (map :text matches-or-misses-maps)]
                {:is_match is-match
                 :text     (tokens->string text-tokens (not is-match))})))))

Scores a search result. Returns a vector of score maps, each containing :weight, :score, and other info about the text match, if there is one. If there is no match, the score is 0.

(defn- text-scores-with
  [weighted-scorers query-tokens search-result]
  ;; TODO is pmap over search-result worth it?
  (let [scores (for [column      (search.config/searchable-columns-for-model (:model search-result))
                     {:keys [scorer name weight]
                      :as   _ws} weighted-scorers
                     :let        [matched-text (-> search-result
                                                   (get column)
                                                   (search.config/column->string (:model search-result) column))
                                  match-tokens (some-> matched-text search.util/normalize search.util/tokenize)
                                  raw-score (scorer query-tokens match-tokens)]
                     :when       (and matched-text (pos? raw-score))]
                 {:score               raw-score
                  :name                (str "text-" name)
                  :weight              weight
                  :match               matched-text
                  :match-context-thunk #(match-context query-tokens match-tokens)
                  :column              column})]
    (if (seq scores)
      (vec scores)
      [{:score 0 :weight 0}])))
(defn- consecutivity-scorer
  [query-tokens match-tokens]
  (/ (search.util/largest-common-subseq-length
      matches?
      ;; See comment on largest-common-subseq-length re. its cache. This is a little conservative, but better to under- than over-estimate
      (take 30 query-tokens)
      (take 30 match-tokens))
     (count query-tokens)))
(defn- occurrences
  [query-tokens match-tokens token-matches?]
  (reduce (fn [tally token]
            (if (token-matches? token match-tokens)
              (inc tally)
              tally))
          0
          query-tokens))

How many search tokens show up in the result?

(defn- total-occurrences-scorer
  [query-tokens match-tokens]
  (/ (occurrences query-tokens match-tokens matches-in?)
     (count query-tokens)))

How many search tokens are exact matches (perfect string match, not includes?) in the result?

(defn- exact-match-scorer
  [query-tokens match-tokens]
  (/ (occurrences query-tokens match-tokens #(some (partial = %1) %2))
     (count query-tokens)))

How much of the result is covered by the search query?

(defn fullness-scorer
  [query-tokens match-tokens]
  (let [match-token-count (count match-tokens)]
    (if (zero? match-token-count)
      0
      (/ (occurrences query-tokens match-tokens matches-in?)
         match-token-count))))
(defn- prefix-counter
  [query-string item-string]
  (reduce
   (fn [cnt [a b]]
     (if (= a b) (inc cnt) (reduced cnt)))
   0
   (map vector query-string item-string)))

Tokens is a seq of strings, like ["abc" "def"]

(defn- count-token-chars
  [tokens]
  (reduce
   (fn [cnt x] (+ cnt (count x)))
   0
   tokens))

How much does the search query match the beginning of the result?

(defn prefix-scorer
  [query-tokens match-tokens]
  (let [query (u/lower-case-en (str/join " " query-tokens))
        match (u/lower-case-en (str/join " " match-tokens))]
    (/ (prefix-counter query match)
       (count-token-chars query-tokens))))
(def ^:private match-based-scorers
  [{:scorer exact-match-scorer :name "exact-match" :weight 4}
   {:scorer consecutivity-scorer :name "consecutivity" :weight 2}
   {:scorer total-occurrences-scorer :name "total-occurrences" :weight 2}
   {:scorer fullness-scorer :name "fullness" :weight 1}
   {:scorer prefix-scorer :name "prefix" :weight 1}])
(def ^:private model->sort-position
  (zipmap (reverse search.config/models-search-order) (range)))
(defn- model-score
  [{:keys [model]}]
  (/ (or (model->sort-position model) 0)
     (count model->sort-position)))
(defn- text-scores-with-match
  [raw-search-string result]
  (if (seq raw-search-string)
    (text-scores-with match-based-scorers
                      (search.util/tokenize (search.util/normalize raw-search-string))
                      result)
    [{:score 0 :weight 0}]))
(defn- pinned-score
  [{:keys [model collection_position]}]
  ;; We experimented with favoring lower collection positions, but it wasn't good
  ;; So instead, just give a bonus for items that are pinned at all
  (if (and (#{"card" "dashboard"} model)
           ((fnil pos? 0) collection_position))
    1
    0))
(defn- bookmarked-score
  [{:keys [model bookmark]}]
  (if (and (#{"card" "collection" "dashboard"} model)
           bookmark)
    1
    0))
(defn- dashboard-count-score
  [{:keys [model dashboardcard_count]}]
  (if (= model "card")
    (min (/ dashboardcard_count
            search.config/dashboard-count-ceiling)
         1)
    0))
(defn- recency-score
  [{:keys [updated_at]}]
  (let [stale-time search.config/stale-time-in-days
        days-ago (if updated_at
                   (t/time-between updated_at
                                   (t/offset-date-time)
                                   :days)
                   stale-time)]
    (/
     (max (- stale-time days-ago) 0)
     stale-time)))

Massage the raw result from the DB and match data into something more useful for the client

(defn- serialize
  [result all-scores relevant-scores]
  (let [{:keys [name display_name collection_id collection_name collection_authority_level collection_type]} result
        matching-columns            (into #{} (remove nil? (map :column relevant-scores)))
        match-context-thunk         (first (keep :match-context-thunk relevant-scores))]
    (-> result
        (assoc
         :name           (if (and (contains? matching-columns :display_name) display_name)
                           display_name
                           name)
         :context        (when (and match-context-thunk
                                    (empty?
                                     (remove matching-columns search.config/displayed-columns)))
                           (match-context-thunk))
         :collection     {:id              collection_id
                          :name            collection_name
                          :authority_level collection_authority_level
                          :type            collection_type}
         :scores          all-scores)
        (update :dataset_query #(some-> % json/parse-string mbql.normalize/normalize))
        (dissoc
         :collection_id
         :collection_name
         :collection_type
         :display_name))))

Default weights and scores for a given result.

(defn weights-and-scores
  [result]
  [{:weight 2 :score (pinned-score result) :name "pinned"}
   {:weight 2 :score (bookmarked-score result) :name "bookmarked"}
   {:weight 3/2 :score (recency-score result) :name "recency"}
   {:weight 1 :score (dashboard-count-score result) :name "dashboard"}
   {:weight 1/2 :score (model-score result) :name "model"}])

Score a result, returning a collection of maps with score and weight. Should not include the text scoring, done separately. Should return a sequence of maps with

{:weight number, :score number, :name string}

(defenterprise score-result
  metabase-enterprise.search.scoring
  [result]
  (weights-and-scores result))
(defn- sum-weights [weights]
  (reduce
   (fn [acc {:keys [weight] :or {weight 0}}]
     (+ acc weight))
   0
   weights))
(defn- compute-normalized-score [scores]
  (let [weight-sum (sum-weights scores)]
    (if (zero? weight-sum)
      0
      (let [score-sum (reduce
                       (fn [acc {:keys [weight score]
                                 :or {weight 0 score 0}}]
                         (+ acc (* score weight)))
                       0
                       scores)]
        (/ score-sum weight-sum)))))

Reweight scores such that the sum of their weights equals total, and their proportions do not change.

(defn force-weight
  [scores total]
  (let [total-weight (sum-weights scores)
        weight-calc-fn (if (contains? #{nil 0} total-weight)
                         (fn weight-calc-fn [_] 0)
                         (fn weight-calc-fn [weight] (* total (/ weight total-weight))))]
    (mapv #(update % :weight weight-calc-fn) scores)))

This is used to control the total weight of text-based scorers in [[score-and-result]]

(def ^:const text-scores-weight
  10)

Returns a map with the normalized, combined score from relevant-scores as :score and :result.

(defn score-and-result
  [raw-search-string result]
  (let [text-matches     (-> raw-search-string
                             (text-scores-with-match result)
                             (force-weight text-scores-weight))
        all-scores       (into (vec (score-result result)) text-matches)
        relevant-scores  (remove #(= 0 (:score %)) all-scores)
        total-score      (compute-normalized-score all-scores)]
    ;; Searches with a blank search string mean "show me everything, ranked";
    ;; see https://github.com/metabase/metabase/pull/15604 for archived search.
    ;; If the search string is non-blank, results with no text match have a score of zero.
    (if (or (str/blank? raw-search-string)
            (pos? (reduce (fn [acc {:keys [score] :or {score 0}}] (+ acc score))
                          0
                          text-matches)))
      {:score total-score
       :result (serialize result all-scores relevant-scores)}
      {:score 0})))

Compare maps of scores and results. Must return -1, 0, or 1. The score is assumed to be a vector, and will be compared in order.

(defn compare-score
  [{score-1 :score} {score-2 :score}]
  (compare score-1 score-2))

Given a reducible collection (i.e., from jdbc/reducible-query) and a transforming function for it, applies the transformation and returns a seq of the results sorted by score. The transforming function is expected to output maps with :score and :result keys.

(defn top-results
  [reducible-results max-results xf]
  (->> reducible-results
       (transduce xf (u/sorted-take max-results compare-score))
       rseq
       (map :result)))
 
(ns metabase.search.util
  (:require
   [clojure.core.memoize :as memoize]
   [clojure.string :as str]
   [metabase.util :as u]
   [metabase.util.malli :as mu]))

Returns a string pattern to match a wildcard search term.

(defn wildcard-match
  [s]
  (str "%" s "%"))
(mu/defn normalize :- :string
  "Normalize a `query` to lower-case."
  [query :- :string]
  (u/lower-case-en (str/trim query)))
(mu/defn tokenize :- [:sequential :string]
  "Break a search `query` into its constituent tokens"
  [query :- :string]
  (filter seq
          (str/split query #"\s+")))

Given two lists (and an equality test), return the length of the longest overlapping subsequence.

(largest-common-subseq-length = [1 2 3 :this :part :will :not :be :relevant] [:not :counted 1 2 3 :also :not :counted]) ;; => 3

(def largest-common-subseq-length
  (memoize/fifo
   (fn
     ([eq xs ys]
      (largest-common-subseq-length eq xs ys 0))
     ([eq xs ys tally]
      (if (or (zero? (count xs))
              (zero? (count ys)))
        tally
        (max
         (if (eq (first xs)
                 (first ys))
           (largest-common-subseq-length eq (rest xs) (rest ys) (inc tally))
           tally)
         (largest-common-subseq-length eq xs (rest ys) 0)
         (largest-common-subseq-length eq (rest xs) ys 0)))))
   ;; Uses O(n*m) space (the lengths of the two lists) with k≤2, so napkin math suggests this gives us caching for at
   ;; least a 31*31 search (or 50*20, etc) which sounds like more than enough. Memory is cheap and the items are
   ;; small, so we may as well skew high.
   ;; As a precaution, the scorer that uses this limits the number of tokens (see the `take` call below)
   :fifo/threshold 2000))
 

Code related to configuring, starting, and stopping the Metabase Jetty web server.

(ns metabase.server
  (:require
   [clojure.core :as core]
   [clojure.string :as str]
   [medley.core :as m]
   [metabase.config :as config]
   [metabase.server.protocols :as server.protocols]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [ring.adapter.jetty9 :as ring-jetty]
   [ring.adapter.jetty9.servlet :as servlet])
  (:import
   (jakarta.servlet AsyncContext)
   (jakarta.servlet.http HttpServletRequest HttpServletResponse)
   (org.eclipse.jetty.server Request Server)
   (org.eclipse.jetty.server.handler AbstractHandler StatisticsHandler)))
(set! *warn-on-reflection* true)
(defn- jetty-ssl-config []
  (m/filter-vals
   some?
   {:ssl-port       (config/config-int :mb-jetty-ssl-port)
    :keystore       (config/config-str :mb-jetty-ssl-keystore)
    :key-password   (config/config-str :mb-jetty-ssl-keystore-password)
    :truststore     (config/config-str :mb-jetty-ssl-truststore)
    :trust-password (config/config-str :mb-jetty-ssl-truststore-password)
    :client-auth    (when (config/config-bool :mb-jetty-ssl-client-auth)
                      :need)}))
(defn- jetty-config []
  (cond-> (m/filter-vals
           some?
           {:port          (config/config-int :mb-jetty-port)
            :host          (config/config-str :mb-jetty-host)
            :max-threads   (config/config-int :mb-jetty-maxthreads)
            :min-threads   (config/config-int :mb-jetty-minthreads)
            :max-queued    (config/config-int :mb-jetty-maxqueued)
            :max-idle-time (config/config-int :mb-jetty-maxidletime)})
    (config/config-int :mb-jetty-request-header-size) (assoc :request-header-size (config/config-int
                                                                                    :mb-jetty-request-header-size))
    (config/config-str :mb-jetty-daemon) (assoc :daemon? (config/config-bool :mb-jetty-daemon))
    (config/config-str :mb-jetty-ssl)    (-> (assoc :ssl? true)
                                             (merge (jetty-ssl-config)))))
(defn- log-config [jetty-config]
  (log/info (trs "Launching Embedded Jetty Webserver with config:")
            "\n"
            (u/pprint-to-str (m/filter-keys
                              #(not (str/includes? % "password"))
                              jetty-config))))
(defonce ^:private instance*
  (atom nil))

THE instance of our Jetty web server, if there currently is one.

(defn instance
  ^Server []
  @instance*)
(defn- async-proxy-handler ^AbstractHandler [handler timeout]
  (proxy [AbstractHandler] []
    (handle [_ ^Request base-request ^HttpServletRequest request ^HttpServletResponse response]
      (let [^AsyncContext context (doto (.startAsync request)
                                    (.setTimeout timeout))
            request-map           (servlet/build-request-map request)
            raise                 (fn raise [^Throwable e]
                                    (log/error e (trs "Unexpected exception in endpoint"))
                                    (try
                                      (.sendError response 500 (.getMessage e))
                                      (catch Throwable e
                                        (log/error e (trs "Unexpected exception writing error response"))))
                                    (.complete context))]
        (try
          (handler
           request-map
           (fn [response-map]
             (server.protocols/respond (:body response-map) {:request       request
                                                             :request-map   request-map
                                                             :async-context context
                                                             :response      response
                                                             :response-map  response-map}))
           raise)
          (catch Throwable e
            (log/error e (trs "Unexpected Exception in API request handler"))
            (raise e))
          (finally
            (.setHandled base-request true)))))))

Create a new async Jetty server with handler and options. Handy for creating the real Metabase web server, and creating one-off web servers for tests and REPL usage.

(defn create-server
  ^Server [handler options]
  ;; if any API endpoint functions aren't at the very least returning a channel to fetch the results later after 10
  ;; minutes we're in serious trouble. (Almost everything 'slow' should be returning a channel before then, but
  ;; some things like CSV downloads don't currently return channels at this time)
  ;;
  ;; TODO - I suppose the default value should be moved to the `metabase.config` namespace?
  (let [timeout (or (config/config-int :mb-jetty-async-response-timeout)
                    (* 10 60 1000))
        handler (async-proxy-handler handler timeout)
        stats-handler (doto (StatisticsHandler.)
                        (.setHandler handler))]
    (doto ^Server (#'ring-jetty/create-server (assoc options :async? true))
      (.setHandler stats-handler))))

Start the embedded Jetty web server. Returns :started if a new server was started; nil if there was already a running server.

(start-web-server! #'metabase.server.handler/app)

(defn start-web-server!
  [handler]
  (when-not (instance)
    ;; NOTE: we always start jetty w/ join=false so we can start the server first then do init in the background
    (let [config     (jetty-config)
          new-server (create-server handler config)]
      (log-config config)
      ;; Only start the server if the newly created server becomes the official new server
      ;; Don't JOIN yet -- we're doing other init in the background; we can join later
      (when (compare-and-set! instance* nil new-server)
        (.start new-server)
        :started))))

Stop the embedded Jetty web server. Returns :stopped if a server was stopped, nil if there was nothing to stop.

(defn stop-web-server!
  []
  (let [[^Server old-server] (reset-vals! instance* nil)]
    (when old-server
      (log/info (trs "Shutting Down Embedded Jetty Webserver"))
      (.stop old-server)
      :stopped)))
 

Top-level Metabase Ring handler.

(ns metabase.server.handler
  (:require
   [metabase.config :as config]
   [metabase.server.middleware.auth :as mw.auth]
   [metabase.server.middleware.browser-cookie :as mw.browser-cookie]
   [metabase.server.middleware.exceptions :as mw.exceptions]
   [metabase.server.middleware.json :as mw.json]
   [metabase.server.middleware.log :as mw.log]
   [metabase.server.middleware.misc :as mw.misc]
   [metabase.server.middleware.offset-paging :as mw.offset-paging]
   [metabase.server.middleware.security :as mw.security]
   [metabase.server.middleware.session :as mw.session]
   [metabase.server.middleware.ssl :as mw.ssl]
   [metabase.server.routes :as routes]
   [metabase.util.log :as log]
   [ring.core.protocols :as ring.protocols]
   [ring.middleware.cookies :refer [wrap-cookies]]
   [ring.middleware.gzip :refer [wrap-gzip]]
   [ring.middleware.keyword-params :refer [wrap-keyword-params]]
   [ring.middleware.params :refer [wrap-params]]))
(extend-protocol ring.protocols/StreamableResponseBody
  ;; java.lang.Double, java.lang.Long, and java.lang.Boolean will be given a Content-Type of "application/json; charset=utf-8"
  ;; so they should be strings, and will be parsed into their respective values.
  java.lang.Number
  (write-body-to-stream [num response output-stream]
    (ring.protocols/write-body-to-stream (str num) response output-stream))

  java.lang.Boolean
  (write-body-to-stream [bool response output-stream]
    (ring.protocols/write-body-to-stream (str bool) response output-stream))

  clojure.lang.Keyword
  (write-body-to-stream [kkey response output-stream]
    (ring.protocols/write-body-to-stream
     (if-let  [key-ns (namespace kkey)]
       (str key-ns "/" (name kkey))
       (name kkey))
     response output-stream)))
(def ^:private middleware
  ;; ▼▼▼ POST-PROCESSING ▼▼▼ happens from TOP-TO-BOTTOM
  [#'mw.exceptions/catch-uncaught-exceptions    ; catch any Exceptions that weren't passed to `raise`
   #'mw.exceptions/catch-api-exceptions         ; catch exceptions and return them in our expected format
   #'mw.log/log-api-call
   #'mw.browser-cookie/ensure-browser-id-cookie ; add cookie to identify browser; add `:browser-id` to the request
   #'mw.security/add-security-headers           ; Add HTTP headers to API responses to prevent them from being cached
   #'mw.json/wrap-json-body                     ; extracts json POST body and makes it avaliable on request
   #'mw.offset-paging/handle-paging             ; binds per-request parameters to handle paging
   #'mw.json/wrap-streamed-json-response        ; middleware to automatically serialize suitable objects as JSON in responses
   #'wrap-keyword-params                        ; converts string keys in :params to keyword keys
   #'wrap-params                                ; parses GET and POST params as :query-params/:form-params and both as :params
   #'mw.misc/maybe-set-site-url                 ; set the value of `site-url` if it hasn't been set yet
   #'mw.session/reset-session-timeout           ; Resets the timeout cookie for user activity to [[mw.session/session-timeout]]
   #'mw.session/bind-current-user               ; Binds *current-user* and *current-user-id* if :metabase-user-id is non-nil
   #'mw.session/wrap-current-user-info          ; looks for :metabase-session-id and sets :metabase-user-id and other info if Session ID is valid
   #'mw.session/wrap-session-id                 ; looks for a Metabase Session ID and assoc as :metabase-session-id
   #'mw.auth/wrap-static-api-key                ; looks for a static Metabase API Key on the request and assocs as :metabase-api-key
   #'wrap-cookies                               ; Parses cookies in the request map and assocs as :cookies
   #'mw.misc/add-content-type                   ; Adds a Content-Type header for any response that doesn't already have one
   #'mw.misc/disable-streaming-buffering        ; Add header to streaming (async) responses so ngnix doesn't buffer keepalive bytes
   #'wrap-gzip                                  ; GZIP response if client can handle it
   #'mw.misc/bind-request                       ; bind `metabase.middleware.misc/*request*` for the duration of the request
   #'mw.ssl/redirect-to-https-middleware])

▲▲▲ PRE-PROCESSING ▲▲▲ happens from BOTTOM-TO-TOP

(defn- apply-middleware
  [handler]
  (reduce
   (fn [handler middleware-fn]
     (middleware-fn handler))
   handler
   middleware))

The primary entry point to the Ring HTTP server.

(def app
  (apply-middleware routes/routes))

during interactive dev, recreate app whenever a middleware var or routes/routes changes.

(when config/is-dev?
  (doseq [varr  (cons #'routes/routes middleware)
          :when (instance? clojure.lang.IRef varr)]
    (add-watch varr ::reload (fn [_ _ _ _]
                               (log/infof "%s changed, rebuilding %s" varr #'app)
                               (alter-var-root #'app (constantly (apply-middleware routes/routes)))))))
 

Middleware related to enforcing authentication/API keys (when applicable). Unlike most other middleware most of this is not used as part of the normal app; it is instead added selectively to appropriate routes.

(ns metabase.server.middleware.auth
  (:require
   [clojure.string :as str]
   [metabase.models.setting :refer [defsetting]]
   [metabase.server.middleware.util :as mw.util]
   [metabase.util.i18n :refer [deferred-trs]]))
(def ^:private ^:const ^String static-metabase-api-key-header "x-metabase-apikey")

Middleware that returns a 401 response if request has no associated :metabase-user-id.

(defn enforce-authentication
  [handler]
  (fn [{:keys [metabase-user-id] :as request} respond raise]
    (if metabase-user-id
      (handler request respond raise)
      (respond mw.util/response-unauthentic))))
(defn- wrap-static-api-key* [{:keys [headers], :as request}]
  (if-let [api-key (headers static-metabase-api-key-header)]
    (assoc request :static-metabase-api-key api-key)
    request))

Middleware that sets the :static-metabase-api-key keyword on the request if a valid API Key can be found. We check the request headers for X-METABASE-APIKEY and if it's not found then no keyword is bound to the request.

(defn wrap-static-api-key
  [handler]
  (fn [request respond raise]
    (handler (wrap-static-api-key* request) respond raise)))

When set, this API key is required for all API requests.

(defsetting api-key
  :visibility :internal)

We don't want to change the name of the setting from MB_API_KEY, but we want to differentiate this static key from the API keys that can be generated by admins.

(defn static-api-key
  [] (api-key))

Url for documentation on how to set MBAPIKEY.

(def mb-api-key-doc-url
  "https://www.metabase.com/docs/latest/configuring-metabase/environment-variables#mb_api_key")

Response when the MBAPIKEY is not set.

(def key-not-set-response
  {:status 403
   :body (deferred-trs "MB_API_KEY is not set. See {0} for details" mb-api-key-doc-url)})

Middleware that enforces validation of the client via API Key, canceling the request processing if the check fails.

Validation is handled by first checking for the presence of the :static-metabase-api-key on the request. If the api key is available then we validate it by checking it against the configured :mb-api-key value set in our global config.

If the request :static-metabase-api-key matches the configured api-key value then the request continues, otherwise we reject the request and return a 403 Forbidden response.

This variable only works for /api/notify/db/:id endpoint

(defn enforce-static-api-key
  [handler]
  (fn [{:keys [static-metabase-api-key], :as request} respond raise]
    (cond (str/blank? (static-api-key))
          (respond key-not-set-response)
          (not static-metabase-api-key)
          (respond mw.util/response-forbidden)
          (= (static-api-key) static-metabase-api-key)
          (handler request respond raise)
          :else
          (respond mw.util/response-forbidden))))
 

Middleware that sets a permanent browser identifier cookie so we can identify logins from new browsers. This is mostly so we can send people 'login from a new device' emails the first time they log in with a new browser. If this cookie is deleted, it's fine; the user will just get an email saying they logged in from a new device next time they log in.

(ns metabase.server.middleware.browser-cookie
  (:require
   [java-time.api :as t]
   [metabase.server.request.util :as request.u]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [ring.util.response :as response]))
(set! *warn-on-reflection* true)
(def ^:private browser-id-cookie-name "metabase.DEVICE")

This cookie doesn't need to be secure, because it's only used for notification purposes and cannot be used for CSRF as it is not a session cookie. However, we do need to make sure it's persisted/sent as much as possible to prevent superfluous login notification emails when used with full-app embedding, which means setting SameSite=None when possible (over HTTPS) and SameSite=Lax otherwise. (See #18553)

(defn- cookie-options
  [request]
  (merge {:http-only true
          :path      "/"
          ;; Set the cookie to expire 20 years from now. That should be sufficient
          :expires   (t/format :rfc-1123-date-time (t/plus (t/zoned-date-time) (t/years 20)))}
         (if (request.u/https? request)
           {:same-site :none, :secure true}
           {:same-site :lax})))
(mu/defn ^:private add-browser-id-cookie [request response browser-id :- ms/NonBlankString]
  (response/set-cookie response browser-id-cookie-name browser-id (cookie-options request)))

Set a permanent browser identifier cookie if one is not already set.

(defn ensure-browser-id-cookie
  [handler]
  (fn [request respond raise]
    (if-let [browser-id (get-in request [:cookies browser-id-cookie-name :value])]
      (handler (assoc request :browser-id browser-id) respond raise)
      (let [browser-id (str (random-uuid))]
        (handler
         (assoc request :browser-id browser-id)
         (fn [response]
           (respond (add-browser-id-cookie request response browser-id)))
         raise)))))
 

Ring middleware for handling Exceptions thrown in API request handler functions.

(ns metabase.server.middleware.exceptions
  (:require
   [clojure.java.jdbc :as jdbc]
   [clojure.string :as str]
   [metabase.server.middleware.security :as mw.security]
   [metabase.util.i18n :refer [deferred-tru trs]]
   [metabase.util.log :as log])
  (:import
   (java.sql SQLException)
   (org.eclipse.jetty.io EofException)))
(set! *warn-on-reflection* true)
(declare api-exception-response)

Catch any exceptions other than 404 thrown in the request handler body and rethrow a generic 400 exception instead. This minimizes information available to bad actors when exceptions occur on public endpoints.

(defn public-exceptions
  [handler]
  (fn [request respond _]
    (let [raise (fn [e]
                  (log/warn e (trs "Exception in API call"))
                  (if (= 404 (:status-code (ex-data e)))
                    (respond {:status 404, :body (deferred-tru "Not found.")})
                    (respond {:status 400, :body (deferred-tru "An error occurred.")})))]
      (try
        (handler request respond raise)
        (catch Throwable e
          (raise e))))))

Catch any exceptions thrown in the request handler body and rethrow a 400 exception that only has the message from the original instead (i.e., don't rethrow the original stacktrace). This reduces the information available to bad actors but still provides some information that will prove useful in debugging errors.

(defn message-only-exceptions
  [handler]
  (fn [request respond _]
    (let [raise (fn [^Throwable e]
                  (respond {:status 400, :body (.getMessage e)}))]
      (try
        (handler request respond raise)
        (catch Throwable e
          (log/error e (trs "Exception in API call"))
          (raise e))))))

Convert an uncaught exception from an API endpoint into an appropriate format to be returned by the REST API (e.g. a map, which eventually gets serialized to JSON, or a plain string message).

(defmulti api-exception-response
  {:arglists '([e])}
  class)
(defmethod api-exception-response Throwable
  [^Throwable e]
  (let [{:keys [status-code], :as info} (ex-data e)
        other-info                      (dissoc info :status-code :schema :type :toucan2/context-trace)
        body                            (cond
                                          (and status-code (not= status-code 500) (empty? other-info))
                                          ;; If status code was specified (but not a 500 -- an unexpected error, and
                                          ;; other data wasn't, it's something like a 404. Return message as
                                          ;; the (plain-text) body.
                                          (.getMessage e)

                                          ;; if the response includes `:errors`, (e.g., it's something like a generic
                                          ;; parameter validation exception), just return the `other-info` from the
                                          ;; ex-data.
                                          (and status-code (:errors other-info))
                                          other-info

                                          ;; Otherwise return the full `Throwable->map` representation with Stacktrace
                                          ;; and ex-data
                                          :else
                                          (merge
                                           (Throwable->map e)
                                           {:message (.getMessage e)}
                                           other-info))]
    {:status  (or status-code 500)
     :headers (mw.security/security-headers)
     :body    body}))
(defmethod api-exception-response SQLException
  [e]
  (-> ((get-method api-exception-response (.getSuperclass SQLException)) e)
      (assoc-in [:body :sql-exception-chain] (str/split (with-out-str (jdbc/print-sql-exception-chain e))
                                                        #"\s*\n\s*"))))
(defmethod api-exception-response EofException
  [_e]
  (log/info (trs "Request canceled before finishing."))
  {:status-code 204, :body nil, :headers (mw.security/security-headers)})

Middleware (with [request respond raise]) that catches API Exceptions and returns them in our normal-style format rather than the Jetty 500 Stacktrace page, which is not so useful for our frontend.

(defn catch-api-exceptions
  [handler]
  (fn [request respond _raise]
    (handler
     request
     respond
     (comp respond api-exception-response))))

Middleware (with [request respond raise]) that catches any unexpected Exceptions and reroutes them through raise where they can be handled appropriately.

(defn catch-uncaught-exceptions
  [handler]
  (fn [request respond raise]
    (try
      (handler
       request
       ;; for people that accidentally pass along an Exception, e.g. from qp.async, do the nice thing and route it to
       ;; the right place for them
       (fn [response]
         ((if (instance? Throwable response)
            raise
            respond) response))
       raise)
      (catch Throwable e
        (raise e)))))
 

Middleware related to parsing JSON requests and generating JSON responses.

(ns metabase.server.middleware.json
  (:require
   [cheshire.core :as json]
   [cheshire.factory]
   [cheshire.generate :as json.generate]
   [metabase.util.date-2 :as u.date]
   [ring.middleware.json :as ring.json]
   [ring.util.io :as rui]
   [ring.util.response :as response])
  (:import
   (com.fasterxml.jackson.core JsonGenerator)
   (java.io BufferedWriter OutputStream OutputStreamWriter)
   (java.nio.charset StandardCharsets)
   (java.time.temporal Temporal)))
(set! *warn-on-reflection* true)

+----------------------------------------------------------------------------------------------------------------+ | JSON SERIALIZATION CONFIG | +----------------------------------------------------------------------------------------------------------------+

Tell the JSON middleware to use a date format that includes milliseconds (why?)

(def ^:private default-date-format "yyyy-MM-dd'T'HH:mm:ss.SSS'Z'")
(alter-var-root #'cheshire.factory/default-date-format (constantly default-date-format))
(alter-var-root #'json.generate/*date-format* (constantly default-date-format))

Custom JSON encoders

(defn- write-string! [^JsonGenerator json-generator, ^String s]
  (.writeString json-generator s))

For java.time classes use the date util function that writes them as ISO-8601

(json.generate/add-encoder Temporal (fn [t json-generator]
                                      (write-string! json-generator (u.date/format t))))

Always fall back to .toString instead of barfing. In some cases we should be able to improve upon this behavior; .toString may just return the Class and address, e.g. some.Class@72a8b25e The following are known few classes where .toString is the optimal behavior: * org.postgresql.jdbc4.Jdbc4Array (Postgres arrays) * org.bson.types.ObjectId (Mongo BSON IDs) * java.sql.Date (SQL Dates -- .toString returns YYYY-MM-DD)

(json.generate/add-encoder Object json.generate/encode-str)

Binary arrays ("[B") -- hex-encode their first four bytes, e.g. "0xC42360D7"

(json.generate/add-encoder
 (Class/forName "[B")
 (fn [byte-ar json-generator]
   (write-string! json-generator (apply str "0x" (for [b (take 4 byte-ar)]
                                                   (format "%02X" b))))))

+----------------------------------------------------------------------------------------------------------------+ | Parsing JSON Requests | +----------------------------------------------------------------------------------------------------------------+

Middleware that parses JSON in the body of a request. (This is basically a copy of ring-json-middleware, but tweaked to handle async-style calls.)

(defn wrap-json-body
  ;; TODO - we should really just fork ring-json-middleware and put these changes in the fork, or submit this as a PR
  [handler]
  (fn
    [request respond raise]
    (if-let [[valid? json] (#'ring.json/read-json request {:keywords? true})]
      (if valid?
        (handler (assoc request :body json) respond raise)
        (respond ring.json/default-malformed-response))
      (handler request respond raise))))

+----------------------------------------------------------------------------------------------------------------+ | Streaming JSON Responses | +----------------------------------------------------------------------------------------------------------------+

Write response-seq to a PipedOutputStream as JSON, returning the connected PipedInputStream

(defn- streamed-json-response
  [response-seq opts]
  (rui/piped-input-stream
   (fn [^OutputStream output-stream]
     (with-open [output-writer   (OutputStreamWriter. output-stream StandardCharsets/UTF_8)
                 buffered-writer (BufferedWriter. output-writer)]
       (json/generate-stream response-seq buffered-writer opts)))))
(defn- wrap-streamed-json-response* [opts response]
  (if-let [json-response (and (coll? (:body response))
                              (update response :body streamed-json-response opts))]
    (if (contains? (:headers json-response) "Content-Type")
      json-response
      (response/content-type json-response "application/json; charset=utf-8"))
    response))

Similar to ring.middleware/wrap-json-response in that it will serialize the response's body to JSON if it's a collection. Rather than generating a string it will stream the response using a PipedOutputStream.

Accepts the following options (same as wrap-json-response):

:pretty - true if the JSON should be pretty-printed :escape-non-ascii - true if non-ASCII characters should be escaped with \u

(defn wrap-streamed-json-response
  "Similar to ring.middleware/wrap-json-response in that it will serialize the response's body to JSON if it's a
  collection. Rather than generating a string it will stream the response using a PipedOutputStream.
  Accepts the following options (same as `wrap-json-response`):
  :pretty            - true if the JSON should be pretty-printed
  :escape-non-ascii  - true if non-ASCII characters should be escaped with \\u"
  [handler & [{:as opts}]]
  (fn [request respond raise]
    (handler
     request
     (comp respond (partial wrap-streamed-json-response* opts))
     raise)))
 

Ring middleware for logging API requests/responses.

(ns metabase.server.middleware.log
  (:require
   [clojure.core.async :as a]
   [clojure.string :as str]
   [metabase.async.streaming-response :as streaming-response]
   [metabase.async.streaming-response.thread-pool :as thread-pool]
   [metabase.async.util :as async.u]
   [metabase.db.connection :as mdb.connection]
   [metabase.driver.sql-jdbc.execute.diagnostic
    :as sql-jdbc.execute.diagnostic]
   [metabase.server :as server]
   [metabase.server.request.util :as request.u]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [toucan2.core :as t2])
  (:import
   (clojure.core.async.impl.channels ManyToManyChannel)
   (com.mchange.v2.c3p0 PoolBackedDataSource)
   (metabase.async.streaming_response StreamingResponse)
   (org.eclipse.jetty.util.thread QueuedThreadPool)))
(set! *warn-on-reflection* true)

To simplify passing large amounts of arguments around most functions in this namespace take an "info" map that looks like

{:request ..., :response ..., :start-time ..., :call-count-fn ...}

This map is created in log-api-call at the bottom of this namespace.

+----------------------------------------------------------------------------------------------------------------+ | Getting & Formatting Request/Response Info | +----------------------------------------------------------------------------------------------------------------+

These functions take parts of the info map and convert it into formatted strings.

(defn- format-status-info
  [{:keys [async-status]
    {:keys [request-method uri] :or {request-method :XXX}} :request
    {:keys [status]} :response}]
  (str
   (format "%s %s %d" (u/upper-case-en (name request-method)) uri status)
   (when async-status
     (format " [%s: %s]" (trs "ASYNC") async-status))))
(defn- format-performance-info
  [{:keys [start-time call-count-fn _diag-info-fn]
    :or {start-time    (System/nanoTime)
         call-count-fn (constantly -1)}}]
  (let [elapsed-time (u/format-nanoseconds (- (System/nanoTime) start-time))
        db-calls     (call-count-fn)]
    (trs "{0} ({1} DB calls)" elapsed-time db-calls)))
(defn- stats [diag-info-fn]
  (str
   (when-let [^PoolBackedDataSource pool (let [data-source (mdb.connection/data-source)]
                                           (when (instance? PoolBackedDataSource data-source)
                                             data-source))]
     (trs "App DB connections: {0}/{1}"
          (.getNumBusyConnectionsAllUsers pool) (.getNumConnectionsAllUsers pool)))
   " "
   (when-let [^QueuedThreadPool pool (some-> (server/instance) .getThreadPool)]
     (trs "Jetty threads: {0}/{1} ({2} idle, {3} queued)"
          (.getBusyThreads pool)
          (.getMaxThreads pool)
          (.getIdleThreads pool)
          (.getQueueSize pool)))
   " "
   (trs "({0} total active threads)" (Thread/activeCount))
   " "
   (trs "Queries in flight: {0}" (thread-pool/active-thread-count))
   " "
   (trs "({0} queued)" (thread-pool/queued-thread-count))
   (when diag-info-fn
     (when-let [diag-info (not-empty (diag-info-fn))]
       (format
        "; %s DB %s connections: %d/%d (%d threads blocked)"
        (some-> diag-info ::sql-jdbc.execute.diagnostic/driver name)
        (::sql-jdbc.execute.diagnostic/database-id diag-info)
        (::sql-jdbc.execute.diagnostic/active-connections diag-info)
        (::sql-jdbc.execute.diagnostic/total-connections diag-info)
        (::sql-jdbc.execute.diagnostic/threads-waiting diag-info))))))
(defn- format-threads-info [{:keys [diag-info-fn]} {:keys [include-stats?]}]
  (when include-stats?
    (stats diag-info-fn)))
(defn- format-error-info [{{:keys [body]} :response} {:keys [error?]}]
  (when (and error?
             (or (string? body) (coll? body)))
    (str "\n" (u/pprint-to-str body))))
(defn- format-info [info opts]
  (str/join " " (filter some? [(format-status-info info)
                               (format-performance-info info)
                               (format-threads-info info opts)
                               (format-error-info info opts)])))

+----------------------------------------------------------------------------------------------------------------+ | Logging the Info | +----------------------------------------------------------------------------------------------------------------+

log-info below takes an info map and actually writes the log message, using the format functions from the section above to create the combined message.

log-options determines some other formatting options, such as the color of the message. The first logger out of the list below whose :status-pred is true will be used to log the API request/response.

include-stats? here is to avoid incurring the cost of collecting the Jetty stats and concatenating the extra strings when they're just going to be ignored. This is automatically handled by the macro, but is bypassed once we wrap it in a function

(def ^:private log-options
  [{:status-pred    #(>= % 500)
    :error?         true
    :color          'red
    :log-fn         #(log/error %)
    :include-stats? false}
   {:status-pred    #(>= % 403)
    :error?         true
    :color          'red
    :log-fn         #(log/warn  %)
    :include-stats? false}
   {:status-pred    #(>= % 400)
    :error?         true
    :color          'red
    :log-fn         #(log/debug %)
    :include-stats? false}
   {:status-pred    (constantly true)
    :error?         false
    :color          'green
    :log-fn         #(log/debug %)
    :include-stats? true}])
(defn- log-info
  [{{:keys [status] :or {status -1}} :response, :as info}]
  (try
    (let [{:keys [color log-fn]
           :or {color  :default-color
                log-fn identity}
           :as opts}
          (some #(when ((:status-pred %) status) %)
                log-options)]
      (log-fn (u/format-color color (format-info info opts))))
    (catch Throwable e
      (log/error e (trs "Error logging API request")))))

+----------------------------------------------------------------------------------------------------------------+ | Async Logging | +----------------------------------------------------------------------------------------------------------------+

These functions call log-info when appropriate -- right away for non-core.async-channel responses, or after the channel closes for core.async channels.

For async responses that return a core.async channel, wait for the channel to return a response before logging the API request info.

(defn- log-core-async-response
  [{{chan :body, :as _response} :response, :as info}]
  {:pre [(async.u/promise-chan? chan)]}
  ;; [async] wait for the pipe to close the canceled/finished channel and log the API response
  (a/go
    (let [result (a/<! chan)]
      (log-info (assoc info :async-status (if (nil? result) "canceled" "completed"))))))
(defn- log-streaming-response [{{streaming-response :body, :as _response} :response, :as info}]
  ;; [async] wait for the streaming response to be canceled/finished channel and log the API response
  (let [finished-chan (streaming-response/finished-chan streaming-response)]
    (a/go
      (let [result (a/<! finished-chan)]
        (log-info (assoc info :async-status (name result)))))))

Log an API response. Returns resonse, possibly modified (i.e., core.async channels will be wrapped); this value should be passed to the normal respond function.

(defn- logged-response
  [{{:keys [body], :as response} :response, :as info}]
  (condp instance? body
    ManyToManyChannel (log-core-async-response info)
    StreamingResponse (log-streaming-response info)
    (log-info info))
  response)

+----------------------------------------------------------------------------------------------------------------+ | Middleware | +----------------------------------------------------------------------------------------------------------------+

Actual middleware. Determines whether request should be logged, and, if so, creates the info dictionary and hands off to functions above.

(defn- should-log-request? [{:keys [uri], :as request}]
  ;; don't log calls to /health or /util/logs because they clutter up the logs (especially the window in admin) with
  ;; useless lines
  (and (request.u/api-call? request)
       (not (#{"/api/util/logs"} uri))))

Logs info about request such as status code, number of DB calls, and time taken to complete.

(defn log-api-call
  [handler]
  (fn [request respond raise]
    (if-not (should-log-request? request)
      ;; non-API call or health or logs call, don't log it
      (handler request respond raise)
      ;; API call, log info about it
      (t2/with-call-count [call-count-fn]
        (sql-jdbc.execute.diagnostic/capturing-diagnostic-info [diag-info-fn]
          (let [info           {:request       request
                                :start-time    (System/nanoTime)
                                :call-count-fn call-count-fn
                                :diag-info-fn  diag-info-fn}
                response->info (fn [response]
                                 (assoc info :response response))
                respond        (comp respond logged-response response->info)]
            (handler request respond raise)))))))
 

Misc Ring middleware.

(ns metabase.server.middleware.misc
  (:require
   [clojure.string :as str]
   [metabase.async.streaming-response]
   [metabase.db :as mdb]
   [metabase.public-settings :as public-settings]
   [metabase.server.request.util :as request.u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log])
  (:import
   (clojure.core.async.impl.channels ManyToManyChannel)
   (metabase.async.streaming_response StreamingResponse)))
(comment metabase.async.streaming-response/keep-me)
(defn- add-content-type* [{:keys [body], {:strs [Content-Type]} :headers, :as response}]
  (cond-> response
    (not Content-Type)
    (assoc-in [:headers "Content-Type"] (if (string? body)
                                          "text/plain"
                                          "application/json; charset=utf-8"))))

Add an appropriate Content-Type header to response if it doesn't already have one. Most responses should already have one, so this is a fallback for ones that for one reason or another do not.

(defn add-content-type
  [handler]
  (fn [request respond raise]
    (handler request
             (if-not (request.u/api-call? request)
               respond
               (comp respond add-content-type*))
             raise)))

------------------------------------------------ SETTING SITE-URL ------------------------------------------------

It's important for us to know what the site URL is for things like returning links, etc. this is stored in the site-url Setting; we can set it automatically by looking at the Origin, X-Forwarded-Host, or Host headers sent with a request.

Effectively the very first API request that gets sent to us (usually some sort of setup request) ends up setting the (initial) value of site-url

(defn- maybe-set-site-url* [{{:strs [origin x-forwarded-host host user-agent]} :headers, uri :uri}]
  (when (and (mdb/db-is-set-up?)
             (not (public-settings/site-url))
             (not= uri "/api/health")
             (or (nil? user-agent) ((complement str/includes?) user-agent "HealthChecker")))
    (when-let [site-url (or origin x-forwarded-host host)]
      (log/info (trs "Setting Metabase site URL to {0}" site-url))
      (try
        (public-settings/site-url! site-url)
        (catch Throwable e
          (log/warn e (trs "Failed to set site-url")))))))

Middleware to set the site-url setting on the initial setup request

(defn maybe-set-site-url
  [handler]
  (fn [request respond raise]
    (maybe-set-site-url* request)
    (handler request respond raise)))

------------------------------------------ Disable Streaming Buffering -------------------------------------------

(defn- maybe-add-disable-buffering-header [{:keys [body], :as response}]
  (cond-> response
    (or (instance? StreamingResponse body)
        (instance? ManyToManyChannel body))
    (assoc-in [:headers "X-Accel-Buffering"] "no")))

Tell nginx not to batch streaming responses -- otherwise load balancers are liable to cancel our request prematurely if they aren't configured for longer timeouts. See https://nginx.org/en/docs/http/ngxhttpproxymodule.html#proxycache

(defn disable-streaming-buffering
  [handler]
  (fn [request respond raise]
    (handler
     request
     (comp respond maybe-add-disable-buffering-header)
     raise)))

-------------------------------------------------- Bind request --------------------------------------------------

The Ring request currently being handled by this thread, if any.

(def ^:dynamic *request*
  nil)

Ring middleware that binds *request* for the duration of this Ring request.

(defn bind-request
  [handler]
  (fn [request respond raise]
    (binding [*request* request]
      (handler request respond raise))))
 
(ns metabase.server.middleware.offset-paging
  (:require
   [medley.core :as m]
   [metabase.server.middleware.security :as mw.security]
   [metabase.util.i18n :refer [tru]]))
(set! *warn-on-reflection* true)

Limit for offset-limit paging.

(def ^:dynamic *limit*  nil)
(def ^:private default-limit 50)

Offset for offset-limit paging.

(def ^:dynamic *offset*  nil)
(def ^:private default-offset 0)

Bool for whether a request is paged or not. Automatically generated by a handler in offset-paging middleware.

(def ^:dynamic *paged?*
  false)
(defn- offset-paged? [{{:strs [page limit offset]} :query-params}]
  (or page limit offset))
(defn- parse-paging-params [{{:strs [limit offset]} :query-params}]
  (let [limit  (or (some-> limit Integer/parseUnsignedInt)
                   default-limit)
        offset (or (some-> offset Integer/parseUnsignedInt)
                   default-offset)]
    {:limit limit, :offset offset}))
(defn- with-paging-params [request {:keys [limit offset]}]
  (-> request
      (assoc ::limit limit, ::offset offset)
      (m/dissoc-in [:query-params "offset"])
      (m/dissoc-in [:query-params "limit"])
      (m/dissoc-in [:params :offset])
      (m/dissoc-in [:params :limit])))

Limit offset paging. This has many downsides but many upsides, chief among them at-will random paging. (it isn't stable with respect to underlying data changing, though)

(defn handle-paging
  [handler]
  (fn [request respond raise]
    (if-not (offset-paged? request)
      (handler request respond raise)
      (let [paging-params (try
                            (parse-paging-params request)
                            (catch Throwable e
                              e))]
        (if (instance? Throwable paging-params)
          (let [^Throwable e paging-params]
            (respond {:status  400
                      :headers (mw.security/security-headers)
                      :body    (merge
                                 (Throwable->map e)
                                 {:message (tru "Error parsing paging parameters: {0}" (ex-message e))})}))
          (let [{:keys [limit offset]} paging-params
                request                (with-paging-params request paging-params)]
            (binding [*limit*  limit
                      *offset* offset
                      *paged?* true]
              (handler request respond raise))))))))
 

Ring middleware for adding security-related headers to API responses.

(ns metabase.server.middleware.security
  (:require
   [clojure.java.io :as io]
   [clojure.string :as str]
   [java-time.api :as t]
   [metabase.analytics.snowplow :as snowplow]
   [metabase.config :as config]
   [metabase.embed.settings :as embed.settings]
   [metabase.models.setting :refer [defsetting]]
   [metabase.public-settings :as public-settings]
   [metabase.server.request.util :as request.u]
   [metabase.util.i18n :refer [deferred-tru]]
   [ring.util.codec :refer [base64-encode]])
  (:import
   (java.security MessageDigest SecureRandom)))
(set! *warn-on-reflection* true)

Generates a random nonce of 10 characters to add to the Content-Security-Policy header so that only scripts and inline style elements with the same nonce will be allowed to run. The server generates a unique nonce value each time it sends a response. For more information see https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Content-Security-Policy/style-src.

(defn- generate-nonce
  []
  (let [chars         "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
        secure-random (SecureRandom.)]
    (apply str (repeatedly 10 #(get chars (.nextInt secure-random (count chars)))))))
(defonce ^:private ^:const inline-js-hashes
  (letfn [(file-hash [resource-filename]
            (base64-encode
             (.digest (doto (MessageDigest/getInstance "SHA-256")
                        (.update (.getBytes (slurp (io/resource resource-filename))))))))]
    (mapv file-hash [ ;; inline script in index.html that sets `MetabaseBootstrap` and the like
                     "frontend_client/inline_js/index_bootstrap.js"
                     ;; inline script in index.html that loads Google Analytics
                     "frontend_client/inline_js/index_ganalytics.js"
                     ;; inline script in init.html
                     "frontend_client/inline_js/init.js"])))

Headers that tell browsers not to cache a response.

(defn- cache-prevention-headers
  []
  {"Cache-Control" "max-age=0, no-cache, must-revalidate, proxy-revalidate"
   "Expires"        "Tue, 03 Jul 2001 06:00:00 GMT"
   "Last-Modified"  (t/format :rfc-1123-date-time (t/zoned-date-time))})

Headers that tell browsers to cache a static resource for a long time.

(defn- cache-far-future-headers
  []
  {"Cache-Control" "public, max-age=31536000"})

Tell browsers to only access this resource over HTTPS for the next year (prevent MTM attacks). (This only applies if the original request was HTTPS; if sent in response to an HTTP request, this is simply ignored)

(def ^:private ^:const strict-transport-security-header
  {"Strict-Transport-Security" "max-age=31536000"})

Content-Security-Policy header. See https://content-security-policy.com for more details.

(defn- content-security-policy-header
  [nonce]
  {"Content-Security-Policy"
   (str/join
    (for [[k vs] {:default-src  ["'none'"]
                  :script-src   (concat
                                  ["'self'"
                                   "https://maps.google.com"
                                   "https://accounts.google.com"
                                   (when (public-settings/anon-tracking-enabled)
                                     "https://www.google-analytics.com")
                                   ;; for webpack hot reloading
                                   (when config/is-dev?
                                     "http://localhost:8080")
                                   ;; for react dev tools to work in Firefox until resolution of
                                   ;; https://github.com/facebook/react/issues/17997
                                   (when config/is-dev?
                                     "'unsafe-inline'")]
                                  ;; CLJS REPL
                                  (when config/is-dev?
                                    ["'unsafe-eval'"
                                     "http://localhost:9630"])
                                 (when-not config/is-dev?
                                   (map (partial format "'sha256-%s'") inline-js-hashes)))
                  :child-src    ["'self'"
                                 ;; TODO - double check that we actually need this for Google Auth
                                 "https://accounts.google.com"]
                  :style-src    ["'self'"
                                 ;; See [[generate-nonce]]
                                 (when nonce
                                   (format "'nonce-%s'" nonce))
                                 ;; for webpack hot reloading
                                 (when config/is-dev?
                                   "http://localhost:8080")
                                 ;; CLJS REPL
                                 (when config/is-dev?
                                   "http://localhost:9630")
                                 "https://accounts.google.com"]
                  :font-src     ["*"]
                  :img-src      ["*"
                                 "'self' data:"]
                  :connect-src  ["'self'"
                                 ;; Google Identity Services
                                 "https://accounts.google.com"
                                 ;; MailChimp. So people can sign up for the Metabase mailing list in the sign up process
                                 "metabase.us10.list-manage.com"
                                 ;; Google analytics
                                 (when (public-settings/anon-tracking-enabled)
                                   "www.google-analytics.com")
                                 ;; Snowplow analytics
                                 (when (public-settings/anon-tracking-enabled)
                                   (snowplow/snowplow-url))
                                 ;; Webpack dev server
                                 (when config/is-dev?
                                   "*:8080 ws://*:8080")
                                 ;; CLJS REPL
                                 (when config/is-dev?
                                   "ws://*:9630")]
                  :manifest-src ["'self'"]}]
      (format "%s %s; " (name k) (str/join " " vs))))})
(defn- embedding-app-origin
  []
  (when (and (embed.settings/enable-embedding) (embed.settings/embedding-app-origin))
    (embed.settings/embedding-app-origin)))
(defn- content-security-policy-header-with-frame-ancestors
  [allow-iframes? nonce]
  (update (content-security-policy-header nonce)
          "Content-Security-Policy"
          #(format "%s frame-ancestors %s;" % (if allow-iframes? "*" (or (embedding-app-origin) "'none'")))))
(defsetting ssl-certificate-public-key
  (deferred-tru
    (str "Base-64 encoded public key for this site''s SSL certificate. "
         "Specify this to enable HTTP Public Key Pinning. "
         "See {0} for more information.")
    "http://mzl.la/1EnfqBf")
  :audit :getter)

TODO - it would be nice if we could make this a proper link in the UI; consider enabling markdown parsing

Return only the first embedding app origin.

(defn- first-embedding-app-origin
  []
  (some-> (embedding-app-origin)
          (str/split #" ")
          first))

Fetch a map of security headers that should be added to a response based on the passed options.

(defn security-headers
  [& {:keys [nonce allow-iframes? allow-cache?]
      :or   {allow-iframes? false, allow-cache? false}}]
  (merge
   (if allow-cache?
     (cache-far-future-headers)
     (cache-prevention-headers))
   strict-transport-security-header
   (content-security-policy-header-with-frame-ancestors allow-iframes? nonce)
   (when-not allow-iframes?
     ;; Tell browsers not to render our site as an iframe (prevent clickjacking)
     {"X-Frame-Options"                 (if (embedding-app-origin)
                                          (format "ALLOW-FROM %s" (first-embedding-app-origin))
                                          "DENY")})
   { ;; Tell browser to block suspected XSS attacks
    "X-XSS-Protection"                  "1; mode=block"
    ;; Prevent Flash / PDF files from including content from site.
    "X-Permitted-Cross-Domain-Policies" "none"
    ;; Tell browser not to use MIME sniffing to guess types of files -- protect against MIME type confusion attacks
    "X-Content-Type-Options"            "nosniff"}))
(defn- add-security-headers* [request response]
  (update response :headers merge (security-headers
                                   :nonce          (:nonce request)
                                   :allow-iframes? ((some-fn request.u/public? request.u/embed?) request)
                                   :allow-cache?   (request.u/cacheable? request))))

Middleware that adds HTTP security and cache-busting headers.

(defn add-security-headers
  [handler]
  (fn [request respond raise]
    (let [request (assoc request :nonce (generate-nonce))]
      (handler
       request
       (comp respond (partial add-security-headers* request))
       raise))))
 

Ring middleware related to session and API-key based authentication (binding current user and permissions).

How do authenticated API requests work? There are two main paths to authentication: a session or an API key.

For session authentication, Metabase first looks for a cookie called metabase.SESSION. This is the normal way of doing things; this cookie gets set automatically upon login. metabase.SESSION is an HttpOnly cookie and thus can't be viewed by FE code. If the session is a full-app embedded session, then the cookie is metabase.EMBEDDED_SESSION instead.

Finally we'll check for the presence of a X-Metabase-Session header. If that isn't present, you don't have a Session ID.

The second main path to authentication is an API key. For this, we look at the X-Api-Key header. If that matches an ApiKey in our database, you'll be authenticated as that ApiKey's associated User.

(ns metabase.server.middleware.session
  (:require
   [honey.sql.helpers :as sql.helpers]
   [java-time.api :as t]
   [metabase.api.common
    :as api
    :refer [*current-user*
            *current-user-id*
            *current-user-permissions-set*
            *is-group-manager?*
            *is-superuser?*]]
   [metabase.config :as config]
   [metabase.core.initialization-status :as init-status]
   [metabase.db :as mdb]
   [metabase.driver.sql.query-processor :as sql.qp]
   [metabase.models.api-key :as api-key]
   [metabase.models.setting
    :as setting
    :refer [*user-local-values* defsetting]]
   [metabase.models.user :as user :refer [User]]
   [metabase.public-settings :as public-settings]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.server.request.util :as request.u]
   [metabase.util :as u]
   [metabase.util.i18n :as i18n :refer [deferred-trs deferred-tru trs tru]]
   [metabase.util.log :as log]
   [metabase.util.password :as u.password]
   [ring.util.response :as response]
   [schema.core :as s]
   [toucan2.core :as t2]
   [toucan2.pipeline :as t2.pipeline])
  (:import
   (java.util UUID)))
(def ^:private ^String metabase-session-cookie          "metabase.SESSION")
(def ^:private ^String metabase-embedded-session-cookie "metabase.EMBEDDED_SESSION")
(def ^:private ^String metabase-session-timeout-cookie  "metabase.TIMEOUT")
(def ^:private ^String anti-csrf-token-header           "x-metabase-anti-csrf-token")
(defn- clear-cookie [response cookie-name]
  (response/set-cookie response cookie-name nil {:expires "Thu, 1 Jan 1970 00:00:00 GMT", :path "/"}))

You can't add a cookie (by setting the :cookies key of a response) if the response is an unwrapped JSON response; wrap response if needed.

(defn- wrap-body-if-needed
  [response]
  (if (and (map? response) (contains? response :body))
    response
    {:body response, :status 200}))

Add a header to response to clear the current Metabase session cookie.

(defn clear-session-cookie
  [response]
  (reduce clear-cookie (wrap-body-if-needed response) [metabase-session-cookie
                                                       metabase-embedded-session-cookie
                                                       metabase-session-timeout-cookie]))
(def ^:private possible-session-cookie-samesite-values
  #{:lax :none :strict nil})
(defn- normalized-session-cookie-samesite [value]
  (some-> value name u/lower-case-en keyword))
(defn- valid-session-cookie-samesite?
  [normalized-value]
  (contains? possible-session-cookie-samesite-values normalized-value))
(defsetting session-cookie-samesite
  (deferred-tru "Value for the session cookie's `SameSite` directive.")
  :type :keyword
  :visibility :settings-manager
  :default :lax
  :getter (fn session-cookie-samesite-getter []
            (let [value (normalized-session-cookie-samesite
                         (setting/get-raw-value :session-cookie-samesite))]
              (if (valid-session-cookie-samesite? value)
                value
                (throw (ex-info "Invalid value for session cookie samesite"
                                {:possible-values possible-session-cookie-samesite-values
                                 :session-cookie-samesite value})))))
  :setter (fn session-cookie-samesite-setter
            [new-value]
            (let [normalized-value (normalized-session-cookie-samesite new-value)]
              (if (valid-session-cookie-samesite? normalized-value)
                (setting/set-value-of-type!
                 :keyword
                 :session-cookie-samesite
                 normalized-value)
                (throw (ex-info (tru "Invalid value for session cookie samesite")
                                {:possible-values possible-session-cookie-samesite-values
                                 :session-cookie-samesite normalized-value
                                 :http-status 400}))))))

The appropriate cookie attributes to persist a newly created Session to response.

(defmulti default-session-cookie-attributes
  {:arglists '([session-type request])}
  (fn [session-type _] session-type))
(defmethod default-session-cookie-attributes :default
  [session-type _]
  (throw (ex-info (str (tru "Invalid session-type."))
           {:session-type session-type})))
(defmethod default-session-cookie-attributes :normal
  [_ request]
  (merge
   {:same-site (session-cookie-samesite)
    ;; TODO - we should set `site-path` as well. Don't want to enable this yet so we don't end
    ;; up breaking things
    :path      "/" #_(site-path)}
   ;; If the authentication request request was made over HTTPS (hopefully always except for
   ;; local dev instances) add `Secure` attribute so the cookie is only sent over HTTPS.
   (when (request.u/https? request)
     {:secure true})))
(defmethod default-session-cookie-attributes :full-app-embed
  [_ request]
  (merge
   {:path "/"}
   (when (request.u/https? request)
     ;; SameSite=None is required for cross-domain full-app embedding. This is safe because
     ;; security is provided via anti-CSRF token. Note that most browsers will only accept
     ;; SameSite=None with secure cookies, thus we are setting it only over HTTPS to prevent
     ;; the cookie from being rejected in case of same-domain embedding.
     {:same-site :none
      :secure    true})))
(declare session-timeout-seconds)

Add an appropriate timeout cookie to track whether the session should timeout or not, according to the [[session-timeout]] setting. If the session-timeout setting is on, the cookie has an appropriately timed expires attribute. If the session-timeout setting is off, the cookie has a max-age attribute, so it expires in the far future.

(defn set-session-timeout-cookie
  [response request session-type request-time]
  (let [response       (wrap-body-if-needed response)
        timeout        (session-timeout-seconds)
        cookie-options (merge
                        (default-session-cookie-attributes session-type request)
                        (if (some? timeout)
                          {:expires (t/format :rfc-1123-date-time (t/plus request-time (t/seconds timeout)))}
                          {:max-age (* 60 (config/config-int :max-session-age))}))]
    (-> response
        wrap-body-if-needed
        (response/set-cookie metabase-session-timeout-cookie "alive" cookie-options))))

Returns the appropriate cookie name for the session type.

(defn session-cookie-name
  [session-type]
  (case session-type
    :normal
    metabase-session-cookie
    :full-app-embed
    metabase-embedded-session-cookie))

Check if we should use permanent cookies for a given request, which are not cleared when a browser sesion ends.

(defn- use-permanent-cookies?
  [request]
  (if (public-settings/session-cookies)
    ;; Disallow permanent cookies if MB_SESSION_COOKIES is set
    false
    ;; Otherwise check whether the user selected "remember me" during login
    (get-in request [:body :remember])))

Add the appropriate cookies to the response for the Session.

(s/defn set-session-cookies
  [request
   response
   {session-uuid :id
    session-type :type
    anti-csrf-token :anti_csrf_token} :- {:id (s/cond-pre UUID u/uuid-regex), s/Keyword s/Any}
   request-time]
  (let [cookie-options (merge
                        (default-session-cookie-attributes session-type request)
                        {:http-only true}
                        ;; If permanent cookies should be used, set the `Max-Age` directive; cookies with no
                        ;; `Max-Age` and no `Expires` directives are session cookies, and are deleted when the
                        ;; browser is closed.
                        ;; See https://developer.mozilla.org/en-US/docs/Web/HTTP/Cookies#define_the_lifetime_of_a_cookie
                        ;; max-session age-is in minutes; Max-Age= directive should be in seconds
                        (when (use-permanent-cookies? request)
                          {:max-age (* 60 (config/config-int :max-session-age))}))]
    (when (and (= (session-cookie-samesite) :none) (not (request.u/https? request)))
      (log/warn
       (str (deferred-trs "Session cookie's SameSite is configured to \"None\", but site is served over an insecure connection. Some browsers will reject cookies under these conditions.")
            " "
            "https://www.chromestatus.com/feature/5633521622188032")))
    (-> response
        wrap-body-if-needed
        (cond-> (= session-type :full-app-embed)
          (assoc-in [:headers anti-csrf-token-header] anti-csrf-token))
        (set-session-timeout-cookie request session-type request-time)
        (response/set-cookie (session-cookie-name session-type) (str session-uuid) cookie-options))))

+----------------------------------------------------------------------------------------------------------------+ | wrap-session-id | +----------------------------------------------------------------------------------------------------------------+

(def ^:private ^String metabase-session-header "x-metabase-session")

Attempt to add :metabase-session-id to request based on a specific strategy. Return modified request if successful or nil if we should try another strategy.

(defmulti ^:private wrap-session-id-with-strategy
  {:arglists '([strategy request])}
  (fn [strategy _]
    strategy))
(defmethod wrap-session-id-with-strategy :embedded-cookie
  [_ {:keys [cookies headers], :as request}]
  (when-let [session (get-in cookies [metabase-embedded-session-cookie :value])]
    (when-let [anti-csrf-token (get headers anti-csrf-token-header)]
      (assoc request :metabase-session-id session, :anti-csrf-token anti-csrf-token :metabase-session-type :full-app-embed))))
(defmethod wrap-session-id-with-strategy :normal-cookie
  [_ {:keys [cookies], :as request}]
  (when-let [session (get-in cookies [metabase-session-cookie :value])]
    (when (seq session)
      (assoc request :metabase-session-id session :metabase-session-type :normal))))
(defmethod wrap-session-id-with-strategy :header
  [_ {:keys [headers], :as request}]
  (when-let [session (get headers metabase-session-header)]
    (when (seq session)
      (assoc request :metabase-session-id session))))
(defmethod wrap-session-id-with-strategy :best
  [_ request]
  (some
   (fn [strategy]
     (wrap-session-id-with-strategy strategy request))
   [:embedded-cookie :normal-cookie :header]))

Middleware that sets the :metabase-session-id keyword on the request if a session id can be found. We first check the request :cookies for metabase.SESSION, then if no cookie is found we look in the http headers for X-METABASE-SESSION. If neither is found then no keyword is bound to the request.

(defn wrap-session-id
  [handler]
  (fn [request respond raise]
    (let [request (or (wrap-session-id-with-strategy :best request)
                      request)]
      (handler request respond raise))))

+----------------------------------------------------------------------------------------------------------------+ | wrap-current-user-info | +----------------------------------------------------------------------------------------------------------------+

Because this query runs on every single API request it's worth it to optimize it a bit and only compile it to SQL once rather than every time

(def ^:private ^{:arglists '([db-type max-age-minutes session-type enable-advanced-permissions?])} session-with-id-query
  (memoize
   (fn [db-type max-age-minutes session-type enable-advanced-permissions?]
     (first
      (t2.pipeline/compile*
       (cond-> {:select    [[:session.user_id :metabase-user-id]
                            [:user.is_superuser :is-superuser?]
                            [:user.locale :user-locale]]
                :from      [[:core_session :session]]
                :left-join [[:core_user :user] [:= :session.user_id :user.id]]
                :where     [:and
                            [:= :user.is_active true]
                            [:= :session.id [:raw "?"]]
                            (let [oldest-allowed [:inline (sql.qp/add-interval-honeysql-form db-type
                                                                                             :%now
                                                                                             (- max-age-minutes)
                                                                                             :minute)]]
                              [:> :session.created_at oldest-allowed])
                            [:= :session.anti_csrf_token (case session-type
                                                           :normal         nil
                                                           :full-app-embed [:raw "?"])]]
                :limit     [:inline 1]}
         enable-advanced-permissions?
         (->
          (sql.helpers/select
           [:pgm.is_group_manager :is-group-manager?])
          (sql.helpers/left-join
           [:permissions_group_membership :pgm] [:and
                                                 [:= :pgm.user_id :user.id]
                                                 [:is :pgm.is_group_manager true]]))))))))

See above: because this query runs on every single API request (with an API Key) it's worth it to optimize it a bit and only compile it to SQL once rather than every time

(def ^:private ^{:arglists '([enable-advanced-permissions?])} user-data-for-api-key-prefix-query
  (memoize
   (fn [enable-advanced-permissions?]
     (first
      (t2.pipeline/compile*
       (cond-> {:select    [[:api_key.user_id :metabase-user-id]
                            [:api_key.key :api-key]
                            [:user.is_superuser :is-superuser?]
                            [:user.locale :user-locale]]
                :from      :api_key
                :left-join [[:core_user :user] [:= :api_key.user_id :user.id]]
                :where     [:and
                            [:= :user.is_active true]
                            [:= :api_key.key_prefix [:raw "?"]]]
                :limit     [:inline 1]}
         enable-advanced-permissions?
         (->
          (sql.helpers/select
           [:pgm.is_group_manager :is-group-manager?])
          (sql.helpers/left-join
           [:permissions_group_membership :pgm] [:and
                                                 [:= :pgm.user_id :user.id]
                                                 [:is :pgm.is_group_manager true]]))))))))

Return User ID and superuser status for Session with session-id if it is valid and not expired.

(defn- current-user-info-for-session
  [session-id anti-csrf-token]
  (when (and session-id (init-status/complete?))
    (let [sql    (session-with-id-query (mdb/db-type)
                                        (config/config-int :max-session-age)
                                        (if (seq anti-csrf-token) :full-app-embed :normal)
                                        (premium-features/enable-advanced-permissions?))
          params (concat [session-id]
                         (when (seq anti-csrf-token)
                           [anti-csrf-token]))]
      (some-> (t2/query-one (cons sql params))
              ;; is-group-manager? could return `nil, convert it to boolean so it's guaranteed to be only true/false
              (update :is-group-manager? boolean)))))
(def ^:private api-key-that-should-never-match (str (random-uuid)))
(def ^:private hash-that-should-never-match (u.password/hash-bcrypt "password"))
(defn- do-useless-hash []
  (u.password/verify-password api-key-that-should-never-match  hash-that-should-never-match))
(defn- matching-api-key? [{:keys [api-key] :as _user-data} passed-api-key]
  ;; if we get an API key, check the hash against the passed value. If not, don't reveal info via a timing attack - do
  ;; a useless hash, *then* return `false`.
  (if api-key
    (u.password/verify-password passed-api-key  api-key)
    (do-useless-hash)))

Return User ID and superuser status for an API Key with `api-key-id

(defn- current-user-info-for-api-key
  [api-key]
  (when (and api-key (init-status/complete?))
    (let [user-data (some-> (t2/query-one (cons (user-data-for-api-key-prefix-query
                                                 (premium-features/enable-advanced-permissions?))
                                                [(api-key/prefix api-key)]))
                               (update :is-group-manager? boolean))]
      (when (matching-api-key? user-data api-key)
        (dissoc user-data :api-key)))))
(defn- merge-current-user-info
  [{:keys [metabase-session-id anti-csrf-token], {:strs [x-metabase-locale x-api-key]} :headers, :as request}]
  (merge
   request
   (or (current-user-info-for-session metabase-session-id anti-csrf-token)
       (current-user-info-for-api-key x-api-key))
   (when x-metabase-locale
     (log/tracef "Found X-Metabase-Locale header: using %s as user locale" (pr-str x-metabase-locale))
     {:user-locale (i18n/normalized-locale-string x-metabase-locale)})))

Add :metabase-user-id, :is-superuser?, :is-group-manager? and :user-locale to the request if a valid session token OR a valid API key was passed.

(defn wrap-current-user-info
  [handler]
  (fn [request respond raise]
    (handler (merge-current-user-info request) respond raise)))

+----------------------------------------------------------------------------------------------------------------+ | bind-current-user | +----------------------------------------------------------------------------------------------------------------+

(def ^:private current-user-fields
  (into [User] user/admin-or-self-visible-columns))
(defn- find-user [user-id]
  (when user-id
    (t2/select-one current-user-fields, :id user-id)))

User ID that we've previous bound [[user-local-values]] for. This exists so we can avoid rebinding it in recursive calls to [[with-current-user]] if it is already bound, as this can mess things up since things like [[metabase.models.setting/set-user-local-value!]] will only update the values for the top-level binding.

(def ^:private ^:dynamic *user-local-values-user-id*
  ;; placeholder value so we will end up rebinding [[*user-local-values*]] it if you call
  ;;
  ;;    (with-current-user nil
  ;;      ...)
  ;;
  ::none)

Impl for [[with-current-user]].

(defn do-with-current-user
  [{:keys [metabase-user-id is-superuser? permissions-set user-locale settings is-group-manager?]} thunk]
  (binding [*current-user-id*              metabase-user-id
            i18n/*user-locale*             user-locale
            *is-group-manager?*            (boolean is-group-manager?)
            *is-superuser?*                (boolean is-superuser?)
            *current-user*                 (delay (find-user metabase-user-id))
            *current-user-permissions-set* (delay (or permissions-set (some-> metabase-user-id user/permissions-set)))
            ;; as mentioned above, do not rebind this to something new, because changes to its value will not be
            ;; propagated to frames further up the stack
            *user-local-values*            (if (= *user-local-values-user-id* metabase-user-id)
                                             *user-local-values*
                                             (delay (atom (or settings
                                                              (user/user-local-settings metabase-user-id)))))
            *user-local-values-user-id*    metabase-user-id]
    (thunk)))
(defmacro ^:private with-current-user-for-request
  [request & body]
  `(do-with-current-user ~request (fn [] ~@body)))

Middleware that binds [[metabase.api.common/current-user]], [[current-user-id]], [[is-superuser?]], [[current-user-permissions-set]], and [[metabase.models.setting/user-local-values]].

  • *current-user-id* int ID or nil of user associated with request
  • *current-user* delay that returns current user (or nil) from DB
  • metabase.util.i18n/*user-locale* ISO locale code e.g en or en-US to use for the current User. Overrides site-locale if set.
  • *is-superuser?* Boolean stating whether current user is a superuser.
  • *is-group-manager?* Boolean stating whether current user is a group manager of at least one group.
  • *current-user-permissions-set* delay that returns the set of permissions granted to the current user from DB
  • *user-local-values* atom containing a map of user-local settings and values for the current user
(defn bind-current-user
  [handler]
  (fn [request respond raise]
    (with-current-user-for-request request
      (handler request respond raise))))

Part of the impl for with-current-user -- don't use this directly.

(defn with-current-user-fetch-user-for-id
  [current-user-id]
  (when current-user-id
    (t2/select-one [User [:id :metabase-user-id] [:is_superuser :is-superuser?] [:locale :user-locale] :settings]
      :id current-user-id)))

Execude code in body as an admin user.

(defmacro as-admin
  {:style/indent :defn}
  [& body]
  `(do-with-current-user
    (merge
      (with-current-user-fetch-user-for-id ~`api/*current-user-id*)
      {:is-superuser? true
       :permissions-set #{"/"}})
    (fn [] ~@body)))

Execute code in body with current-user-id bound as the current user. (This is not used in the middleware itself but elsewhere where we want to simulate a User context, such as when rendering Pulses or in tests.)

(defmacro with-current-user
  {:style/indent :defn}
  [current-user-id & body]
  `(do-with-current-user
    (with-current-user-fetch-user-for-id ~current-user-id)
    (fn [] ~@body)))

+----------------------------------------------------------------------------------------------------------------+ | reset-cookie-timeout | +----------------------------------------------------------------------------------------------------------------+

Returns nil if the [[session-timeout]] value is valid. Otherwise returns an error key.

(defn- check-session-timeout
  [timeout]
  (when (some? timeout)
    (let [{:keys [unit amount]} timeout
          units-in-24-hours (case unit
                              "seconds" (* 60 60 24)
                              "minutes" (* 60 24)
                              "hours"   24)
          units-in-100-years (* units-in-24-hours 365.25 100)]
      (cond
        (not (pos? amount))
        :amount-must-be-positive
        (>= amount units-in-100-years)
        :amount-must-be-less-than-100-years))))
(defsetting session-timeout
  ;; Should be in the form "{\"amount\":60,\"unit\":\"minutes\"}" where the unit is one of "seconds", "minutes" or "hours".
  ;; The amount is nillable.
  (deferred-tru "Time before inactive users are logged out. By default, sessions last indefinitely.")
  :type    :json
  :default nil
  :getter  (fn []
             (let [value (setting/get-value-of-type :json :session-timeout)]
               (if-let [error-key (check-session-timeout value)]
                 (do (log/warn (case error-key
                                 :amount-must-be-positive            (trs "Session timeout amount must be positive.")
                                 :amount-must-be-less-than-100-years (trs "Session timeout must be less than 100 years.")))
                     nil)
                 value)))
  :setter  (fn [new-value]
             (when-let [error-key (check-session-timeout new-value)]
               (throw (ex-info (case error-key
                                 :amount-must-be-positive            (tru "Session timeout amount must be positive.")
                                 :amount-must-be-less-than-100-years (tru "Session timeout must be less than 100 years."))
                               {:status-code 400})))
             (setting/set-value-of-type! :json :session-timeout new-value)))

Convert the session-timeout setting value to seconds.

(defn session-timeout->seconds
  [{:keys [unit amount]}]
  (when amount
    (-> (case unit
          "seconds" amount
          "minutes" (* amount 60)
          "hours"   (* amount 3600))
        (max 60)))) ; Ensure a minimum of 60 seconds so a user can't lock themselves out

Returns the number of seconds before a session times out. An alternative to calling (session-timeout) directly

(defn session-timeout-seconds
  []
  (session-timeout->seconds (session-timeout)))

Implementation for reset-cookie-timeout respond handler.

(defn reset-session-timeout*
  [request response request-time]
  (if (and
       ;; Only reset the timeout if the request includes a session cookie.
       (:metabase-session-type request)
       ;; Do not reset the timeout if it is being updated in the response, e.g. if it is being deleted
       (not (contains? (:cookies response) metabase-session-timeout-cookie)))
    (set-session-timeout-cookie response request (:metabase-session-type request) request-time)
    response))

Middleware that resets the expiry date on session cookies according to the session-timeout setting. Will not change anything if the session-timeout setting is nil, or the timeout cookie has already expired.

(defn reset-session-timeout
  [handler]
  (fn [request respond raise]
    (let [;; The expiry time for the cookie is relative to the time the request is received, rather than the time of the response.
          request-time (t/zoned-date-time (t/zone-id "GMT"))]
      (handler request
               (fn [response]
                 (respond (reset-session-timeout* request response request-time)))
               raise))))
 

Middleware for redirecting users to HTTPS sessions

(ns metabase.server.middleware.ssl
  (:require
   [clojure.string :as str]
   [metabase.public-settings :as public-settings]
   [metabase.server.request.util :as request.u]
   [ring.util.request :as req]
   [ring.util.response :as response]))
(set! *warn-on-reflection* true)

The set of URLs that should not be forced to redirect to their HTTPS equivalents

(def no-redirect-https-uris
  #{"/api/health"})
(defn- get-request? [{method :request-method}]
  (or (= method :head)
      (= method :get)))
(defn- https-url [url-string]
  (let [url (java.net.URL. url-string)
        site-url (java.net.URL. (public-settings/site-url))]
    (str (java.net.URL. "https" (.getHost site-url) (.getPort site-url) (.getFile url)))))

Given a HTTP request, return a redirect response to the equivalent HTTPS URL.

(defn- ssl-redirect-response
  [request]
  (-> (response/redirect (https-url (req/request-url request)))
      (response/status   (if (get-request? request) 301 307))))

Redirect users to HTTPS sessions when certain conditions are met. See no-redirect-https-uris for URIs excluded from https redirects.

(defn redirect-to-https-middleware
  [handler]
  (fn [request respond raise]
    (cond
      (str/blank? (public-settings/site-url))
      (handler request respond raise)
      (not (str/starts-with? (public-settings/site-url) "https:"))
      (handler request respond raise)
      (no-redirect-https-uris (:uri request))
      (handler request respond raise)
      (and
       (public-settings/redirect-all-requests-to-https)
       (not (request.u/https? request)))
      (respond (ssl-redirect-response request))
      :else (handler request respond raise))))
 

Ring middleware utility functions. TODO -- consider renaming this to metabase.server.request.util.

(ns metabase.server.middleware.util)

Generic 401 (Unauthenticated) Ring response map.

Generic 403 (Forbidden) Ring response map.

(def response-unauthentic  {:status 401, :body "Unauthenticated"})
(def response-forbidden          {:status 403, :body "Forbidden"})
 
(ns metabase.server.protocols
  (:require
   [potemkin.types :as p.types]
   [ring.adapter.jetty9.servlet :as servlet]))

Protocol for converting API endpoint responses to something Jetty can handle.

(p.types/defprotocol+ Respond
  (respond [body context]
    "Convert an API endpoint response to something Jetty-friendly. Default impl uses Ring functionality to write the
  response to a Jetty `OutputStream`. Things that need more advanced functionality than what Ring provides (such as
  the streaming response logic) provide their own custom implementations of this method.
  `context` has the following keys:
  * `:request`       -- `jakarta.servlet.http.HttpServletRequest`
  * `:request-map`   -- Ring request map
  * `:async-context` -- `jakarta.servlet.AsyncContext`
  * `:response`      -- `jakarta.servlet.http.HttpServletResponse`
  * `:response-map`  -- Ring response map"))
(extend-protocol Respond
  nil
  (respond [_ {:keys [async-context response response-map]}]
    (servlet/update-servlet-response response async-context response-map))

  Object
  (respond [_ {:keys [async-context response response-map]}]
    (servlet/update-servlet-response response async-context response-map)))
 

Utility functions for Ring requests.

(ns metabase.server.request.util
  (:require
   [cheshire.core :as json]
   [clj-http.client :as http]
   [clojure.string :as str]
   [java-time.api :as t]
   [metabase.config :as config]
   [metabase.public-settings :as public-settings]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [user-agent :as user-agent])
  (:import
   (java.time ZoneId)))
(set! *warn-on-reflection* true)

Is this ring request an API call (does path start with /api)?

(defn api-call?
  [{:keys [^String uri]}]
  (str/starts-with? uri "/api"))

Is this ring request one that will serve public.html?

(defn public?
  [{:keys [uri]}]
  (re-matches #"^/public/.*$" uri))

Is this ring request one that will serve public.html?

(defn embed?
  [{:keys [uri]}]
  (re-matches #"^/embed/.*$" uri))

Can the ring request be permanently cached?

(defn cacheable?
  [{:keys [request-method uri], :as _request}]
  (and (= request-method :get)
       (or
        ;; match requests that are js/css and have a cache-busting hex string
        (re-matches #"^/app/dist/.+\.[a-f0-9]{20}\.(js|css)$" uri)
        ;; any resource that is named as a cache-busting hex string (e.g. fonts, images)
        (re-matches #"^/app/dist/[a-f0-9]{20}.*$" uri))))

True if the original request made by the frontend client (i.e., browser) was made over HTTPS.

In many production instances, a reverse proxy such as an ELB or nginx will handle SSL termination, and the actual request handled by Jetty will be over HTTP.

(defn https?
  [{{:strs [x-forwarded-proto x-forwarded-protocol x-url-scheme x-forwarded-ssl front-end-https origin]} :headers
    :keys                                                                                                [scheme]}]
  (cond
    ;; If `X-Forwarded-Proto` is present use that. There are several alternate headers that mean the same thing. See
    ;; https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/X-Forwarded-Proto
    (or x-forwarded-proto x-forwarded-protocol x-url-scheme)
    (= "https" (u/lower-case-en (or x-forwarded-proto x-forwarded-protocol x-url-scheme)))
    ;; If none of those headers are present, look for presence of `X-Forwarded-Ssl` or `Frontend-End-Https`, which
    ;; will be set to `on` if the original request was over HTTPS.
    (or x-forwarded-ssl front-end-https)
    (= "on" (u/lower-case-en (or x-forwarded-ssl front-end-https)))
    ;; If none of the above are present, we are most not likely being accessed over a reverse proxy. Still, there's a
    ;; good chance `Origin` will be present because it should be sent with `POST` requests, and most auth requests are
    ;; `POST`. See https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Origin
    origin
    (str/starts-with? (u/lower-case-en origin) "https")
    ;; Last but not least, if none of the above are set (meaning there are no proxy servers such as ELBs or nginx in
    ;; front of us), we can look directly at the scheme of the request sent to Jetty.
    scheme
    (= scheme :https)))

Whether this frontend client that made this request is embedded inside an <iframe>.

(defn embedded?
  [request]
  (some-> request (get-in [:headers "x-metabase-embedded"]) Boolean/parseBoolean))

The IP address a Ring request came from. Looks at the public-settings/source-address-header header (by default X-Forwarded-For, or the (:remote-addr request) if not set.

(defn ip-address
  [{:keys [headers remote-addr]}]
  (some-> (or (some->> (public-settings/source-address-header) (get headers))
              remote-addr)
          ;; first IP (if there are multiple) is the actual client -- see
          ;; https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/X-Forwarded-For
          (str/split #"\s*,\s*")
          first
          ;; strip out non-ip-address characters like square brackets which we get sometimes
          (str/replace #"[^0-9a-fA-F.:]" "")))

Schema for the device info returned by device-info.

(def DeviceInfo
  [:map {:closed true}
   [:device_id          ms/NonBlankString]
   [:device_description ms/NonBlankString]
   [:ip_address         ms/NonBlankString]])
(mu/defn device-info :- DeviceInfo
  "Information about the device that made this request, as recorded by the `LoginHistory` table."
  [{{:strs [user-agent]} :headers, :keys [browser-id], :as request}]
  (let [id          (or browser-id
                        (log/warn (trs "Login request is missing device ID information")))
        description (or user-agent
                        (log/warn (trs "Login request is missing user-agent information")))
        ip-address  (or (ip-address request)
                        (log/warn (trs "Unable to determine login request IP address")))]
    (when-not (and id description ip-address)
      (log/warn (tru "Error determining login history for request")))
    {:device_id          (or id (trs "unknown"))
     :device_description (or description (trs "unknown"))
     :ip_address         (or ip-address (trs "unknown"))}))

Format a user-agent string from a request in a human-friendly way.

(defn describe-user-agent
  [user-agent-string]
  (when-not (str/blank? user-agent-string)
    (when-let [{device-type     :type-name
                {os-name :name} :os
                browser-name    :name} (some-> user-agent-string user-agent/parse not-empty)]
      (let [non-blank    (fn [s]
                           (when-not (str/blank? s)
                             s))
            device-type  (or (non-blank device-type)
                             (tru "Unknown device type"))
            os-name      (or (non-blank os-name)
                             (tru "Unknown OS"))
            browser-name (or (non-blank browser-name)
                             (tru "Unknown browser"))]
        (format "%s (%s/%s)" device-type browser-name os-name)))))
(defn- describe-location [{:keys [city region country]}]
  (when-let [info (not-empty (remove str/blank? [city region country]))]
    (str/join ", " info)))

Max amount of time to wait for a IP address geocoding request to complete. We send emails on the first login from a new device using this information, so the timeout has to be fairly short in case the request is hanging for one reason or another.

(def ^:private gecode-ip-address-timeout-ms
  5000)
(def ^:private IPAddress->Info
  [:map-of
   [:and {:error/message "valid IP address string"}
    ms/NonBlankString [:fn u/ip-address?]]
   [:map {:closed true}
    [:description ms/NonBlankString]
    [:timezone    [:maybe (ms/InstanceOfClass ZoneId)]]]])

TODO -- replace with something better, like built-in database once we find one that's GPL compatible

(mu/defn geocode-ip-addresses :- [:maybe IPAddress->Info]
  "Geocode multiple IP addresses, returning a map of IP address -> info, with each info map containing human-friendly
  `:description` of the location and a `java.time.ZoneId` `:timezone`, if that information is available."
  [ip-addresses :- [:maybe [:sequential :string]]]
  (let [ip-addresses (set (filter u/ip-address? ip-addresses))]
    (when (seq ip-addresses)
      (let [url (str "https://get.geojs.io/v1/ip/geo.json?ip=" (str/join "," ip-addresses))]
        (try
         (let [response (-> (http/get url {:headers            {"User-Agent" config/mb-app-id-string}
                                           :socket-timeout     gecode-ip-address-timeout-ms
                                           :connection-timeout gecode-ip-address-timeout-ms})
                            :body
                            (json/parse-string true))]
           (into {} (for [info response]
                      [(:ip info) {:description (or (describe-location info)
                                                    "Unknown location")
                                   :timezone    (u/ignore-exceptions (some-> (:timezone info) t/zone-id))}])))
         (catch Throwable e
           (log/error e (trs "Error geocoding IP addresses") {:url url})
           nil))))))
 

Main Compojure routes tables. See https://github.com/weavejester/compojure/wiki/Routes-In-Detail for details about how these work. /api/ routes are in metabase.api.routes.

(ns metabase.server.routes
  (:require
   [compojure.core :refer [context defroutes GET]]
   [compojure.route :as route]
   [metabase.api.dataset :as api.dataset]
   [metabase.api.routes :as api]
   [metabase.config :as config]
   [metabase.core.initialization-status :as init-status]
   [metabase.db.connection :as mdb.connection]
   [metabase.db.connection-pool-setup :as mdb.connection-pool-setup]
   [metabase.driver.sql-jdbc.connection :as sql-jdbc.conn]
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings :as public-settings]
   [metabase.server.routes.index :as index]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [ring.util.response :as response]))
(when config/ee-available?
  (classloader/require '[metabase-enterprise.sso.api.routes :as ee.sso.routes]))

Like response/redirect, but passes along query string URL params as well. This is important because the public and embedding routes below pass query params (such as template tags) as part of the URL.

(defn- redirect-including-query-string
  [url]
  (fn [{:keys [query-string]} respond _]
    (respond (response/redirect (str url "?" query-string)))))

/public routes. /public/question/:uuid.:export-format redirects to /api/public/card/:uuid/query/:export-format

(defroutes ^:private public-routes
  (GET ["/question/:uuid.:export-format", :uuid u/uuid-regex, :export-format api.dataset/export-format-regex]
       [uuid export-format]
       (redirect-including-query-string (format "%s/api/public/card/%s/query/%s" (public-settings/site-url) uuid export-format)))
  (GET "*" [] index/public))

/embed routes. /embed/question/:token.:export-format redirects to /api/public/card/:token/query/:export-format

(defroutes ^:private embed-routes
  (GET ["/question/:token.:export-format", :export-format api.dataset/export-format-regex]
       [token export-format]
       (redirect-including-query-string (format "%s/api/embed/card/%s/query/%s" (public-settings/site-url) token export-format)))
  (GET "*" [] index/embed))

Top-level ring routes for Metabase.

(defroutes  routes
  (or (some-> (resolve 'ee.sso.routes/routes) var-get)
      (fn [_ respond _]
        (respond nil)))
  ;; ^/$ -> index.html
  (GET "/" [] index/index)
  (GET "/favicon.ico" [] (response/resource-response (public-settings/application-favicon-url)))
  ;; ^/api/health -> Health Check Endpoint
  (GET "/api/health" []
       (if (init-status/complete?)
         (try (if (or (mdb.connection-pool-setup/recent-activity?)
                      (sql-jdbc.conn/can-connect-with-spec? {:datasource (mdb.connection/data-source)}))
                {:status 200, :body {:status "ok"}}
                {:status 503 :body {:status "Unable to get app-db connection"}})
              (catch Exception e
                (log/warn e (trs "Error in api/health database check"))
                {:status 503 :body {:status "Error getting app-db connection"}}))
         {:status 503, :body {:status "initializing", :progress (init-status/progress)}}))
  ;; ^/api/ -> All other API routes
  (context "/api" [] (fn [& args]
                       ;; Redirect naughty users who try to visit a page other than setup if setup is not yet complete
                       ;;
                       ;; if Metabase is not finished initializing, return a generic error message rather than
                       ;; something potentially confusing like "DB is not set up"
                       (if-not (init-status/complete?)
                         {:status 503, :body "Metabase is still initializing. Please sit tight..."}
                         (apply api/routes args))))
  ;; ^/app/ -> static files under frontend_client/app
  (context "/app" []
    (route/resources "/" {:root "frontend_client/app"})
    ;; return 404 for anything else starting with ^/app/ that doesn't exist
    (route/not-found {:status 404, :body "Not found."}))
  ;; ^/public/ -> Public frontend and download routes
  (context "/public" [] public-routes)
  ;; ^/emebed/ -> Embed frontend and download routes
  (context "/embed" [] embed-routes)
  ;; Anything else (e.g. /user/edit_current) should serve up index.html; React app will handle the rest
  (GET "*" [] index/index))
 

Logic related to loading various versions of the index.html template. The actual template lives in resources/frontend_client/index_template.html; when the frontend is built (e.g. via ./bin/build.sh frontend) different versions that include the FE app are created as index.html, public.html, and embed.html.

(ns metabase.server.routes.index
  (:require
   [cheshire.core :as json]
   [clojure.java.io :as io]
   [clojure.string :as str]
   [hiccup.util]
   [metabase.core.initialization-status :as init-status]
   [metabase.models.setting :as setting]
   [metabase.public-settings :as public-settings]
   [metabase.util.embed :as embed]
   [metabase.util.i18n :as i18n :refer [trs]]
   [metabase.util.log :as log]
   [ring.util.response :as response]
   [stencil.core :as stencil])
  (:import
   (java.io FileNotFoundException)))
(set! *warn-on-reflection* true)
(defn- base-href []
  (let [path (some-> (public-settings/site-url) io/as-url .getPath)]
    (str path "/")))
(defn- escape-script [s]
  ;; Escapes text to be included in an inline <script> tag, in particular the string '</script'
  ;; https://stackoverflow.com/questions/14780858/escape-in-script-tag-contents/23983448#23983448
  (str/replace s #"(?i)</script" "</scr\\\\ipt"))
(defn- fallback-localization [locale-or-name]
  (json/generate-string
   {"headers"
    {"language"     (str locale-or-name)
     "plural-forms" "nplurals=2; plural=(n != 1);"}
    "translations"
    { {"Metabase" {"msgid"  "Metabase"
                     "msgstr" ["Metabase"]}}}}))
(defn- localization-json-file-name [locale-string]
  (format "frontend_client/app/locales/%s.json" (str/replace locale-string \- \_)))
(defn- load-localization* [locale-string]
  (or
   (when locale-string
     (when-not (= locale-string "en")
       (try
         (slurp (or (io/resource (localization-json-file-name locale-string))
                    (when-let [fallback-locale (i18n/fallback-locale locale-string)]
                      (io/resource (localization-json-file-name (str fallback-locale))))
                    ;; don't try to i18n the Exception message below, we have no locale to translate it to!
                    (throw (FileNotFoundException. (format "Locale '%s' not found." locale-string)))))
         (catch Throwable e
           (log/warn (.getMessage e))))))
   (fallback-localization locale-string)))

Load a JSON-encoded map of localized strings for the current user's Locale.

(let [load-fn (memoize load-localization*)]
  (defn- load-localization
    [locale-override]
    (load-fn (or locale-override (i18n/user-locale-string)))))
(defn- load-inline-js* [resource-name]
  (slurp (io/resource (format "frontend_client/inline_js/%s.js" resource-name))))
(def ^:private ^{:arglists '([resource-name])} load-inline-js (memoize load-inline-js*))
(defn- load-template [path variables]
  (try
    (stencil/render-file path variables)
    (catch IllegalArgumentException e
      (let [message (trs "Failed to load template ''{0}''. Did you remember to build the Metabase frontend?" path)]
        (log/error e message)
        (throw (Exception. message e))))))
(defn- load-entrypoint-template [entrypoint-name embeddable? {:keys [uri params nonce]}]
  (load-template
   (str "frontend_client/" entrypoint-name ".html")
   (let [{:keys [anon-tracking-enabled google-auth-client-id], :as public-settings} (setting/user-readable-values-map #{:public})]
     {:bootstrapJS          (load-inline-js "index_bootstrap")
      :googleAnalyticsJS    (load-inline-js "index_ganalytics")
      :bootstrapJSON        (escape-script (json/generate-string public-settings))
      :userLocalizationJSON (escape-script (load-localization (:locale params)))
      :siteLocalizationJSON (escape-script (load-localization (public-settings/site-locale)))
      :nonceJSON            (escape-script (json/generate-string nonce))
      :language             (hiccup.util/escape-html (public-settings/site-locale))
      :favicon              (hiccup.util/escape-html (public-settings/application-favicon-url))
      :applicationName      (hiccup.util/escape-html (public-settings/application-name))
      :uri                  (hiccup.util/escape-html uri)
      :baseHref             (hiccup.util/escape-html (base-href))
      :embedCode            (when embeddable? (embed/head uri))
      :enableGoogleAuth     (boolean google-auth-client-id)
      :enableAnonTracking   (boolean anon-tracking-enabled)})))
(defn- load-init-template []
  (load-template
    "frontend_client/init.html"
    {:initJS (load-inline-js "init")}))

Response that serves up an entrypoint into the Metabase application, e.g. index.html.

(defn- entrypoint
  [entrypoint-name embeddable? request respond _raise]
  (respond
    (-> (response/response (if (init-status/complete?)
                             (load-entrypoint-template entrypoint-name embeddable? request)
                             (load-init-template)))
        (response/content-type "text/html; charset=utf-8"))))

main index.html entrypoint.

/public index.html entrypoint.

/embed index.html entrypoint.

(def index      (partial entrypoint "index"  (not :embeddable)))
(def public  (partial entrypoint "public" :embeddable))
(def embed    (partial entrypoint "embed"  :embeddable))
 
(ns metabase.setup
  (:require
   [environ.core :as env]
   [metabase.config :as config]
   [metabase.db.connection :as mdb.connection]
   [metabase.models.setting :as setting :refer [defsetting Setting]]
   [metabase.util.i18n :refer [deferred-tru tru]]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

A token used to signify that an instance has permissions to create the initial User. This is created upon the first launch of Metabase, by the first instance; once used, it is cleared out, never to be used again.

(defsetting setup-token
  :visibility :public
  :setter     :none
  :audit      :never)

Function for checking if the supplied string matches our setup token. Returns boolean true if supplied token matches the setup token, false otherwise.

(defn token-match?
  [token]
  {:pre [(string? token)]}
  (= token (setup-token)))

Create and set a new setup token, if one has not already been created. Returns the newly created token.

(defn create-token!
  []
  ;; fetch the value directly from the DB; *do not* rely on cached value, in case a different instance came along and
  ;; already created it
  ;;
  ;; TODO -- 95% sure we can just use [[setup-token]] directly now and not worry about manually fetching the env var
  ;; value or setting DB values and the like
  (or (when-let [mb-setup-token (env/env :mb-setup-token)]
        (setting/set-value-of-type! :string :setup-token mb-setup-token))
      (t2/select-one-fn :value Setting :key "setup-token")
      (setting/set-value-of-type! :string :setup-token (str (random-uuid)))))
(defsetting has-user-setup
  (deferred-tru "A value that is true iff the metabase instance has one or more users registered.")
  :visibility :public
  :type       :boolean
  :setter     (fn [value]
                (if (or config/is-dev? config/is-test?)
                  (setting/set-value-of-type! :boolean :has-user-setup value)
                  (throw (ex-info (tru "Cannot set `has-user-setup`.")
                                  {:value value}))))
  ;; Once a User is created it's impossible for this to ever become falsey -- deleting the last User is disallowed.
  ;; After this returns true once the result is cached and it will continue to return true forever without any
  ;; additional DB hits.
  ;;
  ;; This is keyed by the unique identifier for the application database, to support resetting it in tests or swapping
  ;; it out in the REPL
  :getter     (let [app-db-id->user-exists? (atom {})]
                (fn []
                  (let [possible-override (when (or config/is-dev? config/is-test?)
                                            ;; allow for overriding in dev and test
                                            (setting/get-value-of-type :boolean :has-user-setup))]
                    ;; override could be false so have to check non-nil
                    (if (some? possible-override)
                      possible-override
                      (or (get @app-db-id->user-exists? (mdb.connection/unique-identifier))
                          (let [exists? (boolean (seq (t2/select :model/User {:where [:not= :id config/internal-mb-user-id]})))]
                            (swap! app-db-id->user-exists? assoc (mdb.connection/unique-identifier) exists?)
                            exists?))))))
  :doc        false
  :audit      :never)
 

Formatting for dates, times, and ranges.

(ns metabase.shared.formatting.date
  (:require
   [metabase.shared.formatting.constants :as constants]
   [metabase.shared.formatting.internal.date-builder :as builder]
   [metabase.shared.formatting.internal.date-formatters :as formatters]
   [metabase.shared.formatting.internal.date-options :as options]
   [metabase.shared.util.time :as shared.ut]))

The range separator is a Unicode en-dash, not an ASCII hyphen.

(def range-separator
  " \u2013 ")

-------------------------------------------- Parameter Formatting ---------------------------------------------

(def ^:private parameter-formatters
  {:month   (builder/->formatter [:year "-" :month-dd])
   :quarter (builder/->formatter ["Q" :quarter "-" :year])
   :day     formatters/big-endian-day})

Returns a formatting date string for a datetime used as a parameter to a Card.

(defn ^:export format-for-parameter
  [value options]
  (let [options (options/prepare-options options)
        t       (shared.ut/coerce-to-timestamp value options)]
    (if (not (shared.ut/valid? t))
      ;; Fall back to a basic string rendering if we couldn't parse it.
      (str value)
      (if-let [fmt (parameter-formatters (:unit options))]
        ;; A few units have special formats.
        (fmt t)
        ;; Otherwise, render as a day or day range.
        (let [[start end] (shared.ut/to-range t options)]
          (if (shared.ut/same-day? start end)
            (formatters/big-endian-day start)
            (str (formatters/big-endian-day start) "~" (formatters/big-endian-day end))))))))

------------------------------------------------ Format Range -------------------------------------------------

(defn- format-range-with-unit-inner [[start end] options]
  (cond
    ;; Uncondensed, or in different years: January 1, 2018 - January 23, 2019
    (or (not (constants/condense-ranges? options))
        (not (shared.ut/same-year? start end)))
    (let [fmt (formatters/month-day-year options)]
      (str (fmt start) range-separator (fmt end)))
    ;; Condensed, but different months: January 1 - February 2, 2018
    (not (shared.ut/same-month? start end))
    (str ((formatters/month-day options) start)
         range-separator
         ((formatters/month-day-year options) end))
    ;; Condensed, and same month: January 1 - 14, 2018
    :else (str ((formatters/month-day options) start)
               range-separator
               ((builder/->formatter [:day-of-month-d ", " :year]) end))))

Returns a string with this datetime formatted as a range, rounded to the given :unit.

(defn ^:export format-range-with-unit
  [value options]
  (let [options (options/prepare-options options)
        t       (shared.ut/coerce-to-timestamp value options)]
    (if (shared.ut/valid? t)
      (format-range-with-unit-inner (shared.ut/to-range t options) options)
      ;; Best-effort fallback if we failed to parse - .toString the input.
      (str value))))

Returns a string with this datetime formatted as a single value, rounded to the given :unit.

---------------------------------------------- Format Single Date -----------------------------------------------

(defn ^:export format-datetime-with-unit
  [value options]
  (let [{:keys [is-exclude no-range type unit]
         :as options}                          (options/prepare-options options)
        t                                      (shared.ut/coerce-to-timestamp value options)]
    (cond
      is-exclude (case unit
                   :hour-of-day (formatters/hour-only t)
                   :day-of-week (formatters/weekday t)
                   (throw (ex-info "is-exclude option is only compatible with hour-of-day and day-of-week units"
                                   {:options options})))
      ;; Weeks in tooltips and cells get formatted specially.
      (and (= unit :week) (#{"tooltip" "cell"} type) (not no-range))
      (format-range-with-unit value options)
      :else ((formatters/options->formatter options) t))))
 

The gory details of transforming date and time styles, with units and other options, into formatting functions.

This namespace deals with the options only, not with specific dates, and returns reusable formatter functions.

(ns metabase.shared.formatting.internal.date-formatters
  (:require
   [clojure.string :as str]
   [metabase.shared.formatting.constants :as constants]
   [metabase.shared.formatting.internal.date-builder :as builder]
   [metabase.util.log :as log]))
(defn- apply-date-separator [format-list date-separator]
  (if date-separator
    (for [fmt format-list]
      (if (string? fmt)
        (str/replace fmt #"/" date-separator)
        fmt))
    format-list))
(defn- apply-date-abbreviation [format-list]
  (for [k format-list]
    (case k
      :month-full         :month-short
      ":month-full"       :month-short
      :day-of-week-full   :day-of-week-short
      ":day-of-week-full" :day-of-week-short
      k)))

Maps each unit to the default way of formatting that unit. This uses full month and weekday names; abbreviated output replaces these with the short forms later.

(def ^:private default-date-formats-for-unit
  ;; TODO Do we have (in i18n or utils) helpers for getting localized ordinals?
  {:year            [:year]                    ; 2022
   :quarter         ["Q" :quarter " - " :year] ; Q4 - 2022
   :minute-of-hour  [:minute-d]                ; 6, 24
   :day-of-week     [:day-of-week-full]        ; Monday; Mon
   :day-of-month    [:day-of-month-d]          ; 7, 23
   :day-of-year     [:day-of-year]             ; 1, 24, 365
   :week-of-year    [:week-of-year]            ; CLJS: 1st, 42nd; CLJ: 1, 42 (no ordinals)
   :month-of-year   [:month-full]              ; October; Oct
   :quarter-of-year ["Q" :quarter]})           ; Q4

Map of {date_style {unit format}}. If given eg. the style "M/D/YYYY" but a unit of months, we don't want to use that directly for the format, since it contains days. This map transforms the date_style + unit pair to the format data structure.

(def ^:private date-style-to-format-overrides
  (let [m-y     [:month-d "/" :year]
        mmm-y   [:month-full ", " :year]]
    {"M/D/YYYY"           {:month   m-y}
     "D/M/YYYY"           {:month   m-y}
     "YYYY/M/D"           {:month   [:year "/" :month-d]
                           :quarter [:year " - Q" :quarter]}
     "MMMM D, YYYY"       {:month   mmm-y}
     "D MMMM, YYYY"       {:month   mmm-y}
     "dddd, MMMM D, YYYY" {:week    [:month-full " " :day-of-month-d ", " :year]
                           :month   mmm-y}}))
(def ^:private fallback-iso-format
  [:year "-" :month-dd "-" :day-of-month-dd "T" :hour-24-dd ":" :minute-dd ":" :second-dd])

The :date-style is transformed to a :date-format as follows: 0. If :date-format is set, just use that. 1. Check [[date-style-to-format-overrides]] for a style + unit override. 2. Check [[default-date-formats-for-unit]] for a unit-specific format. 3. Check [[constants/known-date-styles]] for a basic format. 4. Fall back to a standard ISO date string, emitting a warning.

(defn- resolve-date-style
  [{:keys [date-format date-style unit]}]
  (or date-format
      (get-in date-style-to-format-overrides [date-style unit])
      (get default-date-formats-for-unit unit)
      (get constants/known-date-styles date-style)
      (do
        (log/warn "Unrecognized date style" {:date-style date-style
                                             :unit       unit})
        fallback-iso-format)))
(defn- normalize-date-format [{:keys [date-format] :as options}]
  (merge options (get constants/known-datetime-styles date-format)))
(defn- prepend-weekday [date-format]
  (concat [:day-of-week-short ", "] date-format))

Derives a date format data structure from an options map.

There are three possible sources of the final date format: 1. A directly provided :date-format, which is either a string or a [[metabase.shared.formatting.internal.date-builder]] format structure. 2. :date_style as a provided string, a legacy Moment.js format string. 3. [[constants/default-date-style]]

A string :date-format is converted to a date-builder structure. If :date-format is provided in either form, :date-style is ignored. See [[resolve-date-style]] for the details of how the :date-style is transformed to a format structure.

(defn- date-format-for-options
  [{:keys [date-separator weekday-enabled] :as options}]
  (let [date-format (-> options normalize-date-format resolve-date-style)]
    (cond-> date-format
      date-separator                   (apply-date-separator date-separator)
      weekday-enabled                  prepend-weekday
      (constants/abbreviated? options) apply-date-abbreviation)))

------------------------------------------ Standardized Formats ------------------------------------------------

(def ^:private short-month-day
  (builder/->formatter [:month-short " " :day-of-month-d]))
(def ^:private full-month-day
  (builder/->formatter [:month-full  " " :day-of-month-d]))
(def ^:private short-month-day-year
  (builder/->formatter [:month-short " " :day-of-month-d ", " :year]))
(def ^:private full-month-day-year
  (builder/->formatter [:month-full  " " :day-of-month-d ", " :year]))
(defn- short-months? [{:keys [type] :as options}]
  (and (constants/abbreviated? options) (not= type "tooltip")))

Helper that gets the right month-day-year format based on the options: either full "April 6, 2022" or shortened "Apr 6, 2022".

(defn month-day-year
  [options]
  (if (short-months? options)
    short-month-day-year
    full-month-day-year))

Helper that gets the right month-day format based on the options: either full "April 6" or shortened "Apr 6".

(defn month-day
  [options]
  (if (short-months? options)
    short-month-day
    full-month-day))
(def ^:private big-endian-day-format
  [:year "-" :month-dd "-" :day-of-month-dd])

A cached, commonly used formatter for dates in "2022-04-22" form.

(def big-endian-day
  (builder/->formatter big-endian-day-format))

A cached, commonly used formatter for times in 12-hour "7 PM" form.

(def hour-only
  (builder/->formatter [:hour-12-d " " :am-pm]))

A cached, commonly used formatter for full weekday names.

(def weekday
  (builder/->formatter [:day-of-week-full]))

--------------------------------------------- Time formatters ----------------------------------------------------

(defn- english-time-seconds [inner]
  (vec (concat [:hour-12-d ":" :minute-dd ":" :second-dd]
               inner
               [" " :am-pm])))
(def ^:private iso-time-seconds
  [:hour-24-dd ":" :minute-dd ":" :second-dd])
(def ^:private time-style-to-format
  {"h:mm A" {nil            (english-time-seconds [])
             "seconds"      (english-time-seconds [])
             "milliseconds" (english-time-seconds ["." :millisecond-ddd])}
   "HH:mm"  {nil            iso-time-seconds
             "seconds"      iso-time-seconds
             "milliseconds" (into iso-time-seconds ["." :millisecond-ddd])}})
(def ^:private fallback-iso-time
  [:hour-24-dd ":" :minute-dd ":" :second-dd])

The time format is resolved as follows: 1. If a :time-format is provided as a string, look it up in [[constants/known-time-styles]], throwing if not found. 2. If a :time-format is provided directly as a [[builder]] structure, use that. 3. Check [[time-style-to-format]] for a supported :time-style + :time-enabled resolution pair. 4. Look up :time-style in [[constants/known-time-styles]]. 5. Throw an exception, since the time style is unknown.

(defn- time-format-for-options
  [{:keys [time-enabled time-format time-style] :as options}]
  (or (and (string? time-format)
           (or (get constants/known-time-styles time-format)
               (throw (ex-info "Unknown time format" options))))
      time-format
      (get-in time-style-to-format [time-style time-enabled])
      (get constants/known-time-styles time-style)
      (do
        (log/warn "Unrecognized time style" {:time-style   time-style
                                             :time-enabled time-enabled})
        fallback-iso-time)))

------------------------------------- Custom formatters from options --------------------------------------------- These are cached, since the formatter is always identical for the same options.

(defn- options->formatter*
  [{:keys [date-enabled time-enabled] :as options}]
  ;; TODO The original emits a console warning if the date-style is not in the overrides map. Reproduce that?
  (let [date-format (when date-enabled (date-format-for-options options))
        time-format (when time-enabled (time-format-for-options options))
        format-list (if (and date-format time-format)
                      (concat date-format [", "] time-format)
                      ;; At most one format is given; use that one.
                      ;; If neither is set, emit a warning and use ISO standard format.
                      (or date-format
                          time-format
                          (do
                            (log/warn "Unrecognized date/time format" options)
                            fallback-iso-format)))]
    (builder/->formatter format-list)))
(def ^:private options->formatter-cache (atom {}))

Given the options map, this reduces it to a formatter function. Expects date-style and time-style, if provided, to be in the known set. If they're unknown, this logs a warning and defaults to a full ISO 8601 string format. If date-style or time-style are set to nil, that part will not be included.

The options and corresponding formatters are cached indefinitely, since there are generally only a few dozen different sets of options, and from hundreds to many thousands of dates will be formatted in a typical session.

(defn options->formatter
  [options]
  {:pre [(map? options)]} ;; options must be a Clojure map from date-options/prepare-options
  (if-let [fmt (get @options->formatter-cache options)]
    fmt
    (-> (swap! options->formatter-cache
               (fn [cache]
                 (if (contains? cache options)
                   cache
                   (assoc cache options (options->formatter* options)))))
        (get options))))
 

Normalization and helper predicates for date formatting options maps.

(ns metabase.shared.formatting.internal.date-options
  (:require
   [metabase.shared.formatting.constants :as constants]
   [metabase.util :as u]))
(def ^:private default-options
  {:date-enabled   true
   :date-style     constants/default-date-style
   :time-style     constants/default-time-style
   :output-density "default"
   :unit           :default})
(def ^:private units-with-hour
  #{:default  :minute  :hour  :hour-of-day})
(def ^:private units-with-day
  #{nil :default :minute :hour :day :week})
(def ^:private time-only?
  #{:hour-of-day})

Normalizes the options map. This returns a Clojure map with :kebab-case-keys, whatever the input object or key spelling.

Mixes in the [[default-options]], plus: - defaulting :time-enabled to "minutes" if the :unit is smaller than a day. - transforming :date-format and :time-format to the corresponding styles. - transforming :type of "cell" or "tooltip" to condensed output density - transforming :compact true to :output-density "compact" (takes precedence over "condensed"). - make :unit a keyword

(defn prepare-options
  [options]
  (let [options                               (-> (u/normalize-map options)
                                                  (update :unit keyword))
        {:keys [compact date-abbreviate
                type unit]
         :as options}                         (merge default-options
                                                     (when (units-with-hour (:unit options))
                                                       {:time-enabled "minutes"})
                                                     options)]
    (cond-> options
      true                         (dissoc :compact :date-abbreviate)
      (time-only? unit)            (assoc :date-enabled false)
      (= type "tooltip")           (assoc :output-density "condensed")
      (or compact date-abbreviate) (assoc :output-density "compact")
      (not (units-with-day unit))  (dissoc :weekday-enabled))))
 

JVM Clojure implementation of the [[core/NumberFormatter]] abstaction.

(ns metabase.shared.formatting.internal.numbers
  (:require
   [clojure.string :as str]
   [metabase.shared.formatting.internal.numbers-core :as core]
   [metabase.shared.util.currency :as currency])
  (:import
   (java.math BigDecimal MathContext RoundingMode)
   (java.text DecimalFormat NumberFormat)
   (java.util Currency Locale)))
(set! *warn-on-reflection* true)

Clojure helpers ================================================================================================

(defn- sig-figs [number figures]
  (BigDecimal. (double number) (MathContext. figures RoundingMode/HALF_UP)))
(defn- str-run [n x]
  (apply str (repeat n x)))
(defn- attach-currency-symbol [text ^NumberFormat nf ^Locale locale currency]
  (str (currency/currency-symbol currency)
       (subs text (count (.getSymbol (.getCurrency nf) locale)))))
(defn- symbol-for [currency locale]
  (case currency
    :BTC "₿"
    (-> (name currency)
        (Currency/getInstance)
        (.getSymbol locale))))
(defn- apply-currency-style [text ^Currency _currency ^Locale locale style currency-key]
  (let [sym   (symbol-for currency-key locale)
        ;; TODO Our currency table has plurals but no translation; Java's `Currency.getDisplayName` is singular but
        ;; translated. We should get the names in currency/currency keyed by locale.
        currency (get currency/currency currency-key)]
    (case (or style "symbol")
      "symbol" (str/replace text sym (:symbol currency)) ; Java's symbols are not identical to ours
      "name"   (str (str/replace text sym ) " " (:name_plural currency))
      "code"   (str/replace text sym (str (:code currency) core/non-breaking-space)))))

Currencies known not to be supported by the Java [[Currency]] classes. Rendered as USD, then the symbols are replaced.

Core internals =================================================================================================

(def ^:private bad-currencies
  #{:BTC})
(defn- active-locale [options]
  (if (:locale options)
    (Locale. (:locale options))
    (Locale/getDefault)))
(defn- number-formatter-for-options-baseline
  ^NumberFormat [{:keys [maximum-fraction-digits minimum-fraction-digits number-style]} locale]
  (let [^NumberFormat nf (case number-style
                           ;; For scientific, assemble the 0.###E0 DecimalFormat pattern.
                           "scientific" (DecimalFormat. (str "0."
                                                             (str-run (or minimum-fraction-digits 0) "0")
                                                             (str-run (- (or maximum-fraction-digits 2)
                                                                         (or minimum-fraction-digits 0))
                                                                      "#")
                                                             "E0"))
                           "currency"   (NumberFormat/getCurrencyInstance locale)
                           "percent"    (NumberFormat/getPercentInstance locale)
                           (NumberFormat/getInstance locale))]
    (when (not (= number-style #"scientific"))
      (.setMaximumFractionDigits nf (or maximum-fraction-digits 300)))
    nf))
(defn- set-rounding! [^NumberFormat nf]
  ;; JavaScript does not support picking the rounding mode; it's always HALF_UP.
  ;; (Intl.NumberFormat has an option `roundingMode` but it's new and not supported anywhere as of EOY2022.)
  ;; Since Java is flexible, we match the HALF_UP behavior here.
  (.setRoundingMode nf RoundingMode/HALF_UP))
(defn- set-minimum-fraction! [^NumberFormat nf options]
  (when (:minimum-fraction-digits options)
    (.setMinimumFractionDigits nf (:minimum-fraction-digits options))))
(defn- set-currency! [^NumberFormat nf currency]
  (when currency
    (.setCurrency nf (if (bad-currencies currency)
                       ;; For the currencies the JVM doesn't support, we use USD and replace the symbols later.
                       (Currency/getInstance "USD")
                       (Currency/getInstance (name currency))))))
(defn- set-separators! [^NumberFormat nf options]
  (when-let [[decimal grouping] (:number-separators options)]
    (let [^DecimalFormat df nf
          syms              (.getDecimalFormatSymbols df)]
      (when decimal
        (.setDecimalSeparator syms decimal))
      (if grouping
        (.setGroupingSeparator syms grouping)
        (.setGroupingUsed df false))
      (.setDecimalFormatSymbols df syms))))
(defn- prepare-number-formatter! [^NumberFormat nf options currency]
  (set-rounding! nf)
  (set-minimum-fraction! nf options)
  (set-currency! nf currency)
  (set-separators! nf options))

Certain options do not map into Java's [[NumberFormat]] classes. They are handled by preprocessing the number (eg. by rounding) instead.

(defn- preformat-step
  [options]
  (if (:maximum-significant-digits options)
    #(sig-figs % (:maximum-significant-digits options))
    identity))

The key function implemented for each language, and called by the top-level number formatting. Returns a [[core/NumberFormatter]] instance for each set of options. These formatters are reusable, but this does no caching.

(defn number-formatter-for-options
  [options]
  (let [currency     (some-> options :currency keyword)
        locale       (active-locale options)
        currency-sym (some-> currency (symbol-for locale))
        nf           (number-formatter-for-options-baseline options locale)
        pre          (preformat-step options)]
    (prepare-number-formatter! nf options currency)
    (reify
      core/NumberFormatter
      (format-number-basic [_ number]
        (cond-> (.format nf (pre (bigdec (double number))))
          ;; If running a "bad" currency Java doesn't support, replace the default symbol with the real one.
          (and currency (bad-currencies currency))
          (attach-currency-symbol nf locale currency)
          ;; Handle the :currency-style option, which isn't supported natively on Java.
          currency
          (apply-currency-style (.getCurrency nf) locale (:currency-style options) currency)))
      (wrap-currency [_ text]
        (str currency-sym text))
      (split-exponent [_ formatted]
        (let [^DecimalFormat df nf ;; Scientific mode always uses the DecimalFormat subclass.
              sep (.. df getDecimalFormatSymbols getExponentSeparator)
              exp (str/last-index-of formatted sep)]
          {:mantissa (subs formatted 0 exp)
           :exponent (subs formatted (+ exp (count sep)))})))))

Formats a number in scientific notation. The wrangling required differs by platform.

Scientific notation ============================================================================================

(defn format-number-scientific
  [number options]
  (let [nf   (-> options core/prep-options number-formatter-for-options)
        base (core/format-number-basic nf number)
        {:keys [mantissa exponent]} (core/split-exponent nf base)
        ?plus (when-not (str/starts-with? exponent "-") "+")]
    (str mantissa "e" ?plus exponent)))
 

ClojureScript implementation of number formatting. Implements the [[NumberFormatter]] protocol from numbers_core, plus some helpers.

(ns metabase.shared.formatting.internal.numbers
  (:require
   [clojure.string :as str]
   [metabase.shared.formatting.internal.numbers-core :as core]
   [metabase.shared.util.currency :as currency]
   [metabase.util :as u]))
(def ^:private default-number-separators ".,")
(defn- adjust-number-separators [text separators]
  (if (and separators
           (not= separators default-number-separators))
    (let [decimal    (first separators)
          grouping   (or (second separators) ) ; grouping separators are optional
          transform  {"," grouping "." decimal}]
      (str/replace text #"[\.,]" transform))
    text))
(defn- fix-currency-symbols [text currency]
  (let [sym (currency/currency-symbol currency)]
    (-> text
        ;; Some have spaces and some don't - remove the space if it's there.
        (str/replace (str (name currency) core/non-breaking-space) sym)
        (str/replace (name currency) sym))))
(defn- base-format-scientific [nf number]
  (letfn [(transform [{:keys [type value]}]
            (case type
              "exponentSeparator" "e"
              value))]
    (let [parts  (js->clj (.formatToParts nf number) {:keywordize-keys true})
          ;; If there's no exponent minus sign, add a plus sign.
          parts  (if (some #(= (:type %) "exponentMinusSign") parts)
                   parts
                   (let [[pre post] (split-with #(not= (:type %) "exponentInteger") parts)]
                     (concat pre [{:type "exponentPlusSign" :value "+"}] post)))]
      (apply str (map transform parts)))))

Core internals ================================================================================================= TODO(braden) We could get more nicely localized currency values by using the user's locale. The problem is that then we don't know what the number separators are. We could determine it with a simple test like formatting 12345.67, though. Using "en" here means, among other things, that currency values are not localized as well as they could be. Many European languages put currency signs as suffixes, eg. 123 euros is: - "€123.00" in "en" - "€123,00" with "en" but fixing up the separators for a German locale - "123,00 €" in actual German convention, which is what we would get with a native "de" locale here.

(defn- number-formatter-for-options-baseline [options]
  (let [default-fraction-digits (when (= (:number-style options) "currency")
                                  2)]
    (js/Intl.NumberFormat.
      "en"
      (clj->js (u/remove-nils
                 {:style    (when-not (= (:number-style options) "scientific")
                              (:number-style options "decimal"))
                  :notation (when (= (:number-style options) "scientific")
                              "scientific")
                  :currency (:currency options)
                  :currencyDisplay (:currency-style options)
                  ;; Always use grouping separators, but we may remove them per number_separators.
                  :useGrouping              true
                  :minimumIntegerDigits     (:minimum-integer-digits     options)
                  :minimumFractionDigits    (:minimum-fraction-digits    options default-fraction-digits)
                  :maximumFractionDigits    (:maximum-fraction-digits    options default-fraction-digits)
                  :minimumSignificantDigits (:minimum-significant-digits options)
                  :maximumSignificantDigits (:maximum-significant-digits options)})))))
(defn- currency-symbols? [options]
  (let [style (:currency-style options)]
    (and (:currency options)
         (or (nil? style)
             (= style "symbol")))))
(defn- formatter-fn [nf options]
  (case (:number-style options)
    "scientific" #(base-format-scientific nf %)
    #(.format nf %)))

The key function implemented for each language, and called by the top-level number formatting. Returns a [[core/NumberFormatter]] instance for each set of options. These formatters are reusable, but this does no caching.

(defn number-formatter-for-options
  [options]
  (let [nf        (number-formatter-for-options-baseline options)
        symbols?  (currency-symbols? options)
        formatter (formatter-fn nf options)]
    (reify
      core/NumberFormatter
      (format-number-basic [_ number]
        (cond-> (formatter number)
          true     (adjust-number-separators (:number-separators options))
          symbols? (fix-currency-symbols (:currency options))))
      (wrap-currency [_ text]
        ;; Intl.NumberFormat.formatToParts(1) returns, eg. [currency, integer, decimal, fraction]
        ;; Keep only currency and integer, and replace integer's :value with our provided text.
        (apply str (for [{:keys [type value]} (js->clj (.formatToParts nf 1) :keywordize-keys true)
                         :when (#{"currency" "integer"} type)]
                     (if (= type "integer")
                       text
                       value))))
      (split-exponent [_ formatted] (throw (ex-info "split-exponent not implemented" {:text formatted}))))))

Formats a number in scientific notation. The wrangling required differs by platform.

Scientific notation ============================================================================================

(defn format-number-scientific
  [number options]
  (-> (core/prep-options options)
      number-formatter-for-options
      (core/format-number-basic number)))
 

Cross-platform foundation for the number formatters.

(ns metabase.shared.formatting.internal.numbers-core
  (:require
   [metabase.shared.util.currency :as currency]))

Options ========================================================================================================

(defn- default-decimal-places [{:keys [currency number-style]}]
  (if (and currency (= number-style "currency"))
    (let [places (-> currency keyword (@currency/currency-map) :decimal_digits)]
      {:minimum-fraction-digits places
       :maximum-fraction-digits places})
    {:maximum-fraction-digits 2}))

Transforms input options with defaults and other adjustments. Defaults: - :maximum-fraction-digits is 2 if not specified - BUT if :currency is set, :minimum-fraction-digits = :maximum-fraction-digits = (:decimal_digits currency)

Adjustments: - :decimals is dropped, and both min and max fraction-digits are set to that value.

(defn prep-options
  [options]
  (letfn [(expand-decimals [opts]
            (-> opts
                (dissoc :decimals)
                (assoc :maximum-fraction-digits (:decimals options)
                       :minimum-fraction-digits (:decimals options))))]
    (cond-> (merge (default-decimal-places options) options)
      (:decimals options) expand-decimals)))

A Unicode non-breaking space character.

(def non-breaking-space
  \u00a0)

Formatter abstraction ==========================================================================================

(defprotocol NumberFormatter
  (format-number-basic [this number] "Returns a String that represents the number in this format.")
  (split-exponent [this formatted]
                  "Given a scientific notation string, split it at the locale-dependent exponent.
                  Returns a map `{:mantissa \"123\" :exponent \"+4\"}`.")
  (wrap-currency [this text] "Given an opaque string, wraps it with the currency prefix/suffix for this locale."))
 
(ns metabase.shared.formatting.numbers
  (:require
   [metabase.shared.formatting.internal.numbers :as internal]
   [metabase.shared.formatting.internal.numbers-core :as core]
   [metabase.util :as u]))
(declare format-number)

Extra defaults that are mixed in when formatted a currency value in compact mode.

(def compact-currency-options
  {:currency-style "symbol"})
#?(:cljs
   (def ^:export compact-currency-options-js
     "Extra defaults that are mixed in when formatted a currency value in compact mode."
     (clj->js compact-currency-options)))
;; Compact form ===================================================================================================
(def ^:private display-compact-decimals-cutoff 1000)
(def ^:private humanized-powers
  [[1000000000000 "T"]
   [1000000000    "B"]
   [1000000       "M"]
   [1000          "k"]])
(defn- format-number-compact-basic [number options]
  (let [options   (dissoc options :compact :number-style)
        abs-value (abs number)]
    (cond
      (zero? number) "0"
      (< abs-value display-compact-decimals-cutoff) (format-number number options)
      :else (let [[power suffix] (first (filter #(>= abs-value (first %)) humanized-powers))]
              (str (format-number (/ number power)
                                  (merge options {:minimum-fraction-digits 1 :maximum-fraction-digits 1}))
                   suffix)))))
(defmulti ^:private format-number-compact* (fn [_ {:keys [number-style]}] number-style))
(defmethod format-number-compact* :default [number options]
  (format-number-compact-basic number options))
(defmethod format-number-compact* "percent" [number options]
  (str (format-number-compact-basic (* 100 number) options) "%"))
(defmethod format-number-compact* "currency" [number options]
  (let [options   (merge options compact-currency-options)
        formatter (internal/number-formatter-for-options options)]
    (if (< (abs number) display-compact-decimals-cutoff)
      (core/format-number-basic formatter number)
      (core/wrap-currency formatter (format-number-compact-basic number options)))))
(defmethod format-number-compact* "scientific" [number options]
  (internal/format-number-scientific number (merge options {:maximum-fraction-digits 1 :minimum-fraction-digits 1})))
(defn- format-number-compact [number options]
  (format-number-compact* number (-> options
                                     (dissoc :compact)
                                     core/prep-options)))

High-level =====================================================================================================

(defn- format-number-standard [number options]
  (let [options (core/prep-options options)
        nf (cond
             (:number-formatter options) (:number-formatter options)
             ;; Hacky special case inherited from the TS version - to match classic behavior for small numbers,
             ;; treat maximum-fraction-digits as maximum-significant-digits instead.
             ;; "Small" means |x| < 1, or < 1% for percentages.
             (and (not (:decimals options))
                  (not (:minimum-fraction-digits options))
                  (not= (:number-style options) "currency")
                  (< (abs number)
                     (if (= (:number-style options) "percent")
                       0.01
                       1)))
             (-> options
                 (dissoc :maximum-fraction-digits)
                 (assoc :maximum-significant-digits (max 2 (:minimum-significant-digits options 0)))
                 internal/number-formatter-for-options)
             :else (internal/number-formatter-for-options options))]
    (core/format-number-basic nf number)))

Formats a number according to a map of options. The options: - :compact boolean: Set true for human-readable contractions like $2.4M rather than $2,413,326.98. - :currency string: The ISO currency code, eg. USD, RMB, EUR. Required when :number-style "currency". - :currency-style "symbol" | "code" | "name": Sets how the currency unit is displayed. Default is "symbol". - :maximum-fraction-digits number: Show at most this many decimal places. Default 2. - :minimum-fraction-digits number: Show at least this many decimal places. Default 0, or 2 for currencies. - :minimum-integer-digits number: Show at least this many integer digits. Default 1. - :maximum-significant-digits number: Show at most this many significant figures. Default not set; no extra rounding. - :minimum-significant-digits number: Show at least this many significant figures. Default not set; no padding. - :negative-in-parentheses boolean: True wraps negative values in parentheses; false (the default) uses minus signs. - :number-serpators string: A two-character string "ab" where a is the decimal symbol and b is the grouping. Default is American-style ".,". - :number-style "currency" | "decimal" | "scientific" | "percent": The fundamental type to display. - "currency" renders as eg. "$123.45" based on the :currency value. - "percent" renders eg. 0.432 as "43.2%". - "scientific" renders in scientific notation with 1 integer digit: eg. 0.00432 as "4.32e-3". - "decimal" (the default) is basic numeric notation. - :scale number: Gives a factor by which to multiply the value before rendering it.

(defn ^:export format-number
  [number options]
  (let [{:keys [compact negative-in-parentheses number-style scale] :as options} (u/normalize-map options)]
    (cond
      (and scale (not (NaN? scale))) (format-number (* scale number) (dissoc options :scale))
      (and (neg? number)
           negative-in-parentheses)  (str "("
                                          (format-number (- number) (assoc options :negative-in-parentheses false))
                                          ")")
      compact                        (format-number-compact number options)
      (= (keyword number-style)
         :scientific)                (internal/format-number-scientific number options)
      :else                          (format-number-standard   number options))))
 

The list of currencies, and associated metadata, used by Metabase for number formatting.

(ns metabase.shared.util.currency)

Currencies for which the Metabase frontend supports formatting with its symbol, rather than just its code or name. This list is referenced during XLSX export to achieve parity in currency formatting.

(defn supports-symbol?
  [currency-code]
  (contains?
   #{:USD  ;; US dollar
     :CAD  ;; Canadian dollar
     :EUR  ;; Euro
     :AUD  ;; Australian dollar
     :BRL  ;; Brazilian real
     :CNY  ;; Chinese yuan
     :GBP  ;; British pound
     :HKD  ;; Hong Kong dollar
     :ILS  ;; Israeli new shekel
     :INR  ;; Indian rupee
     :JPY  ;; Japanese yen
     :KRW  ;; South Korean won
     :MXN  ;; Mexican peso
     :NZD  ;; New Zealand dollar
     :TWD  ;; New Taiwan dollar
     :VND} ;; Vietnamese dong
   (keyword currency-code)))
(def ^:private currency-list
  [[:USD {:symbol "$",
          :name "US Dollar",
          :symbol_native "$",
          :decimal_digits 2,
          :rounding 0,
          :code "USD",
          :name_plural "US dollars"}],
   [:CAD {:symbol "CA$",
          :name "Canadian Dollar",
          :symbol_native "$",
          :decimal_digits 2,
          :rounding 0,
          :code "CAD",
          :name_plural "Canadian dollars"}],
   [:EUR {:symbol "€",
          :name "Euro",
          :symbol_native "€",
          :decimal_digits 2,
          :rounding 0,
          :code "EUR",
          :name_plural "euros"}],
   [:AED {:symbol "AED",
          :name "United Arab Emirates Dirham",
          :symbol_native "د.إ.‏",
          :decimal_digits 2,
          :rounding 0,
          :code "AED",
          :name_plural "UAE dirhams"}],
   [:AFN {:symbol "Af",
          :name "Afghan Afghani",
          :symbol_native "؋",
          :decimal_digits 0,
          :rounding 0,
          :code "AFN",
          :name_plural "Afghan Afghanis"}],
   [:ALL {:symbol "ALL",
          :name "Albanian Lek",
          :symbol_native "Lek",
          :decimal_digits 0,
          :rounding 0,
          :code "ALL",
          :name_plural "Albanian lekë"}],
   [:AMD {:symbol "AMD",
          :name "Armenian Dram",
          :symbol_native "դր.",
          :decimal_digits 0,
          :rounding 0,
          :code "AMD",
          :name_plural "Armenian drams"}],
   [:ARS {:symbol "AR$",
          :name "Argentine Peso",
          :symbol_native "$",
          :decimal_digits 2,
          :rounding 0,
          :code "ARS",
          :name_plural "Argentine pesos"}],
   [:AUD {:symbol "AU$",
          :name "Australian Dollar",
          :symbol_native "$",
          :decimal_digits 2,
          :rounding 0,
          :code "AUD",
          :name_plural "Australian dollars"}],
   [:AZN {:symbol "₼",
          :name "Azerbaijani Manat",
          :symbol_native "₼",
          :decimal_digits 2,
          :rounding 0,
          :code "AZN",
          :name_plural "Azerbaijani manats"}],
   [:BAM {:symbol "KM",
          :name "Bosnia-Herzegovina Convertible Mark",
          :symbol_native "KM",
          :decimal_digits 2,
          :rounding 0,
          :code "BAM",
          :name_plural "Bosnia-Herzegovina convertible marks"}],
   [:BDT {:symbol "Tk",
          :name "Bangladeshi Taka",
          :symbol_native "৳",
          :decimal_digits 2,
          :rounding 0,
          :code "BDT",
          :name_plural "Bangladeshi takas"}],
   [:BGN {:symbol "BGN",
          :name "Bulgarian Lev",
          :symbol_native "лв.",
          :decimal_digits 2,
          :rounding 0,
          :code "BGN",
          :name_plural "Bulgarian leva"}],
   [:BHD {:symbol "BD",
          :name "Bahraini Dinar",
          :symbol_native "د.ب.‏",
          :decimal_digits 3,
          :rounding 0,
          :code "BHD",
          :name_plural "Bahraini dinars"}],
   [:BIF {:symbol "FBu",
          :name "Burundian Franc",
          :symbol_native "FBu",
          :decimal_digits 0,
          :rounding 0,
          :code "BIF",
          :name_plural "Burundian francs"}],
   [:BND {:symbol "BN$",
          :name "Brunei Dollar",
          :symbol_native "$",
          :decimal_digits 2,
          :rounding 0,
          :code "BND",
          :name_plural "Brunei dollars"}],
   [:BOB {:symbol "Bs",
          :name "Bolivian Boliviano",
          :symbol_native "Bs",
          :decimal_digits 2,
          :rounding 0,
          :code "BOB",
          :name_plural "Bolivian bolivianos"}],
   [:BRL {:symbol "R$",
          :name "Brazilian Real",
          :symbol_native "R$",
          :decimal_digits 2,
          :rounding 0,
          :code "BRL",
          :name_plural "Brazilian reals"}],
   [:BTC {:symbol "₿",
          :name "Bitcoin",
          :symbol_native "BTC",
          :decimal_digits 8,
          :rounding 0,
          :code "BTC",
          :name_plural "Bitcoins"}],
   [:BWP {:symbol "BWP",
          :name "Botswanan Pula",
          :symbol_native "P",
          :decimal_digits 2,
          :rounding 0,
          :code "BWP",
          :name_plural "Botswanan pulas"}],
   [:BYR {:symbol "BYR",
          :name "Belarusian Ruble",
          :symbol_native "BYR",
          :decimal_digits 0,
          :rounding 0,
          :code "BYR",
          :name_plural "Belarusian rubles"}],
   [:BZD {:symbol "BZ$",
          :name "Belize Dollar",
          :symbol_native "$",
          :decimal_digits 2,
          :rounding 0,
          :code "BZD",
          :name_plural "Belize dollars"}],
   [:CDF {:symbol "CDF",
          :name "Congolese Franc",
          :symbol_native "FrCD",
          :decimal_digits 2,
          :rounding 0,
          :code "CDF",
          :name_plural "Congolese francs"}],
   [:CHF {:symbol "CHF",
          :name "Swiss Franc",
          :symbol_native "CHF",
          :decimal_digits 2,
          :rounding 0.05,
          :code "CHF",
          :name_plural "Swiss francs"}],
   [:CLP {:symbol "CL$",
          :name "Chilean Peso",
          :symbol_native "$",
          :decimal_digits 0,
          :rounding 0,
          :code "CLP",
          :name_plural "Chilean pesos"}],
   [:CNY {:symbol "CN¥",
          :name "Chinese Yuan",
          :symbol_native "CN¥",
          :decimal_digits 2,
          :rounding 0,
          :code "CNY",
          :name_plural "Chinese yuan"}],
   [:COP {:symbol "CO$",
          :name "Colombian Peso",
          :symbol_native "$",
          :decimal_digits 0,
          :rounding 0,
          :code "COP",
          :name_plural "Colombian pesos"}],
   [:CRC {:symbol "₡",
          :name "Costa Rican Colón",
          :symbol_native "₡",
          :decimal_digits 0,
          :rounding 0,
          :code "CRC",
          :name_plural "Costa Rican colóns"}],
   [:CVE {:symbol "CV$",
          :name "Cape Verdean Escudo",
          :symbol_native "CV$",
          :decimal_digits 2,
          :rounding 0,
          :code "CVE",
          :name_plural "Cape Verdean escudos"}],
   [:CZK {:symbol "Kč",
          :name "Czech Republic Koruna",
          :symbol_native "Kč",
          :decimal_digits 2,
          :rounding 0,
          :code "CZK",
          :name_plural "Czech Republic korunas"}],
   [:DJF {:symbol "Fdj",
          :name "Djiboutian Franc",
          :symbol_native "Fdj",
          :decimal_digits 0,
          :rounding 0,
          :code "DJF",
          :name_plural "Djiboutian francs"}],
   [:DKK {:symbol "Dkr",
          :name "Danish Krone",
          :symbol_native "kr",
          :decimal_digits 2,
          :rounding 0,
          :code "DKK",
          :name_plural "Danish kroner"}],
   [:DOP {:symbol "RD$",
          :name "Dominican Peso",
          :symbol_native "RD$",
          :decimal_digits 2,
          :rounding 0,
          :code "DOP",
          :name_plural "Dominican pesos"}],
   [:DZD {:symbol "DA",
          :name "Algerian Dinar",
          :symbol_native "د.ج.‏",
          :decimal_digits 2,
          :rounding 0,
          :code "DZD",
          :name_plural "Algerian dinars"}],
   [:EGP {:symbol "EGP",
          :name "Egyptian Pound",
          :symbol_native "ج.م.‏",
          :decimal_digits 2,
          :rounding 0,
          :code "EGP",
          :name_plural "Egyptian pounds"}],
   [:ERN {:symbol "Nfk",
          :name "Eritrean Nakfa",
          :symbol_native "Nfk",
          :decimal_digits 2,
          :rounding 0,
          :code "ERN",
          :name_plural "Eritrean nakfas"}],
   [:ETB {:symbol "Br",
          :name "Ethiopian Birr",
          :symbol_native "Br",
          :decimal_digits 2,
          :rounding 0,
          :code "ETB",
          :name_plural "Ethiopian birrs"}],
   [:ETH {:symbol "ETH",
          :name "Ethereum",
          :symbol_native "ETH",
          :decimal_digits 8,
          :rounding 0,
          :code "ETH",
          :name_plural "Ethereum"}],
   [:GBP {:symbol "£",
          :name "British Pound Sterling",
          :symbol_native "£",
          :decimal_digits 2,
          :rounding 0,
          :code "GBP",
          :name_plural "British pounds sterling"}],
   [:GEL {:symbol "GEL",
          :name "Georgian Lari",
          :symbol_native "GEL",
          :decimal_digits 2,
          :rounding 0,
          :code "GEL",
          :name_plural "Georgian laris"}],
   [:GHS {:symbol "GH₵",
          :name "Ghanaian Cedi",
          :symbol_native "GH₵",
          :decimal_digits 2,
          :rounding 0,
          :code "GHS",
          :name_plural "Ghanaian cedis"}],
   [:GNF {:symbol "FG",
          :name "Guinean Franc",
          :symbol_native "FG",
          :decimal_digits 0,
          :rounding 0,
          :code "GNF",
          :name_plural "Guinean francs"}],
   [:GTQ {:symbol "GTQ",
          :name "Guatemalan Quetzal",
          :symbol_native "Q",
          :decimal_digits 2,
          :rounding 0,
          :code "GTQ",
          :name_plural "Guatemalan quetzals"}],
   [:HKD {:symbol "HK$",
          :name "Hong Kong Dollar",
          :symbol_native "$",
          :decimal_digits 2,
          :rounding 0,
          :code "HKD",
          :name_plural "Hong Kong dollars"}],
   [:HNL {:symbol "HNL",
          :name "Honduran Lempira",
          :symbol_native "L",
          :decimal_digits 2,
          :rounding 0,
          :code "HNL",
          :name_plural "Honduran lempiras"}],
   [:HRK {:symbol "kn",
          :name "Croatian Kuna",
          :symbol_native "kn",
          :decimal_digits 2,
          :rounding 0,
          :code "HRK",
          :name_plural "Croatian kunas"}],
   [:HUF {:symbol "Ft",
          :name "Hungarian Forint",
          :symbol_native "Ft",
          :decimal_digits 0,
          :rounding 0,
          :code "HUF",
          :name_plural "Hungarian forints"}],
   [:IDR {:symbol "Rp",
          :name "Indonesian Rupiah",
          :symbol_native "Rp",
          :decimal_digits 0,
          :rounding 0,
          :code "IDR",
          :name_plural "Indonesian rupiahs"}],
   [:ILS {:symbol "₪",
          :name "Israeli New Shekel",
          :symbol_native "₪",
          :decimal_digits 2,
          :rounding 0,
          :code "ILS",
          :name_plural "Israeli new shekels"}],
   [:INR {:symbol "Rs",
          :name "Indian Rupee",
          :symbol_native "টকা",
          :decimal_digits 2,
          :rounding 0,
          :code "INR",
          :name_plural "Indian rupees"}],
   [:IQD {:symbol "IQD",
          :name "Iraqi Dinar",
          :symbol_native "د.ع.‏",
          :decimal_digits 0,
          :rounding 0,
          :code "IQD",
          :name_plural "Iraqi dinars"}],
   [:IRR {:symbol "IRR",
          :name "Iranian Rial",
          :symbol_native "﷼",
          :decimal_digits 0,
          :rounding 0,
          :code "IRR",
          :name_plural "Iranian rials"}],
   [:ISK {:symbol "Ikr",
          :name "Icelandic Króna",
          :symbol_native "kr",
          :decimal_digits 0,
          :rounding 0,
          :code "ISK",
          :name_plural "Icelandic krónur"}],
   [:JMD {:symbol "J$",
          :name "Jamaican Dollar",
          :symbol_native "$",
          :decimal_digits 2,
          :rounding 0,
          :code "JMD",
          :name_plural "Jamaican dollars"}],
   [:JOD {:symbol "JD",
          :name "Jordanian Dinar",
          :symbol_native "د.أ.‏",
          :decimal_digits 3,
          :rounding 0,
          :code "JOD",
          :name_plural "Jordanian dinars"}],
   [:JPY {:symbol "¥",
          :name "Japanese Yen",
          :symbol_native "¥",
          :decimal_digits 0,
          :rounding 0,
          :code "JPY",
          :name_plural "Japanese yen"}],
   [:KES {:symbol "Ksh",
          :name "Kenyan Shilling",
          :symbol_native "Ksh",
          :decimal_digits 2,
          :rounding 0,
          :code "KES",
          :name_plural "Kenyan shillings"}],
   [:KGS {:symbol "KGS",
          :name "Kyrgyz Som",
          :symbol_native "сом",
          :decimal_digits 2,
          :rounding 0,
          :code "KGS",
          :name_plural "Kyrgyz soms"}],
   [:KHR {:symbol "KHR",
          :name "Cambodian Riel",
          :symbol_native "៛",
          :decimal_digits 2,
          :rounding 0,
          :code "KHR",
          :name_plural "Cambodian riels"}],
   [:KMF {:symbol "CF",
          :name "Comorian Franc",
          :symbol_native "FC",
          :decimal_digits 0,
          :rounding 0,
          :code "KMF",
          :name_plural "Comorian francs"}],
   [:KRW {:symbol "₩",
          :name "South Korean Won",
          :symbol_native "₩",
          :decimal_digits 0,
          :rounding 0,
          :code "KRW",
          :name_plural "South Korean won"}],
   [:KWD {:symbol "KD",
          :name "Kuwaiti Dinar",
          :symbol_native "د.ك.‏",
          :decimal_digits 3,
          :rounding 0,
          :code "KWD",
          :name_plural "Kuwaiti dinars"}],
   [:KZT {:symbol "KZT",
          :name "Kazakhstani Tenge",
          :symbol_native "тңг.",
          :decimal_digits 2,
          :rounding 0,
          :code "KZT",
          :name_plural "Kazakhstani tenges"}],
   [:LBP {:symbol "LB£",
          :name "Lebanese Pound",
          :symbol_native "ل.ل.‏",
          :decimal_digits 0,
          :rounding 0,
          :code "LBP",
          :name_plural "Lebanese pounds"}],
   [:LKR {:symbol "SLRs",
          :name "Sri Lankan Rupee",
          :symbol_native "SL Re",
          :decimal_digits 2,
          :rounding 0,
          :code "LKR",
          :name_plural "Sri Lankan rupees"}],
   [:LTL {:symbol "Lt",
          :name "Lithuanian Litas",
          :symbol_native "Lt",
          :decimal_digits 2,
          :rounding 0,
          :code "LTL",
          :name_plural "Lithuanian litai"}],
   [:LVL {:symbol "Ls",
          :name "Latvian Lats",
          :symbol_native "Ls",
          :decimal_digits 2,
          :rounding 0,
          :code "LVL",
          :name_plural "Latvian lati"}],
   [:LYD {:symbol "LD",
          :name "Libyan Dinar",
          :symbol_native "د.ل.‏",
          :decimal_digits 3,
          :rounding 0,
          :code "LYD",
          :name_plural "Libyan dinars"}],
   [:MAD {:symbol "MAD",
          :name "Moroccan Dirham",
          :symbol_native "د.م.‏",
          :decimal_digits 2,
          :rounding 0,
          :code "MAD",
          :name_plural "Moroccan dirhams"}],
   [:MDL {:symbol "MDL",
          :name "Moldovan Leu",
          :symbol_native "MDL",
          :decimal_digits 2,
          :rounding 0,
          :code "MDL",
          :name_plural "Moldovan lei"}],
   [:MGA {:symbol "MGA",
          :name "Malagasy Ariary",
          :symbol_native "MGA",
          :decimal_digits 0,
          :rounding 0,
          :code "MGA",
          :name_plural "Malagasy Ariaries"}],
   [:MKD {:symbol "MKD",
          :name "Macedonian Denar",
          :symbol_native "MKD",
          :decimal_digits 2,
          :rounding 0,
          :code "MKD",
          :name_plural "Macedonian denari"}],
   [:MMK {:symbol "MMK",
          :name "Myanma Kyat",
          :symbol_native "K",
          :decimal_digits 0,
          :rounding 0,
          :code "MMK",
          :name_plural "Myanma kyats"}],
   [:MOP {:symbol "MOP$",
          :name "Macanese Pataca",
          :symbol_native "MOP$",
          :decimal_digits 2,
          :rounding 0,
          :code "MOP",
          :name_plural "Macanese patacas"}],
   [:MRU {:symbol "MRU",
          :name "Mauritania Ouguiya",
          :symbol_native "MRU",
          :decimal_digits 2,
          :rounding 0,
          :code "MRU",
          :name_plural "Mauritania Ouguiyas"}],
   [:MUR {:symbol "MURs",
          :name "Mauritian Rupee",
          :symbol_native "MURs",
          :decimal_digits 0,
          :rounding 0,
          :code "MUR",
          :name_plural "Mauritian rupees"}],
   [:MXN {:symbol "MX$",
          :name "Mexican Peso",
          :symbol_native "$",
          :decimal_digits 2,
          :rounding 0,
          :code "MXN",
          :name_plural "Mexican pesos"}],
   [:MYR {:symbol "RM",
          :name "Malaysian Ringgit",
          :symbol_native "RM",
          :decimal_digits 2,
          :rounding 0,
          :code "MYR",
          :name_plural "Malaysian ringgits"}],
   [:MZN {:symbol "MTn",
          :name "Mozambican Metical",
          :symbol_native "MTn",
          :decimal_digits 2,
          :rounding 0,
          :code "MZN",
          :name_plural "Mozambican meticals"}],
   [:NAD {:symbol "N$",
          :name "Namibian Dollar",
          :symbol_native "N$",
          :decimal_digits 2,
          :rounding 0,
          :code "NAD",
          :name_plural "Namibian dollars"}],
   [:NGN {:symbol "₦",
          :name "Nigerian Naira",
          :symbol_native "₦",
          :decimal_digits 2,
          :rounding 0,
          :code "NGN",
          :name_plural "Nigerian nairas"}],
   [:NIO {:symbol "C$",
          :name "Nicaraguan Córdoba",
          :symbol_native "C$",
          :decimal_digits 2,
          :rounding 0,
          :code "NIO",
          :name_plural "Nicaraguan córdobas"}],
   [:NOK {:symbol "Nkr",
          :name "Norwegian Krone",
          :symbol_native "kr",
          :decimal_digits 2,
          :rounding 0,
          :code "NOK",
          :name_plural "Norwegian kroner"}],
   [:NPR {:symbol "NPRs",
          :name "Nepalese Rupee",
          :symbol_native "नेरू",
          :decimal_digits 2,
          :rounding 0,
          :code "NPR",
          :name_plural "Nepalese rupees"}],
   [:NZD {:symbol "NZ$",
          :name "New Zealand Dollar",
          :symbol_native "$",
          :decimal_digits 2,
          :rounding 0,
          :code "NZD",
          :name_plural "New Zealand dollars"}],
   [:OMR {:symbol "OMR",
          :name "Omani Rial",
          :symbol_native "ر.ع.‏",
          :decimal_digits 3,
          :rounding 0,
          :code "OMR",
          :name_plural "Omani rials"}],
   [:PAB {:symbol "B/.",
          :name "Panamanian Balboa",
          :symbol_native "B/.",
          :decimal_digits 2,
          :rounding 0,
          :code "PAB",
          :name_plural "Panamanian balboas"}],
   [:PEN {:symbol "S/.",
          :name "Peruvian Nuevo Sol",
          :symbol_native "S/.",
          :decimal_digits 2,
          :rounding 0,
          :code "PEN",
          :name_plural "Peruvian nuevos soles"}],
   [:PGK {:symbol "K",
          :name "Papua New Guinean Kina",
          :symbol_native "K",
          :decimal_digits 2,
          :rounding 0,
          :code "PGK",
          :name_plural "Papua New Guinean kina"}],
   [:PHP {:symbol "₱",
          :name "Philippine Peso",
          :symbol_native "₱",
          :decimal_digits 2,
          :rounding 0,
          :code "PHP",
          :name_plural "Philippine pesos"}],
   [:PKR {:symbol "PKRs",
          :name "Pakistani Rupee",
          :symbol_native "₨",
          :decimal_digits 0,
          :rounding 0,
          :code "PKR",
          :name_plural "Pakistani rupees"}],
   [:PLN {:symbol "zł",
          :name "Polish Zloty",
          :symbol_native "zł",
          :decimal_digits 2,
          :rounding 0,
          :code "PLN",
          :name_plural "Polish zlotys"}],
   [:PYG {:symbol "₲",
          :name "Paraguayan Guarani",
          :symbol_native "₲",
          :decimal_digits 0,
          :rounding 0,
          :code "PYG",
          :name_plural "Paraguayan guaranis"}],
   [:QAR {:symbol "QR",
          :name "Qatari Rial",
          :symbol_native "ر.ق.‏",
          :decimal_digits 2,
          :rounding 0,
          :code "QAR",
          :name_plural "Qatari rials"}],
   [:RON {:symbol "RON",
          :name "Romanian Leu",
          :symbol_native "RON",
          :decimal_digits 2,
          :rounding 0,
          :code "RON",
          :name_plural "Romanian lei"}],
   [:RSD {:symbol "din.",
          :name "Serbian Dinar",
          :symbol_native "дин.",
          :decimal_digits 0,
          :rounding 0,
          :code "RSD",
          :name_plural "Serbian dinars"}],
   [:RUB {:symbol "₽",
          :name "Russian Ruble",
          :symbol_native "₽",
          :decimal_digits 2,
          :rounding 0,
          :code "RUB",
          :name_plural "Russian rubles"}],
   [:RWF {:symbol "RWF",
          :name "Rwandan Franc",
          :symbol_native "FR",
          :decimal_digits 0,
          :rounding 0,
          :code "RWF",
          :name_plural "Rwandan francs"}],
   [:SAR {:symbol "SR",
          :name "Saudi Riyal",
          :symbol_native "ر.س.‏",
          :decimal_digits 2,
          :rounding 0,
          :code "SAR",
          :name_plural "Saudi riyals"}],
   [:SDG {:symbol "SDG",
          :name "Sudanese Pound",
          :symbol_native "SDG",
          :decimal_digits 2,
          :rounding 0,
          :code "SDG",
          :name_plural "Sudanese pounds"}],
   [:SEK {:symbol "Skr",
          :name "Swedish Krona",
          :symbol_native "kr",
          :decimal_digits 2,
          :rounding 0,
          :code "SEK",
          :name_plural "Swedish kronor"}],
   [:SGD {:symbol "S$",
          :name "Singapore Dollar",
          :symbol_native "$",
          :decimal_digits 2,
          :rounding 0,
          :code "SGD",
          :name_plural "Singapore dollars"}],
   [:SOS {:symbol "Ssh",
          :name "Somali Shilling",
          :symbol_native "Sh.So",
          :decimal_digits 0,
          :rounding 0,
          :code "SOS",
          :name_plural "Somali shillings"}],
   [:SYP {:symbol "SY£",
          :name "Syrian Pound",
          :symbol_native "ل.س.‏",
          :decimal_digits 0,
          :rounding 0,
          :code "SYP",
          :name_plural "Syrian pounds"}],
   [:THB {:symbol "฿",
          :name "Thai Baht",
          :symbol_native "฿",
          :decimal_digits 2,
          :rounding 0,
          :code "THB",
          :name_plural "Thai baht"}],
   [:TND {:symbol "DT",
          :name "Tunisian Dinar",
          :symbol_native "د.ت.‏",
          :decimal_digits 3,
          :rounding 0,
          :code "TND",
          :name_plural "Tunisian dinars"}],
   [:TOP {:symbol "T$",
          :name "Tongan Paʻanga",
          :symbol_native "T$",
          :decimal_digits 2,
          :rounding 0,
          :code "TOP",
          :name_plural "Tongan paʻanga"}],
   [:TRY {:symbol "₺",
          :name "Turkish Lira",
          :symbol_native "₺",
          :decimal_digits 2,
          :rounding 0,
          :code "TRY",
          :name_plural "Turkish Lira"}],
   [:TTD {:symbol "TT$",
          :name "Trinidad and Tobago Dollar",
          :symbol_native "$",
          :decimal_digits 2,
          :rounding 0,
          :code "TTD",
          :name_plural "Trinidad and Tobago dollars"}],
   [:TWD {:symbol "NT$",
          :name "New Taiwan Dollar",
          :symbol_native "NT$",
          :decimal_digits 0,
          :rounding 0,
          :code "TWD",
          :name_plural "New Taiwan dollars"}],
   [:TZS {:symbol "TSh",
          :name "Tanzanian Shilling",
          :symbol_native "TSh",
          :decimal_digits 0,
          :rounding 0,
          :code "TZS",
          :name_plural "Tanzanian shillings"}],
   [:UAH {:symbol "₴",
          :name "Ukrainian Hryvnia",
          :symbol_native "₴",
          :decimal_digits 2,
          :rounding 0,
          :code "UAH",
          :name_plural "Ukrainian hryvnias"}],
   [:UGX {:symbol "USh",
          :name "Ugandan Shilling",
          :symbol_native "USh",
          :decimal_digits 0,
          :rounding 0,
          :code "UGX",
          :name_plural "Ugandan shillings"}],
   [:UYU {:symbol "$U",
          :name "Uruguayan Peso",
          :symbol_native "$",
          :decimal_digits 2,
          :rounding 0,
          :code "UYU",
          :name_plural "Uruguayan pesos"}],
   [:UZS {:symbol "UZS",
          :name "Uzbekistan Som",
          :symbol_native "UZS",
          :decimal_digits 0,
          :rounding 0,
          :code "UZS",
          :name_plural "Uzbekistan som"}],
   [:VEF {:symbol "Bs.S.",
          :name "Venezuelan Bolívar",
          :symbol_native "Bs.S.",
          :decimal_digits 2,
          :rounding 0,
          :code "VES",
          :name_plural "Venezuelan bolívars"}],
   [:VND {:symbol "₫",
          :name "Vietnamese Dong",
          :symbol_native "₫",
          :decimal_digits 0,
          :rounding 0,
          :code "VND",
          :name_plural "Vietnamese dong"}],
   [:XAF {:symbol "FCFA",
          :name "CFA Franc BEAC",
          :symbol_native "FCFA",
          :decimal_digits 0,
          :rounding 0,
          :code "XAF",
          :name_plural "CFA francs BEAC"}],
   [:XOF {:symbol "CFA",
          :name "CFA Franc BCEAO",
          :symbol_native "CFA",
          :decimal_digits 0,
          :rounding 0,
          :code "XOF",
          :name_plural "CFA francs BCEAO"}],
   [:YER {:symbol "YR",
          :name "Yemeni Rial",
          :symbol_native "ر.ي.‏",
          :decimal_digits 0,
          :rounding 0,
          :code "YER",
          :name_plural "Yemeni rials"}],
   [:ZAR {:symbol "R",
          :name "South African Rand",
          :symbol_native "R",
          :decimal_digits 2,
          :rounding 0,
          :code "ZAR",
          :name_plural "South African rand"}],
   [:ZMK {:symbol "ZK",
          :name "Zambian Kwacha",
          :symbol_native "ZK",
          :decimal_digits 0,
          :rounding 0,
          :code "ZMW",
          :name_plural "Zambian kwachas"}]])

The currencies as a Clojure map. Wrapped in [[delay]] so it's only computed on demand.

(def currency-map
  (delay (into {} currency-list)))

Given a currency symbol, as a string or keyword, look it up in the currency map and return the symbol for it as a string.

(defn ^:export currency-symbol
  [currency]
  (some->> currency keyword (get @currency-map) :symbol))

Returns the list of currencies supported by Metabase, with associated metadata. In Clojure, it is converted to a map for quick lookup of currency symbols during XLSX exports. In ClojureScript, it is kept as a 2D array to maintain the order of currencies.

(def ^:export currency
  #?(:clj  @currency-map
     :cljs (clj->js currency-list)))
 
(ns metabase.shared.util.i18n
  (:require
   ["ttag" :as ttag]
   [clojure.string :as str])
  (:require-macros
   [metabase.shared.util.i18n]))
(comment metabase.shared.util.i18n/keep-me
         ttag/keep-me)

Converts '' to ' inside the string; that's java.text.MessageFormat escaping that isn't needed in JS.

(defn- escape-format-string
  [format-string]
  (str/replace format-string #"''" "'"))

Format an i18n format-string with args with a translated string in the user locale.

The strings are formatted in java.test.MessageFormat style. That's used directly in JVM Clojure, but in CLJS we have to adapt to ttag, which doesn't have the same escaping rules. - 'xyz' single quotes wrap literal text which should not be interpolated, and could contain literal '{0}'. - A literal single quote is written with two single quotes: '' The first part is not supported at all. '' is converted to a single '.

(defn js-i18n
  [format-string & args]
  (let [strings (-> format-string
                    escape-format-string
                    (str/split #"\{\d+\}"))]
    (apply ttag/t (clj->js strings) (clj->js args))))
(def ^:private re-param-zero #"\{0\}")

Format an i18n format-string with the appropriate plural form based on the value n. Allows n to be interpolated into the string using {0}.

(defn js-i18n-n
  [format-string format-string-pl n]
  (let [format-string-esc (escape-format-string format-string)
        strings           (str/split format-string-esc re-param-zero)
        strings           (if (= (count strings) 1)
                            [format-string-esc ""]
                            strings)
        has-n?            (re-find #".*\{0\}.*" format-string-esc)]
    (ttag/ngettext (ttag/msgid (clj->js strings) (if has-n? n ""))
                   (-> format-string-pl
                      escape-format-string
                      (str/replace re-param-zero (str n)))
                   n)))
 
(ns metabase.shared.util.i18n
  (:require
   [metabase.util.i18n :as i18n]
   [net.cgrand.macrovich :as macros]))

i18n a string with the user's locale. Format string will be translated to the user's locale when the form is eval'ed. Placeholders should use gettext format e.g. {0}, {1}, and so forth.

(tru "Number of cans: {0}" 2)

(defmacro tru
  [format-string & args]
  (macros/case
    :clj
    `(i18n/tru ~format-string ~@args)
    :cljs
    `(js-i18n ~format-string ~@args)))

i18n a string with the site's locale, when called from Clojure. Format string will be translated to the site's locale when the form is eval'ed. Placeholders should use gettext format e.g. {0}, {1}, and so forth.

(trs "Number of cans: {0}" 2)

NOTE: When called from ClojureScript, this function behaves identically to tru. The originating JS callsite must temporarily override the locale used by ttag using the withInstanceLocalization wrapper function.

(defmacro trs
  [format-string & args]
  (macros/case
    :clj
    (do
      (require 'metabase.util.i18n)
      `(i18n/trs ~format-string ~@args))
    :cljs
    `(js-i18n ~format-string ~@args)))

i18n a string with both singular and plural forms, using the current user's locale. The appropriate plural form will be returned based on the value of n. n can be interpolated into the format strings using the {0} syntax. (Other placeholders are not supported).

(defmacro trun
  [format-string format-string-pl n]
  (macros/case
    :clj
    `(i18n/trun ~format-string ~format-string-pl ~n)
    :cljs
    `(js-i18n-n ~format-string ~format-string-pl ~n)))

i18n a string with both singular and plural forms, using the site's locale. The appropriate plural form will be returned based on the value of n. n can be interpolated into the format strings using the {0} syntax. (Other placeholders are not supported).

(defmacro trsn
  [format-string format-string-pl n]
  (macros/case
    :clj
    `(i18n/trsn ~format-string ~format-string-pl ~n)
    :cljs
    `(js-i18n-n ~format-string ~format-string-pl ~n)))
 
(ns metabase.shared.util.internal.time
  (:require
   [java-time.api :as t]
   [metabase.public-settings :as public-settings]
   [metabase.shared.util.internal.time-common :as common]
   [metabase.util.date-2 :as u.date])
  (:import
   java.util.Locale))
(set! *warn-on-reflection* true)
(defn- now [] (t/offset-date-time))

Given any value, check if it's a datetime object.

----------------------------------------------- predicates -------------------------------------------------------

(defn datetime?
  [value]
  (or (t/offset-date-time? value)
      (t/zoned-date-time? value)
      (t/instant? value)))

checks if the provided value is a local time value.

(defn time?
  [value]
  (t/local-time? value))

Given a datetime, check that it's valid.

(defn valid?
  [value]
  (or (datetime?      value)
      (t/offset-time? value)
      (t/local-time?  value)))

Does nothing. Just a placeholder in CLJS; the JVM implementation does some real work.

(defn normalize
  [value]
  (t/offset-date-time value))

Given two platform-specific datetimes, checks if they fall within the same day.

(defn same-day?
  [d1 d2]
  (= (t/truncate-to d1 :days) (t/truncate-to d2 :days)))

True if these two datetimes fall in the same year.

(defn same-year?
  [d1 d2]
  (= (t/year d1) (t/year d2)))

True if these two datetimes fall in the same (year and) month.

(defn same-month?
  [d1 d2]
  (and (same-year? d1 d2)
       (= (t/month d1) (t/month d2))))

The first day of the week varies by locale, but Metabase has a setting that overrides it. In JVM, we can just read the setting directly.

---------------------------------------------- information -------------------------------------------------------

(defn first-day-of-week
  []
  (public-settings/start-of-week))

The default map of options.

(def default-options
  {:locale (Locale/getDefault)})

------------------------------------------------ to-range --------------------------------------------------------

(defn- minus-ms [value]
  (t/minus value (t/millis 1)))
(defn- apply-offset
  [value offset-n offset-unit]
  (t/plus
    value
    (case offset-unit
      :minute (t/minutes offset-n)
      :hour (t/hours offset-n)
      :day (t/days offset-n)
      :week (t/weeks offset-n)
      :month (t/months offset-n)
      :year (t/years offset-n)
      (t/minutes 0))))
(defmethod common/to-range :default [value _]
  ;; Fallback: Just return a zero-width at the input time.
  ;; This mimics Moment.js behavior if you `m.startOf("unknown unit")` - it doesn't change anything.
  [value value])
(defmethod common/to-range :minute [value {:keys [n] :or {n 1}}]
  (let [start (-> value
                  (t/truncate-to :minutes))]
    [start (minus-ms (t/plus start (t/minutes n)))]))
(defmethod common/to-range :hour [value {:keys [n] :or {n 1}}]
  (let [start (-> value
                  (t/truncate-to :hours))]
    [start (minus-ms (t/plus start (t/hours n)))]))
(defmethod common/to-range :day [value {:keys [n] :or {n 1}}]
  (let [start (-> value
                  (t/truncate-to :days))]
    [start (minus-ms (t/plus start (t/days n)))]))
(defmethod common/to-range :week [value {:keys [n] :or {n 1}}]
  (let [first-day (first-day-of-week)
        start (-> value
                  (t/truncate-to :days)
                  (t/adjust :previous-or-same-day-of-week first-day))]
    [start (minus-ms (t/plus start (t/weeks n)))]))
(defmethod common/to-range :month [value {:keys [n] :or {n 1}}]
  (let [value (-> value
                  (t/truncate-to :days)
                  (t/adjust :first-day-of-month))]
    [value (minus-ms (t/plus value (t/months n)))]))
(defmethod common/to-range :year [value {:keys [n] :or {n 1}}]
  (let [value (-> value
                  (t/truncate-to :days)
                  (t/adjust :first-day-of-year))]
    [value (minus-ms (nth (iterate #(t/adjust % :first-day-of-next-year n) value) n))]))

-------------------------------------------- string->timestamp ---------------------------------------------------

(defmethod common/string->timestamp :default [value _]
  ;; Best effort to parse this unknown string format, as a local zoneless datetime, then treating it as UTC.
  (let [base (try (t/local-date-time value)
                  (catch Exception _
                    (try (t/local-date value)
                         (catch Exception _
                           nil))))]
    (when base
      (t/offset-date-time base (t/zone-id)))))
(defmethod common/string->timestamp :day-of-week [value options]
  ;; Try to parse as a regular timestamp; if that fails then try to treat it as a weekday name and adjust from
  ;; the current time.
  (let [as-default (try ((get-method common/string->timestamp :default) value options)
                        (catch Exception _ nil))]
    (if (valid? as-default)
      as-default
      (let [day (try (t/day-of-week "EEE" value)
                     (catch Exception _
                       (try (t/day-of-week "EEEE" value)
                            (catch Exception _
                              (throw (ex-info (str "Failed to coerce '" value "' to day-of-week")
                                              {:value value}))))))]
        (-> (now)
            (t/truncate-to :days)
            (t/adjust :previous-or-same-day-of-week :monday)  ; Move to ISO start of week.
            (t/adjust :next-or-same-day-of-week day))))))    ; Then to the specified day.

Some of the date coercions are relative, and not directly involved with any particular month. To avoid errors we need to use a reference date that is (a) in a month with 31 days,(b) in a leap year. This uses 2016-01-01 for the purpose.

-------------------------------------------- number->timestamp ---------------------------------------------------

(def ^:private magic-base-date
  (t/offset-date-time 2016 01 01))
(defmethod common/number->timestamp :default [value _]
  ;; If no unit is given, or the unit is not recognized, try to parse the number as year number, returning the timestamp
  ;; for midnight UTC on January 1.
  (t/offset-date-time value))
(defmethod common/number->timestamp :minute-of-hour [value _]
  (-> (now) (t/truncate-to :hours) (t/plus (t/minutes value))))
(defmethod common/number->timestamp :hour-of-day [value _]
  (-> (now) (t/truncate-to :days) (t/plus (t/hours value))))
(defmethod common/number->timestamp :day-of-week [value _]
  ;; Metabase uses 1 to mean the start of the week, based on the Metabase setting for the first day of the week.
  ;; Moment uses 0 as the first day of the week in its configured locale.
  ;; For Java, get the first day of the week from the setting, and offset by `(dec value)` for the current day.
  (-> (now)
      (t/adjust :previous-or-same-day-of-week (first-day-of-week))
      (t/truncate-to :days)
      (t/plus (t/days (dec value)))))
(defmethod common/number->timestamp :day-of-month [value _]
  ;; We force the initial date to be in a month with 31 days.
  (t/plus magic-base-date (t/days (dec value))))
(defmethod common/number->timestamp :day-of-year [value _]
  ;; We force the initial date to be in a leap year (2016).
  (t/plus magic-base-date (t/days (dec value))))
(defmethod common/number->timestamp :week-of-year [value _]
  (-> (now)
      (t/truncate-to :days)
      (t/adjust :first-day-of-year)
      (t/adjust :previous-or-same-day-of-week (first-day-of-week))
      (t/plus (t/weeks (dec value)))))
(defmethod common/number->timestamp :month-of-year [value _]
  (t/offset-date-time (t/year (now)) value 1))
(defmethod common/number->timestamp :quarter-of-year [value _]
  (let [month (inc (* 3 (dec value)))]
    (t/offset-date-time (t/year (now)) month 1)))
(defmethod common/number->timestamp :year [value _]
  (t/offset-date-time value 1 1))

Parses a timestamp with Z or a timezone offset at the end.

---------------------------------------------- parsing helpers ---------------------------------------------------

(defn parse-with-zone
  [value]
  (t/offset-date-time value))

Given a freshly parsed OffsetDateTime, convert it to a LocalDateTime.

(defn localize
  [value]
  (t/local-date-time value))

Parses a time string that has been stripped of any time zone.

(defn parse-time-string
  [value]
  (t/local-time value))

------------------------------------------------ arithmetic ------------------------------------------------------

Return the number of units between two temporal values before and after, e.g. maybe there are 32 :days between Jan 1st and Feb 2nd.

(defn unit-diff
  [unit before after]
  (let [before   (cond-> before
                   (string? before) u.date/parse)
        after    (cond-> after
                   (string? after) u.date/parse)
        ;; you can't use LocalDates in durations I guess, so just convert them LocalDateTimes with time = 0
        before   (cond-> before
                   (instance? java.time.LocalDate before) (t/local-date-time 0))
        after    (cond-> after
                   (instance? java.time.LocalDate after) (t/local-date-time 0))
        duration (t/duration before after)]
    (case unit
      :millisecond (.toMillis duration)
      :second      (.toSeconds duration)
      :minute      (.toMinutes duration)
      :hour        (.toHours duration)
      :day         (.toDays duration)
      :week
      (long (/ (unit-diff :day before after) 7))
      :month
      (let [diff-months (- (u.date/extract after :month-of-year)
                           (u.date/extract before :month-of-year))
            diff-years  (- (u.date/extract after :year)
                          (u.date/extract before :year))]
        (+ diff-months (* diff-years 12)))
      :quarter
      (long (/ (unit-diff :month before after) 3))
      :year
      (- (u.date/extract after :year)
         (u.date/extract before :year)))))

Returns the time elapsed between before and after in days (an integer).

(defn day-diff
  [before after]
  (unit-diff :day before after))
(defn- coerce-local-date-time [input]
  (cond-> input
    (re-find #"(?:Z|[+-]\d\d(?::?\d\d)?)$" input) (t/offset-date-time)
    :always (localize)))

Formats a temporal-value (iso date/time string, int for hour/minute) given the temporal-bucketing unit. If unit is nil, formats the full date/time

(defn format-unit
  [input unit]
  (if (string? input)
    (let [time? (common/matches-time? input)
          date? (common/matches-date? input)
          date-time? (common/matches-date-time? input)
          t (cond
              time? (t/local-time input)
              date? (t/local-date input)
              date-time? (coerce-local-date-time input))]
      (if t
        (case unit
          :day-of-week (t/format "EEEE" t)
          :month-of-year (t/format "MMM" t)
          :minute-of-hour (t/format "m" t)
          :hour-of-day (t/format "h a" t)
          :day-of-month (t/format "d" t)
          :day-of-year (t/format "D" t)
          :week-of-year (t/format "w" t)
          :quarter-of-year (t/format "'Q'Q" t)
          (cond
            time? (t/format "h:mm a" t)
            date? (t/format "MMM d, yyyy" t)
            :else (t/format "MMM d, yyyy, h:mm a" t)))
        input))
    (if (= unit :hour-of-day)
      (str (cond (zero? input) "12" (<= input 12) input :else (- input 12)) " " (if (<= input 11) "AM" "PM"))
      (str input))))

Formats a time difference between two temporal values. Drops redundant information.

(defn format-diff
  [temporal-value-1 temporal-value-2]
  (let [default-format #(str (format-unit temporal-value-1 nil)
                             " – "
                             (format-unit temporal-value-2 nil))]
    (cond
      (some (complement string?) [temporal-value-1 temporal-value-2])
      (default-format)
      (= temporal-value-1 temporal-value-2)
      (format-unit temporal-value-1 nil)
      (and (common/matches-time? temporal-value-1)
           (common/matches-time? temporal-value-2))
      (default-format)
      (and (common/matches-date-time? temporal-value-1)
           (common/matches-date-time? temporal-value-2))
      (let [lhs (coerce-local-date-time temporal-value-1)
            rhs (coerce-local-date-time temporal-value-2)
            year-matches? (= (t/year lhs) (t/year rhs))
            month-matches? (= (t/month lhs) (t/month rhs))
            day-matches? (= (t/day-of-month lhs) (t/day-of-month rhs))
            hour-matches? (= (t/format "H" lhs) (t/format "H" rhs))
            [lhs-fmt rhs-fmt] (cond
                                (and year-matches? month-matches? day-matches? hour-matches?)
                                ["MMM d, yyyy, h:mm a " " h:mm a"]
                                (and year-matches? month-matches? day-matches?)
                                ["MMM d, yyyy, h:mm a " " h:mm a"]
                                year-matches?
                                ["MMM d, h:mm a " " MMM d, yyyy, h:mm a"])]
        (if lhs-fmt
          (str (t/format lhs-fmt lhs) "–" (t/format rhs-fmt rhs))
          (default-format)))
      (and (common/matches-date? temporal-value-1)
           (common/matches-date? temporal-value-2))
      (let [lhs (t/local-date temporal-value-1)
            rhs (t/local-date temporal-value-2)
            year-matches? (= (t/year lhs) (t/year rhs))
            month-matches? (= (t/month lhs) (t/month rhs))
            [lhs-fmt rhs-fmt] (cond
                                (and year-matches? month-matches?)
                                ["MMM d" "d, yyyy"]
                                year-matches?
                                ["MMM d " " MMM d, yyyy"])]
        (if lhs-fmt
          (str (t/format lhs-fmt lhs) "–" (t/format rhs-fmt rhs))
          (default-format)))
      :else
      (default-format))))

Given a n unit time interval and the current date, return a string representing the date-time range. Provide an offset-n and offset-unit time interval to change the date used relative to the current date. options is a map and supports :include-current to include the current given unit of time in the range.

(defn format-relative-date-range
  ([n unit offset-n offset-unit opts]
   (format-relative-date-range (now) n unit offset-n offset-unit opts))
  ([t n unit offset-n offset-unit {:keys [include-current]}]
   (let [offset-now (cond-> t
                      (neg? n) (apply-offset n unit)
                      (and (pos? n) (not include-current)) (apply-offset 1 unit)
                      (and offset-n offset-unit) (apply-offset offset-n offset-unit))
         pos-n (cond-> (abs n)
                 include-current inc)
         date-ranges (map (if (#{:hour :minute} unit)
                            #(t/format "yyyy-MM-dd'T'HH:mm" (t/local-date-time %))
                            #(str (t/local-date %)))
                          (common/to-range offset-now
                                           {:unit unit
                                            :n pos-n
                                            :offset-n offset-n
                                            :offset-unit offset-unit}))]
     (apply format-diff date-ranges))))

Clojure implementation of [[metabase.shared.util.time/truncate]]; basically the same as [[u.date/truncate]] but also handles ISO-8601 strings.

(defn truncate
  [t unit]
  (if (string? t)
    (str (truncate (u.date/parse t) unit))
    (u.date/truncate t unit)))

Clojure implementation of [[metabase.shared.util.time/add]]; basically the same as [[u.date/add]] but also handles ISO-8601 strings.

(defn add
  [t unit amount]
  (if (string? t)
    (str (add (u.date/parse t) unit amount))
    (u.date/add t unit amount)))
 

CLJS implementation of the time utilities on top of Moment.js. See [[metabase.shared.util.time]] for the public interface.

(ns metabase.shared.util.internal.time
  (:require
   ["moment" :as moment]
   [metabase.shared.util.internal.time-common :as common]))
(defn- now [] (moment))

Given any value, check if it's a (possibly invalid) Moment.

----------------------------------------------- predicates -------------------------------------------------------

(defn datetime?
  [value]
  (and value (moment/isMoment value)))

checks if the provided value is a local time value.

(defn time?
  [value]
  (moment/isMoment value))

Given a Moment, check that it's valid.

(defn valid?
  [value]
  (and (datetime? value) (.isValid ^moment/Moment value)))

Does nothing. Just a placeholder in CLJS; the JVM implementation does some real work.

(defn normalize
  [value]
  value)

Given two platform-specific datetimes, checks if they fall within the same day.

(defn same-day?
  [^moment/Moment d1 ^moment/Moment d2]
  (.isSame d1 d2 "day"))

True if these two datetimes fall in the same (year and) month.

(defn same-month?
  [^moment/Moment d1 ^moment/Moment d2]
  (.isSame d1 d2 "month"))

True if these two datetimes fall in the same year.

(defn same-year?
  [^moment/Moment d1 ^moment/Moment d2]
  (.isSame d1 d2 "year"))

The first day of the week varies by locale, but Metabase has a setting that overrides it. In CLJS, Moment is already configured with that setting.

---------------------------------------------- information -------------------------------------------------------

(defn first-day-of-week
  []
  (-> (moment/weekdays 0)
      (.toLowerCase)
      keyword))

The default map of options - empty in CLJS.

(def default-options
  {})

------------------------------------------------ to-range --------------------------------------------------------

(defn- apply-offset
  [^moment/Moment value offset-n offset-unit]
  (.add
   (moment value)
   offset-n
   (name offset-unit)))
(defmethod common/to-range :default [^moment/Moment value {:keys [n unit]}]
  (let [^moment/Moment c1       (.clone value)
        ^moment/Moment c2       (.clone value)
        ^moment/Moment adjusted (if (> n 1)
                                  (.add c2 (dec n) (name unit))
                                  c2)]
    [(.startOf c1       (name unit))
     (.endOf   adjusted (name unit))]))

NB: Only the :default for to-range is needed in CLJS, since Moment's startOf and endOf methods are doing the work.

-------------------------------------------- string->timestamp ---------------------------------------------------

(defmethod common/string->timestamp :default [value _]
  ;; Best effort to parse this unknown string format, as a local zoneless datetime, then treating it as UTC.
  (moment/utc value moment/ISO_8601))
(defmethod common/string->timestamp :day-of-week [value options]
  ;; Try to parse as a regular timestamp; if that fails then try to treat it as a weekday name and adjust from
  ;; the current time.
  (let [as-default (try ((get-method common/string->timestamp :default) value options)
                        (catch js/Error _ nil))]
    (if (valid? as-default)
      as-default
      (-> (now)
          (.isoWeekday value)
          (.startOf "day")))))

Some of the date coercions are relative, and not directly involved with any particular month. To avoid errors we need to use a reference date that is (a) in a month with 31 days,(b) in a leap year. This uses 2016-01-01 for the purpose. This is a function that returns fresh values, since Moments are mutable.

-------------------------------------------- number->timestamp ---------------------------------------------------

(defn- magic-base-date
  []
  (moment "2016-01-01"))
(defmethod common/number->timestamp :default [value _]
  ;; If no unit is given, or the unit is not recognized, try to parse the number as year number, returning the timestamp
  ;; for midnight UTC on January 1.
  (moment/utc value moment/ISO_8601))
(defmethod common/number->timestamp :minute-of-hour [value _]
  (.. (now) (minute value) (startOf "minute")))
(defmethod common/number->timestamp :hour-of-day [value _]
  (.. (now) (hour value) (startOf "hour")))
(defmethod common/number->timestamp :day-of-week [value _]
  ;; Metabase uses 1 to mean the start of the week, based on the Metabase setting for the first day of the week.
  ;; Moment uses 0 as the first day of the week in its configured locale.
  (.. (now) (weekday (dec value)) (startOf "day")))
(defmethod common/number->timestamp :day-of-month [value _]
  ;; We force the initial date to be in a month with 31 days.
  (.. (magic-base-date) (date value) (startOf "day")))
(defmethod common/number->timestamp :day-of-year [value _]
  ;; We force the initial date to be in a leap year (2016).
  (.. (magic-base-date) (dayOfYear value) (startOf "day")))
(defmethod common/number->timestamp :week-of-year [value _]
  (.. (now) (week value) (startOf "week")))
(defmethod common/number->timestamp :month-of-year [value _]
  (.. (now) (month (dec value)) (startOf "month")))
(defmethod common/number->timestamp :quarter-of-year [value _]
  (.. (now) (quarter value) (startOf "quarter")))
(defmethod common/number->timestamp :year [value _]
  (.. (now) (year value) (startOf "year")))

Parses a timestamp with Z or a timezone offset at the end. This requires a different API call from timestamps without time zones in CLJS.

---------------------------------------------- parsing helpers ---------------------------------------------------

(defn parse-with-zone
  [value]
  (moment/parseZone value))

Given a freshly parsed absolute Moment, convert it to a local one.

(defn localize
  [value]
  (.local value))
(def ^:private parse-time-formats
  #js ["HH:mm:ss.SSS[Z]"
       "HH:mm:ss.SSS"
       "HH:mm:ss"
       "HH:mm"])

Parses a time string that has been stripped of any time zone.

(defn parse-time-string
  [value]
  (moment value parse-time-formats))

------------------------------------------------ arithmetic ------------------------------------------------------

(declare unit-diff)

Returns the time elapsed between before and after in days.

(defn day-diff
  [before after]
  (unit-diff :day before after))
(defn- coerce-local-date-time [input]
  (-> input
      common/drop-trailing-time-zone
      (moment/utc moment/ISO_8601)))

Formats a temporal-value (iso date/time string, int for hour/minute) given the temporal-bucketing unit. If unit is nil, formats the full date/time. Time input formatting is only defined with time units.

(defn format-unit
  [input unit]
  (if (string? input)
    (let [time? (common/matches-time? input)
          date? (common/matches-date? input)
          date-time? (common/matches-date-time? input)
          t (cond
              ;; Anchor to an arbitrary date since time inputs are only defined for
              ;; :hour-of-day and :minute-of-hour.
              time? (moment/utc (str "2023-01-01T" input) moment/ISO_8601)
              (or date? date-time?) (coerce-local-date-time input))]
      (if (and t (.isValid t))
        (case unit
          :day-of-week (.format t "dddd")
          :month-of-year (.format t "MMM")
          :minute-of-hour (.format t "m")
          :hour-of-day (.format t "h A")
          :day-of-month (.format t "D")
          :day-of-year (.format t "DDD")
          :week-of-year (.format t "w")
          :quarter-of-year (.format t "[Q]Q")
          (cond
            time? (.format t "h:mm A")
            date? (.format t "MMM D, YYYY")
            date-time? (.format t "MMM D, YYYY, h:mm A")))
        input))
    (if (= unit :hour-of-day)
      (str (cond (zero? input) "12" (<= input 12) input :else (- input 12)) " " (if (<= input 11) "AM" "PM"))
      (str input))))

Formats a time difference between two temporal values. Drops redundant information.

(defn format-diff
  [temporal-value-1 temporal-value-2]
  (let [default-format #(str (format-unit temporal-value-1 nil)
                             " – "
                             (format-unit temporal-value-2 nil))]
    (cond
      (some (complement string?) [temporal-value-1 temporal-value-2])
      (default-format)
      (= temporal-value-1 temporal-value-2)
      (format-unit temporal-value-1 nil)
      (and (common/matches-time? temporal-value-1)
           (common/matches-time? temporal-value-2))
      (default-format)
      (and (common/matches-date-time? temporal-value-1)
           (common/matches-date-time? temporal-value-2))
      (let [lhs (coerce-local-date-time temporal-value-1)
            rhs (coerce-local-date-time temporal-value-2)
            year-matches? (= (.format lhs "YYYY") (.format rhs "YYYY"))
            month-matches? (= (.format lhs "MMM") (.format rhs "MMM"))
            day-matches? (= (.format lhs "D") (.format rhs "D"))
            hour-matches? (= (.format lhs "HH") (.format rhs "HH"))
            [lhs-fmt rhs-fmt] (cond
                                (and year-matches? month-matches? day-matches? hour-matches?)
                                ["MMM D, YYYY, h:mm A " " h:mm A"]
                                (and year-matches? month-matches? day-matches?)
                                ["MMM D, YYYY, h:mm A " " h:mm A"]
                                year-matches?
                                ["MMM D, h:mm A " " MMM D, YYYY, h:mm A"])]
        (if lhs-fmt
          (str (.format lhs lhs-fmt) "–" (.format rhs rhs-fmt))
          (default-format)))
      (and (common/matches-date? temporal-value-1)
           (common/matches-date? temporal-value-2))
      (let [lhs (moment/utc temporal-value-1 moment/ISO_8601)
            rhs (moment/utc temporal-value-2 moment/ISO_8601)
            year-matches? (= (.format lhs "YYYY") (.format rhs "YYYY"))
            month-matches? (= (.format lhs "MMM") (.format rhs "MMM"))
            [lhs-fmt rhs-fmt] (cond
                                (and year-matches? month-matches?)
                                ["MMM D" "D, YYYY"]
                                year-matches?
                                ["MMM D " " MMM D, YYYY"])]
        (if lhs-fmt
          (str (.format lhs lhs-fmt) "–" (.format rhs rhs-fmt))
          (default-format)))
      :else
      (default-format))))

Given a n unit time interval and the current date, return a string representing the date-time range. Provide an offset-n and offset-unit time interval to change the date used relative to the current date. options is a map and supports :include-current to include the current given unit of time in the range.

(defn format-relative-date-range
  ([n unit offset-n offset-unit opts]
   (format-relative-date-range (now) n unit offset-n offset-unit opts))
  ([t n unit offset-n offset-unit {:keys [include-current]}]
   (let [offset-now (cond-> t
                      (neg? n) (apply-offset n unit)
                      (and (pos? n) (not include-current)) (apply-offset 1 unit)
                      (and offset-n offset-unit) (apply-offset offset-n offset-unit))
         pos-n (cond-> (abs n)
                 include-current inc)
         date-ranges (map #(.format % (if (#{:hour :minute} unit) "YYYY-MM-DDTHH:mm" "YYYY-MM-DD"))
                          (common/to-range offset-now
                                           {:unit unit
                                            :n pos-n
                                            :offset-n offset-n
                                            :offset-unit offset-unit}))]
     (apply format-diff date-ranges))))
(def ^:private temporal-formats
  {:offset-date-time {:regex   common/offset-datetime-regex
                      :formats #js ["yyyy-MM-DDTHH:mm:ss.SSS[Z]"
                                    "yyyy-MM-DDTHH:mm:ss[Z]"
                                    "yyyy-MM-DDTHH:mm[Z]"
                                    "yyyy-MM-DDTHH[Z]"]}
   :local-date-time  {:regex   common/local-datetime-regex
                      :formats #js ["yyyy-MM-DDTHH:mm:ss.SSS"
                                    "yyyy-MM-DDTHH:mm:ss"
                                    "yyyy-MM-DDTHH:mm"
                                    "yyyy-MM-DDTHH"]}
   :local-date       {:regex   common/local-date-regex
                      :formats #js ["yyyy-MM-DD"
                                    "yyyy-MM"
                                    "yyyy"]}
   :offset-time      {:regex   common/offset-time-regex
                      :formats #js ["HH:mm:ss.SSS[Z]"
                                    "HH:mm:ss[Z]"
                                    "HH:mm[Z]"
                                    "HH[Z]"]}
   :local-time       {:regex   common/local-time-regex
                      :formats #js ["HH:mm:ss.SSS"
                                    "HH:mm:ss"
                                    "HH:mm"
                                    "HH"]}})
(defn- iso-8601->moment+type
  [s]
  (some (fn [[value-type {:keys [regex formats]}]]
          (when (re-matches regex s)
            (let [parsed (moment/parseZone s formats #_strict? true)]
              (when (.isValid parsed)
                [parsed value-type]))))
        temporal-formats))
(defmulti ^:private moment+type->iso-8601
  {:arglists '([moment+type])}
  (fn [[_t value-type]]
    value-type))
(defmethod moment+type->iso-8601 :offset-date-time
  [[^moment/Moment t _value-type]]
  (let [format-string (cond
                        (pos? (.milliseconds t)) "yyyy-MM-DDTHH:mm:ss.SSS[Z]"
                        (pos? (.seconds t))      "yyyy-MM-DDTHH:mm:ss[Z]"
                        :else                    "yyyy-MM-DDTHH:mm[Z]")]
    (.format t format-string)))
(defmethod moment+type->iso-8601 :local-date-time
  [[^moment/Moment t _value-type]]
  (let [format-string (cond
                        (pos? (.milliseconds t)) "yyyy-MM-DDTHH:mm:ss.SSS"
                        (pos? (.seconds t))      "yyyy-MM-DDTHH:mm:ss"
                        :else                    "yyyy-MM-DDTHH:mm")]
    (.format t format-string)))
(defmethod moment+type->iso-8601 :local-date
  [[^moment/Moment t _value-type]]
  (.format t "yyyy-MM-DD"))
(defmethod moment+type->iso-8601 :offset-time
  [[^moment/Moment t _value-type]]
  (let [format-string (cond
                        (pos? (.milliseconds t)) "HH:mm:ss.SSS[Z]"
                        (pos? (.seconds t))      "HH:mm:ss[Z]"
                        :else                    "HH:mm[Z]")]
    (.format t format-string)))
(defmethod moment+type->iso-8601 :local-time
  [[^moment/Moment t _value-type]]
  (let [format-string (cond
                        (pos? (.milliseconds t)) "HH:mm:ss.SSS"
                        (pos? (.seconds t))      "HH:mm:ss"
                        :else                    "HH:mm")]
    (.format t format-string)))

Return the number of units between two temporal values before and after, e.g. maybe there are 32 :days between Jan 1st and Feb 2nd.

(defn unit-diff
  [unit before after]
  (let [^moment/Moment before (if (string? before)
                                (first (iso-8601->moment+type before))
                                before)
        ^moment/Moment after  (if (string? after)
                                (first (iso-8601->moment+type after))
                                after)]
    (.diff after before (name unit))))

ClojureScript implementation of [[metabase.shared.util.time/truncate]]; supports both Moment.js instances and ISO-8601 strings.

(defn truncate
  [t unit]
  (if (string? t)
    (let [[t value-type] (iso-8601->moment+type t)
          t              (truncate t unit)]
      (moment+type->iso-8601 [t value-type]))
    (.startOf ^moment/Moment t (name unit))))

ClojureScript implementation of [[metabase.shared.util.time/add]]; supports both Moment.js instances and ISO-8601 strings.

(defn add
  [t unit amount]
  (if (string? t)
    (let [[t value-type] (iso-8601->moment+type t)
          t              (add t unit amount)]
      (moment+type->iso-8601 [t value-type]))
    (.add ^moment/Moment t amount (name unit))))
 

Shared core of time utils used by the internal CLJ and CLJS implementations. See [[metabase.shared.util.time]] for the public interface.

(ns metabase.shared.util.internal.time-common)
(defn- by-unit [_ {:keys [unit]}] (keyword unit))

Given a datetime and a unit (eg. "hour"), returns an inclusive datetime range as a pair of datetimes. For a unit of an hour, and a datetime for 13:49:28, that means [13:00:00 13:59:59.999], ie. 1 ms before the end.

(defmulti to-range
  by-unit)

Given a string representation of a datetime and the options map, parses the string as a representation of the :unit option (eg. "hour"). Returns a platform-specific datetime.

(defmulti string->timestamp
  by-unit)

Given a numeric representation of a datetime and the options map, interprets the number based on the :unit option (eg. "day-of-week").

Note that for two relative units - day-of-month and day-of-year - an arbitrary date is generated, not necessarily one in the current month or year. When grouping user data by day-of-month, it doesn't matter whether the current month has 31 days or not.

Returns a platform-specific datetime.

(defmulti number->timestamp
  by-unit)
(def ^:private year-part
  "\\d{4}")
(def ^:private month-part
  "\\d{2}")
(def ^:private day-part
  "\\d{2}")
(def ^:private date-part
  (str year-part \- month-part \- day-part))
(def ^:private hour-part
  "\\d{2}")
(def ^:private minutes-part
  "\\d{2}")
(defn- optional [& parts]
  (str "(?:" (apply str parts) ")?"))
(def ^:private seconds-milliseconds-part
  (str ":\\d{2}" (optional "\\.\\d{1,6}")))
(def ^:private time-part
  (str hour-part \: minutes-part (optional seconds-milliseconds-part)))
(def ^:private date-time-part
  (str date-part \T time-part))
(def ^:private offset-part
  (str "(?:Z|(?:[+-]" time-part "))"))

Regex for a zone-offset string.

(def zone-offset-part-regex
  (re-pattern offset-part))

Regex for a local-date string.

(def ^:const local-date-regex
  (re-pattern (str \^ date-part \$)))

Regex for a local-time string.

(def ^:const local-time-regex
  (re-pattern (str \^ time-part \$)))

Regex for an offset-time string.

(def ^:const offset-time-regex
  (re-pattern (str \^ time-part offset-part \$)))

Regex for a local-datetime string.

(def ^:const local-datetime-regex
  (re-pattern (str \^ date-time-part \$)))

Regex for an offset-datetime string.

(def ^:const offset-datetime-regex
  (re-pattern (str \^ date-time-part offset-part \$)))

Regex for a year-month literal string.

(def ^:const year-month-regex
  (re-pattern (str \^ year-part \- month-part \$)))

Regex for a year literal string.

(def ^:const year-regex
  (re-pattern (str \^ year-part \$)))

Matches a local time string.

(defn matches-time?
  [input]
  (re-matches local-time-regex input))

Matches a local date string.

(defn matches-date?
  [input]
  (re-matches local-date-regex input))

Matches a local AND offset date time string.

(defn matches-date-time?
  [input]
  (re-matches (re-pattern (str date-time-part (optional offset-part))) input))

Strips off a trailing +0500, -0430, or Z from a time string.

(defn drop-trailing-time-zone
  [time-str]
  (or (second (re-matches (re-pattern (str "(.*?)" (optional offset-part) \$)) time-str))
      time-str))
 

Potemkin is Java-only, so here's a basic function-importing macro that works for both CLJS and CLJ.

(ns metabase.shared.util.namespaces
  (:require
    [net.cgrand.macrovich :as macros]
    [potemkin :as p]))
(defn- redef [target sym]
  (let [defn-name (or sym (symbol (name target)))]
    `(def ~defn-name "docstring" (fn [& args#] (apply ~target args#)))))

Imports a single defn from another namespace. This creates a new local function that calls through to the original, so that it reloads nicely in the REPL. (import-fn ns/b) => (defn b [& args] (apply ns/b args)) (import-fn ns/b alt-name) => (defn alt-name [& args] (apply ns/b args))

(defmacro import-fn
  ;; Heavily inspired by Potemkin.
  ([target]
   `(import-fn ~target nil))
  ([target sym]
   (redef target sym)))

Imports defns from other namespaces. This uses [[import-fn]] to create pass-through local functions that reload nicely. (import-fns [ns1 f1 f2 f3] [ns2 f4 f5]) creates f1 that calls ns1/f1, f2 that calls ns1/f2, etc. If you need to rename a function, instead of just the function name, pass [original new-name].

(defmacro import-fns
  [& spaces]
  (macros/case
    :cljs `(do
             ~@(for [[target-ns & fns] spaces
                     f                 fns
                     :let [target-sym (if (vector? f) (first f)  f)
                           new-sym    (if (vector? f) (second f) f)
                           target     (symbol (name target-ns) (name target-sym))]]
                 (redef target new-sym)))
    :clj  `(p/import-vars ~@spaces)))
 
(ns metabase.shared.util.namespaces
  (:require-macros
   [metabase.shared.util.namespaces]))
 

Time parsing helper functions. In Java these return [[OffsetDateTime]], in JavaScript they return Moments. Most of the implementations are in the split CLJ/CLJS files [[metabase.shared.util.internal.time]].

(ns metabase.shared.util.time
  (:require
   [metabase.shared.util.internal.time :as internal]
   [metabase.shared.util.internal.time-common :as common]
   [metabase.shared.util.namespaces :as shared.ns]
   [metabase.util :as u]))

Importing and re-exporting some functions defined in each implementation.

(shared.ns/import-fns
 [common
  local-date-regex
  local-datetime-regex
  local-time-regex
  offset-datetime-regex
  offset-time-regex
  to-range
  year-month-regex
  year-regex
  zone-offset-part-regex]
 [internal
  valid?
  same-day?
  same-month?
  same-year?
  day-diff
  unit-diff
  truncate
  add])
(defn- prep-options [options]
  (merge internal/default-options (u/normalize-map options)))

Parses a timestamp value into a date object. This can be a straightforward Unix timestamp or ISO format string. But the :unit field can be used to alter the parsing to, for example, treat the input number as a day-of-week or day-of-month number. Returns Moments in JS and OffsetDateTimes in Java.

(defn ^:export coerce-to-timestamp
  ([value] (coerce-to-timestamp value {}))
  ([value options]
   (let [options (prep-options options)
         base (cond
                ;; Just return an already-parsed value. (Moment in CLJS, DateTime classes in CLJ.)
                (internal/datetime? value)                        (internal/normalize value)
                ;; If there's a timezone offset, or Z for Zulu/UTC time, parse it directly.
                (and (string? value)
                     (re-matches #".*(Z|[+-]\d\d:?\d\d)$" value)) (internal/parse-with-zone value)
                ;; Then we fall back to two multimethods for coercing strings and number to timestamps per the :unit.
                (string? value)                                   (common/string->timestamp value options)
                :else                                             (common/number->timestamp value options))]
     (if (:local options)
       (internal/localize base)
       base))))

Parses a standalone time, or the time portion of a timestamp. Accepts a platform time value (eg. Moment, OffsetTime, LocalTime) or a string.

(defn ^:export coerce-to-time
  [value]
  (cond
    (internal/time? value) value
    (string? value) (-> value common/drop-trailing-time-zone internal/parse-time-string)
    :else           (throw (ex-info "Unknown input to coerce-to-time; expecting a string"
                                    {:value value}))))

Formats a temporal-value (iso date/time string, int for hour/minute) given the temporal-bucketing unit. If unit is nil, formats the full date/time

(defn format-unit
  [temporal-value unit]
  (internal/format-unit temporal-value unit))

Formats a time difference between two temporal values. Drops redundant information.

(defn format-diff
  [temporal-value-1 temporal-value-2]
  (internal/format-diff temporal-value-1 temporal-value-2))

Given a n unit time interval and the current date, return a string representing the date-time range. Provide an offset-n and offset-unit time interval to change the date used relative to the current date. options is a map and supports :include-current to include the current given unit of time in the range.

(defn format-relative-date-range
  ([n unit]
   (format-relative-date-range n unit nil nil nil))
  ([n unit offset-n offset-unit]
   (format-relative-date-range n unit offset-n offset-unit nil))
  ([n unit offset-n offset-unit options]
   (internal/format-relative-date-range n unit offset-n offset-unit options))
  ([t n unit offset-n offset-unit options]
   (internal/format-relative-date-range (coerce-to-timestamp t) n unit offset-n offset-unit options)))
 

Combined functions for running the entire Metabase sync process. This delegates to a few distinct steps, which in turn are broken out even further:

  1. Sync Metadata [[metabase.sync.sync-metadata]]
  2. Analysis [[metabase.sync.analyze]]
  3. Cache Field Values [[metabase.sync.field-values]]

    In the near future these steps will be scheduled individually, meaning those functions will be called directly instead of calling the [[sync-database!]] function to do all three at once.

(ns metabase.sync
  (:require
   [metabase.driver.h2 :as h2]
   [metabase.driver.util :as driver.u]
   [metabase.models.field :as field]
   [metabase.models.table :as table]
   [metabase.sync.analyze :as analyze]
   [metabase.sync.analyze.fingerprint :as fingerprint]
   [metabase.sync.field-values :as field-values]
   [metabase.sync.interface :as i]
   [metabase.sync.sync-metadata :as sync-metadata]
   [metabase.sync.util :as sync-util]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms])
  (:import
   (java.time.temporal Temporal)))

Schema for results returned from [[sync-database!]].

(def ^:private SyncDatabaseResults
  [:maybe
   [:sequential
    [:map
     [:start-time (ms/InstanceOfClass Temporal)]
     [:end-time   (ms/InstanceOfClass Temporal)]
     [:name       :string]
     [:steps      [:maybe [:sequential sync-util/StepNameWithMetadata]]]]]])
(mu/defn sync-database! :- SyncDatabaseResults
  "Perform all the different sync operations synchronously for `database`.
  By default, does a `:full` sync that performs all the different sync operations consecutively. You may instead
  specify only a `:schema` sync that will sync just the schema but skip analysis.
  Please note that this function is *not* what is called by the scheduled tasks; those call different steps
  independently. This function is called when a Database is first added."
  ([database]
   (sync-database! database nil))
  ([database                         :- i/DatabaseInstance
    {:keys [scan], :or {scan :full}} :- [:maybe [:map
                                                 [:scan {:optional true} [:maybe [:enum :schema :full]]]]]]
   (sync-util/sync-operation :sync database (format "Sync %s" (sync-util/name-for-logging database))
     (cond-> [(assoc (sync-metadata/sync-db-metadata! database) :name "metadata")]
       (= scan :full)
       (conj (assoc (analyze/analyze-db! database) :name "analyze")
             (assoc (field-values/update-field-values! database) :name "field-values"))))))

Perform all the different sync operations synchronously for a given table. Since often called on a sequence of tables, caller should check if can connect.

(mu/defn sync-table!
  [table :- i/TableInstance]
  (doto table
    sync-metadata/sync-table-metadata!
    analyze/analyze-table!
    field-values/update-field-values-for-table!
    sync-util/set-initial-table-sync-complete!))

Refingerprint a field, usually after its type changes. Checks if can connect to database, returning :sync/no-connection if not.

(mu/defn refingerprint-field!
  [field :- i/FieldInstance]
  (let [table    (field/table field)
        database (table/database table)]
    ;; it's okay to allow testing H2 connections during sync. We only want to disallow you from testing them for the
    ;; purposes of creating a new H2 database.
    (if (binding [h2/*allow-testing-h2-connections* true]
          (driver.u/can-connect-with-details? (:engine database) (:details database)))
      (sync-util/with-error-handling (format "Error refingerprinting field %s"
                                             (sync-util/name-for-logging field))
        (fingerprint/refingerprint-field field))
      :sync/no-connection)))
 

Logic responsible for doing deep 'analysis' of the data inside a database. This is significantly more expensive than the basic sync-metadata step, and involves things like running MBQL queries and fetching values to do things like determine Table row counts and infer field semantic types.

(ns metabase.sync.analyze
  (:require
   [metabase.models.field :refer [Field]]
   [metabase.sync.analyze.classify :as classify]
   [metabase.sync.analyze.fingerprint :as fingerprint]
   [metabase.sync.interface :as i]
   [metabase.sync.util :as sync-util]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [toucan2.core :as t2]))

How does analysis decide which Fields should get analyzed?

Good question. There are two situations in which Fields should get analyzed:

  • Whenever a new Field is first detected, or
  • When the fingerprinters are updated in such a way that this Field (based on its base type) ought to be
  • re-fingerprinted

So how do we check all that?

  1. We keep track of which base types are affected by new fingerprint versions. See the discussion in metabase.sync.interface for more details.

  2. FINGERPRINTING

    2a. When running fingerprinting, we calculate a fairly sophisticated SQL query to only fetch Fields that need to be re-fingerprinted based on type info and their current fingerprint version

    2b. All of these fields get updated fingerprints and marked with the newest version. We also set last_analyzed to nil so we know we need to re-run classification for them

  3. CLASSIFICATION

    All Fields that have the latest fingerprint version but a nil last_analyzed time need to be re-classified. Classification takes place for these Fields and semantic types and the like are updated as needed.

  4. MARKING FIELDS AS RECENTLY ANALYZED

    Once all of the above is done, we update the last_analyzed timestamp for all the Fields that got re-fingerprinted and re-classified.

So what happens during the next analysis?

During the next analysis phase, Fields whose fingerprint is up-to-date will be skipped. However, if a new fingerprint version is introduced, Fields that need it will be upgraded to it. We'll still only reclassify the newly re-fingerprinted Fields, because we'll know to skip the ones from last time since their value of last_analyzed is not nil.

(mu/defn ^:private update-last-analyzed!
  [tables :- [:sequential i/TableInstance]]
  (when-let [ids (seq (map u/the-id tables))]
    ;; The WHERE portion of this query should match up with that of `classify/fields-to-classify`
    (t2/update! Field {:table_id            [:in ids]
                       :fingerprint_version i/*latest-fingerprint-version*
                       :last_analyzed       nil}
                {:last_analyzed :%now})))

Update the last_analyzed date for all the recently re-fingerprinted/re-classified Fields in TABLE.

(mu/defn ^:private update-fields-last-analyzed!
  [table :- i/TableInstance]
  (update-last-analyzed! [table]))

Update the last_analyzed date for all the recently re-fingerprinted/re-classified Fields in TABLE.

(mu/defn ^:private update-fields-last-analyzed-for-db!
  [_database :- i/DatabaseInstance
   tables    :- [:sequential i/TableInstance]]
  ;; The WHERE portion of this query should match up with that of `classify/fields-to-classify`
  (update-last-analyzed! tables))

Perform in-depth analysis for a table.

(mu/defn analyze-table!
  [table :- i/TableInstance]
  (fingerprint/fingerprint-fields! table)
  (classify/classify-fields! table)
  (classify/classify-table! table)
  (update-fields-last-analyzed! table))
(defn- maybe-log-progress [progress-bar-fn]
  (fn [step table]
    (let [progress-bar-result (progress-bar-fn)]
      (when progress-bar-result
        (log/info (u/format-color 'blue "%s Analyzed %s %s" step progress-bar-result (sync-util/name-for-logging table)))))))
(defn- fingerprint-fields-summary [{:keys [fingerprints-attempted updated-fingerprints no-data-fingerprints failed-fingerprints]}]
  (format "Fingerprint updates attempted %d, updated %d, no data found %d, failed %d"
          fingerprints-attempted updated-fingerprints no-data-fingerprints failed-fingerprints))
(defn- classify-fields-summary [{:keys [fields-classified fields-failed]}]
  (format "Total number of fields classified %d, %d failed"
          fields-classified fields-failed))
(defn- classify-tables-summary [{:keys [total-tables tables-classified]}]
  (format "Total number of tables classified %d, %d updated"
          total-tables tables-classified))
(defn- make-analyze-steps [tables log-fn]
  [(sync-util/create-sync-step "fingerprint-fields"
                               #(fingerprint/fingerprint-fields-for-db! % tables log-fn)
                               fingerprint-fields-summary)
   (sync-util/create-sync-step "classify-fields"
                               #(classify/classify-fields-for-db! % tables log-fn)
                               classify-fields-summary)
   (sync-util/create-sync-step "classify-tables"
                               #(classify/classify-tables-for-db! % tables log-fn)
                               classify-tables-summary)])

Perform in-depth analysis on the data for all Tables in a given database. This is dependent on what each database driver supports, but includes things like cardinality testing and table row counting. This also updates the :last_analyzed value for each affected Field.

(mu/defn analyze-db!
  [database :- i/DatabaseInstance]
  (sync-util/sync-operation :analyze database (format "Analyze data for %s" (sync-util/name-for-logging database))
    (let [tables (sync-util/db->sync-tables database)]
      (sync-util/with-emoji-progress-bar [emoji-progress-bar (inc (* 3 (count tables)))]
        (u/prog1 (sync-util/run-sync-operation "analyze" database (make-analyze-steps tables (maybe-log-progress emoji-progress-bar)))
          (update-fields-last-analyzed-for-db! database tables))))))

Refingerprint a subset of tables in a given database. This will re-fingerprint tables up to a threshold amount of [[fingerprint/max-refingerprint-field-count]].

(mu/defn refingerprint-db!
  [database :- i/DatabaseInstance]
  (sync-util/sync-operation :refingerprint database (format "Refingerprinting tables for %s" (sync-util/name-for-logging database))
    (let [tables (sync-util/db->sync-tables database)
          log-fn (fn [step table]
                   (log/info (u/format-color 'blue "%s Analyzed %s" step (sync-util/name-for-logging table))))]
      (sync-util/run-sync-operation "refingerprint database"
                                    database
                                    [(sync-util/create-sync-step "refingerprinting fields"
                                                                 #(fingerprint/refingerprint-fields-for-db! % tables log-fn)
                                                                 fingerprint-fields-summary)]))))
 

Classifier that determines whether a Field should be marked as a :type/Category and/or as a list Field based on the number of distinct values it has.

As of Metabase v0.29, the Category now longer has any use inside of the Metabase backend; it is used only for frontend purposes (e.g. deciding which widget to show). Previously, makring something as a Category meant that its values should be cached and saved in a FieldValues object. With the changes in v0.29, this is instead managed by a column called has-field-values.

A value of list now means the values should be cached. Deciding whether a Field should be a list Field is still determined by the cardinality of the Field, like Category status. Thus it is entirely possibly for a Field to be both a Category and a list Field.

(ns metabase.sync.analyze.classifiers.category
  (:require
   [metabase.lib.schema.metadata :as lib.schema.metadata]
   [metabase.models.field-values :as field-values]
   [metabase.sync.interface :as i]
   [metabase.sync.util :as sync-util]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]))
(defn- cannot-be-category-or-list?
  [{base-type :base_type, semantic-type :semantic_type}]
  (or (isa? base-type :type/Temporal)
      (isa? base-type :type/Collection)
      (isa? base-type :type/Float)
      ;; Don't let IDs become list Fields (they already can't become categories, because they already have a semantic
      ;; type). It just doesn't make sense to cache a sequence of numbers since they aren't inherently meaningful
      (isa? semantic-type :type/PK)
      (isa? semantic-type :type/FK)))
(mu/defn ^:private field-should-be-category? :- [:maybe :boolean]
  [fingerprint :- [:maybe i/Fingerprint]
   field       :- i/FieldInstance]
  (let [distinct-count (get-in fingerprint [:global :distinct-count])
        nil%           (get-in fingerprint [:global :nil%])]
    ;; Only mark a Field as a Category if it doesn't already have a semantic type.
    (when (and (nil? (:semantic_type field))
               (or (some-> nil% (< 1))
                   (isa? (:base_type field) :type/Boolean))
               (some-> distinct-count (<= field-values/category-cardinality-threshold)))
      (log/debug (format "%s has %d distinct values. Since that is less than %d, we're marking it as a category."
                         (sync-util/name-for-logging field)
                         distinct-count
                         field-values/category-cardinality-threshold))
      true)))
(mu/defn ^:private field-should-be-auto-list? :- [:maybe :boolean]
  "Based on `distinct-count`, should we mark this `field` as `has-field-values` = `auto-list`?"
  [fingerprint :- [:maybe i/Fingerprint]
   field       :- [:map [:has-field-values {:optional true} [:maybe ::lib.schema.metadata/column.has-field-values]]]]
  ;; only update has-field-values if it hasn't been set yet. If it's already been set then it was probably done so
  ;; manually by an admin, and we don't want to stomp over their choices.
  (let [distinct-count (get-in fingerprint [:global :distinct-count])]
    (when (and (nil? (:has-field-values field))
               (some-> distinct-count (<= field-values/auto-list-cardinality-threshold)))
      (log/debug (format "%s has %d distinct values. Since that is less than %d, it should have cached FieldValues."
                         (sync-util/name-for-logging field)
                         distinct-count
                         field-values/auto-list-cardinality-threshold))
      true)))
(mu/defn infer-is-category-or-list :- [:maybe i/FieldInstance]
  "Classifier that attempts to determine whether `field` ought to be marked as a Category based on its distinct count."
  [field       :- i/FieldInstance
   fingerprint :- [:maybe i/Fingerprint]]
  (when (and fingerprint
             (not (cannot-be-category-or-list? field)))
    (cond-> field
      (field-should-be-category? fingerprint field)  (assoc :semantic_type :type/Category)
      (field-should-be-auto-list? fingerprint field) (assoc :has_field_values :auto-list))))
 

Classifier that infers the semantic type of a Field based on its name and base type.

(ns metabase.sync.analyze.classifiers.name
  (:require
   [clojure.string :as str]
   [metabase.config :as config]
   [metabase.driver.util :as driver.u]
   [metabase.sync.interface :as i]
   [metabase.sync.util :as sync-util]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]))
(def ^:private bool-or-int-type #{:type/Boolean :type/Integer})
(def ^:private float-type       #{:type/Float})
(def ^:private int-type         #{:type/Integer})
(def ^:private int-or-text-type #{:type/Integer :type/Text})
(def ^:private text-type        #{:type/Text})
(def ^:private timestamp-type   #{:type/DateTime})
(def ^:private time-type        #{:type/Time})
(def ^:private date-type        #{:type/Date})
(def ^:private number-type      #{:type/Number})
(def ^:private any-type         #{:type/*})

Tuples of [name-pattern set-of-valid-base-types semantic-type]. Fields whose name matches the pattern and one of the base types should be given the semantic type. Be mindful that patterns are tried top to bottom when matching derived types (eg. Date should be before DateTime).

  • Convert field name to lowercase before matching against a pattern
  • Consider a nil set-of-valid-base-types to mean "match any base type"
(def ^:private pattern+base-types+semantic-type
  [[#"^id$"                        any-type         :type/PK]
   [#"^lon$"                       float-type       :type/Longitude]
   [#"^.*_lon$"                    float-type       :type/Longitude]
   [#"^.*_lng$"                    float-type       :type/Longitude]
   [#"^.*_long$"                   float-type       :type/Longitude]
   [#"^.*_longitude$"              float-type       :type/Longitude]
   [#"^lng$"                       float-type       :type/Longitude]
   [#"^long$"                      float-type       :type/Longitude]
   [#"^longitude$"                 float-type       :type/Longitude]
   [#"^lat$"                       float-type       :type/Latitude]
   [#"^.*_lat$"                    float-type       :type/Latitude]
   [#"^latitude$"                  float-type       :type/Latitude]
   [#"^.*_latitude$"               float-type       :type/Latitude]
   [#"^.*_type$"                   int-or-text-type :type/Category]
   [#"^.*_url$"                    text-type        :type/URL]
   [#"^active$"                    bool-or-int-type :type/Category]
   [#"^city$"                      text-type        :type/City]
   [#"^country"                    text-type        :type/Country]
   [#"_country$"                   text-type        :type/Country]
   [#"^currency$"                  int-or-text-type :type/Category]
   [#"^first(?:_?)name$"           text-type        :type/Name]
   [#"^full(?:_?)name$"            text-type        :type/Name]
   [#"^gender$"                    int-or-text-type :type/Category]
   [#"^last(?:_?)name$"            text-type        :type/Name]
   [#"^name$"                      text-type        :type/Name]
   [#"^postal(?:_?)code$"          int-or-text-type :type/ZipCode]
   [#"^role$"                      int-or-text-type :type/Category]
   [#"^sex$"                       int-or-text-type :type/Category]
   [#"^status$"                    int-or-text-type :type/Category]
   [#"^type$"                      int-or-text-type :type/Category]
   [#"^url$"                       text-type        :type/URL]
   [#"^zip(?:_?)code$"             int-or-text-type :type/ZipCode]
   [#"discount"                    number-type      :type/Discount]
   [#"income"                      number-type      :type/Income]
   [#"quantity"                    int-type         :type/Quantity]
   [#"count$"                      int-type         :type/Quantity]
   [#"number"                      int-type         :type/Quantity]
   [#"^num_"                       int-type         :type/Quantity]
   [#"join"                        date-type        :type/JoinDate]
   [#"join"                        time-type        :type/JoinTime]
   [#"join"                        timestamp-type   :type/JoinTimestamp]
   [#"create"                      date-type        :type/CreationDate]
   [#"create"                      time-type        :type/CreationTime]
   [#"create"                      timestamp-type   :type/CreationTimestamp]
   [#"start"                       date-type        :type/CreationDate]
   [#"start"                       time-type        :type/CreationTime]
   [#"start"                       timestamp-type   :type/CreationTimestamp]
   [#"cancel"                      date-type        :type/CancelationDate]
   [#"cancel"                      time-type        :type/CancelationTime]
   [#"cancel"                      timestamp-type   :type/CancelationTimestamp]
   [#"delet(?:e|i)"                date-type        :type/DeletionDate]
   [#"delet(?:e|i)"                time-type        :type/DeletionTime]
   [#"delet(?:e|i)"                timestamp-type   :type/DeletionTimestamp]
   [#"update"                      date-type        :type/UpdatedDate]
   [#"update"                      time-type        :type/UpdatedTime]
   [#"update"                      timestamp-type   :type/UpdatedTimestamp]
   [#"source"                      int-or-text-type :type/Source]
   [#"channel"                     int-or-text-type :type/Source]
   [#"share"                       float-type       :type/Share]
   [#"percent"                     float-type       :type/Share]
   [#"rate$"                       float-type       :type/Share]
   [#"margin"                      number-type      :type/GrossMargin]
   [#"cost"                        number-type      :type/Cost]
   [#"duration"                    number-type      :type/Duration]
   [#"author"                      int-or-text-type :type/Author]
   [#"creator"                     int-or-text-type :type/Author]
   [#"created(?:_?)by"             int-or-text-type :type/Author]
   [#"owner"                       int-or-text-type :type/Owner]
   [#"company"                     int-or-text-type :type/Company]
   [#"vendor"                      int-or-text-type :type/Company]
   [#"subscription"                int-or-text-type :type/Subscription]
   [#"score"                       number-type      :type/Score]
   [#"rating"                      number-type      :type/Score]
   [#"stars"                       number-type      :type/Score]
   [#"description"                 text-type        :type/Description]
   [#"title"                       text-type        :type/Title]
   [#"comment"                     text-type        :type/Comment]
   [#"birthda(?:te|y)"             date-type        :type/Birthdate]
   [#"birthda(?:te|y)"             timestamp-type   :type/Birthdate]
   [#"(?:te|y)(?:_?)of(?:_?)birth" date-type        :type/Birthdate]
   [#"(?:te|y)(?:_?)of(?:_?)birth" timestamp-type   :type/Birthdate]])

Check that all the pattern tuples are valid

(when-not config/is-prod?
  (doseq [[name-pattern base-types semantic-type] pattern+base-types+semantic-type]
    (assert (instance? java.util.regex.Pattern name-pattern))
    (assert (every? #(isa? % :type/*) base-types))
    (assert (or (isa? semantic-type :Semantic/*)
                (isa? semantic-type :Relation/*)))))
(mu/defn ^:private semantic-type-for-name-and-base-type :- [:maybe ms/FieldSemanticOrRelationType]
  "If `name` and `base-type` matches a known pattern, return the `semantic-type` we should assign to it."
  [field-name :- ms/NonBlankString
   base-type  :- ms/FieldType]
  (let [field-name (u/lower-case-en field-name)]
    (some (fn [[name-pattern valid-base-types semantic-type]]
            (when (and (some (partial isa? base-type) valid-base-types)
                       (re-find name-pattern field-name))
              semantic-type))
          pattern+base-types+semantic-type)))

Schema that allows a metabase.model.field/Field or a column from a query resultset

(def ^:private FieldOrColumn
  [:and
   [:map
    ;; Some DBs such as MSSQL can return columns with blank name
    [:name      :string]
    [:base_type :keyword]
    [:semantic_type {:optional true} [:maybe :keyword]]]
   ::i/no-kebab-case-keys])
(mu/defn infer-semantic-type :- [:maybe :keyword]
  "Classifer that infers the semantic type of a `field` based on its name and base type."
  [field-or-column :- FieldOrColumn]
  ;; Don't overwrite keys, else we're ok with overwriting as a new more precise type might have
  ;; been added.
  (when-not (or (some (partial isa? (:semantic_type field-or-column)) [:type/PK :type/FK])
                (str/blank? (:name field-or-column)))
    (semantic-type-for-name-and-base-type (:name field-or-column) (:base_type field-or-column))))
(mu/defn infer-and-assoc-semantic-type :- [:maybe FieldOrColumn]
  "Returns `field-or-column` with a computed semantic type based on the name and base type of the `field-or-column`"
  [field-or-column :- FieldOrColumn
   _fingerprint    :- [:maybe i/Fingerprint]]
  (when-let [inferred-semantic-type (infer-semantic-type field-or-column)]
    (log/debug (format "Based on the name of %s, we're giving it a semantic type of %s."
                       (sync-util/name-for-logging field-or-column)
                       inferred-semantic-type))
    (assoc field-or-column :semantic_type inferred-semantic-type)))
(defn- prefix-or-postfix
  [s]
  (re-pattern (format "(?:^%s)|(?:%ss?$)" s s)))
(def ^:private entity-types-patterns
  [[(prefix-or-postfix "order")        :entity/TransactionTable]
   [(prefix-or-postfix "transaction")  :entity/TransactionTable]
   [(prefix-or-postfix "sale")         :entity/TransactionTable]
   [(prefix-or-postfix "product")      :entity/ProductTable]
   [(prefix-or-postfix "user")         :entity/UserTable]
   [(prefix-or-postfix "account")      :entity/UserTable]
   [(prefix-or-postfix "people")       :entity/UserTable]
   [(prefix-or-postfix "person")       :entity/UserTable]
   [(prefix-or-postfix "employee")     :entity/UserTable]
   [(prefix-or-postfix "event")        :entity/EventTable]
   [(prefix-or-postfix "checkin")      :entity/EventTable]
   [(prefix-or-postfix "log")          :entity/EventTable]
   [(prefix-or-postfix "subscription") :entity/SubscriptionTable]
   [(prefix-or-postfix "company")      :entity/CompanyTable]
   [(prefix-or-postfix "companies")    :entity/CompanyTable]
   [(prefix-or-postfix "vendor")       :entity/CompanyTable]])
(mu/defn infer-entity-type :- i/TableInstance
  "Classifer that infers the semantic type of a `table` based on its name."
  [table :- i/TableInstance]
  (let [table-name (-> table :name u/lower-case-en)]
    (assoc table :entity_type (or (some (fn [[pattern type]]
                                          (when (re-find pattern table-name)
                                            type))
                                        entity-types-patterns)
                                  (case (some-> (:db_id table) driver.u/database->driver)
                                    :googleanalytics :entity/GoogleAnalyticsTable
                                    :druid           :entity/EventTable
                                    nil)
                                  :entity/GenericTable))))
 

Classifier that decides whether a Field should be marked 'No Preview Display'. (This means Fields are generally not shown in Table results and the like, but still shown in a single-row object detail page.)

(ns metabase.sync.analyze.classifiers.no-preview-display
  (:require
   [metabase.sync.interface :as i]
   [metabase.util.malli :as mu]))

Fields whose values' average length is greater than this amount should be marked as preview_display = false.

(def ^:private ^:const ^Long average-length-no-preview-threshold
  50)
(defn- long-plain-text-field?
  [{base-type :base_type, semantic-type :semantic_type} fingerprint]
  (and (isa? base-type :type/Text)
       (contains? #{nil :type/SerializedJSON} semantic-type)
       (some-> fingerprint
               (get-in [:type :type/Text :average-length])
               (> average-length-no-preview-threshold))))
(mu/defn infer-no-preview-display :- [:maybe i/FieldInstance]
  "Classifier that determines whether `field` should be marked 'No Preview Display'. If `field` is textual and its
  average length is too great, mark it so it isn't displayed in the UI."
  [field       :- i/FieldInstance
   fingerprint :- [:maybe i/Fingerprint]]
  (when (long-plain-text-field? field fingerprint)
    (assoc field :preview_display false)))
 

Logic for inferring the semantic types of Text fields based on their TextFingerprints. These tests only run against Fields that don't have existing semantic types.

(ns metabase.sync.analyze.classifiers.text-fingerprint
  (:require
   [metabase.sync.interface :as i]
   [metabase.sync.util :as sync-util]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]))

Fields that have at least this percent of values that are satisfy some predicate (such as u/email?) should be given the corresponding semantic type (such as :type/Email).

(def ^:private ^:const ^Double percent-valid-threshold
  0.95)

Fields that have at least this lower percent of values that satisfy some predicate (such as u/state?) should be given the corresponding semantic type (such as :type/State)

(def ^:private ^Double lower-percent-valid-threshold
  0.7)

Is the value of percent-key inside text-fingerprint above the percent-valid-threshold?

(mu/defn ^:private percent-key-above-threshold?
  [threshold        :- :double
   text-fingerprint :- i/TextFingerprint
   percent-key      :- :keyword]
  (when-let [percent (get text-fingerprint percent-key)]
    (>= percent threshold)))

Map of keys inside the TextFingerprint to the corresponding semantic types we should mark a Field as if the value of the key is over percent-valid-thresold.

(def ^:private percent-key->semantic-type
  {:percent-json  [:type/SerializedJSON percent-valid-threshold]
   :percent-url   [:type/URL            percent-valid-threshold]
   :percent-email [:type/Email          percent-valid-threshold]
   :percent-state [:type/State          lower-percent-valid-threshold]})
(mu/defn ^:private infer-semantic-type-for-text-fingerprint :- [:maybe ms/FieldType]
  "Check various percentages inside the `text-fingerprint` and return the corresponding semantic type to mark the Field
  as if the percent passes the threshold."
  [text-fingerprint :- i/TextFingerprint]
  (some (fn [[percent-key [semantic-type threshold]]]
          (when (percent-key-above-threshold? threshold text-fingerprint percent-key)
            semantic-type))
        percent-key->semantic-type))

We can edit the semantic type if its currently unset or if it was set during the current analysis phase. The original field might exist in the metadata at :sync.classify/original. This is an attempt at classifier refinement: we never want to overwrite a user selection of semantic type but we allow for fingerprint results to give a better semantic type than previous classifiers.

(defn- can-edit-semantic-type?
  [field]
  (or (nil? (:semantic_type field))
      (let [original (get (meta field) :sync.classify/original)]
        (and original
             (nil? (:semantic_type original))))))
(mu/defn infer-semantic-type :- [:maybe i/FieldInstance]
  "Do classification for `:type/Text` Fields with a valid `TextFingerprint`.
   Currently this only checks the various recorded percentages, but this is subject to change in the future."
  [field       :- i/FieldInstance
   fingerprint :- [:maybe i/Fingerprint]]
  (when (and (isa? (:base_type field) :type/Text)
             (can-edit-semantic-type? field))
    (when-let [text-fingerprint (get-in fingerprint [:type :type/Text])]
      (when-let [inferred-semantic-type (infer-semantic-type-for-text-fingerprint text-fingerprint)]
        (log/debug (format "Based on the fingerprint of %s, we're marking it as %s."
                           (sync-util/name-for-logging field) inferred-semantic-type))
        (assoc field
               :semantic_type inferred-semantic-type)))))
 

Analysis sub-step that takes a fingerprint for a Field and infers and saves appropriate information like special type. Each 'classifier' takes the information available to it and decides whether or not to run. We currently have the following classifiers:

  1. name: Looks at the name of a Field and infers a semantic type if possible
  2. no-preview-display: Looks at average length of text Field recorded in fingerprint and decides whether or not we should hide this Field
  3. category: Looks at the number of distinct values of Field and determines whether it can be a Category
  4. text-fingerprint: Looks at percentages recorded in a text Fields' TextFingerprint and infers a semantic type if possible

All classifier functions take two arguments, a FieldInstance and a possibly nil Fingerprint, and should return the Field with any appropriate changes (such as a new semantic type). If no changes are appropriate, a classifier may return nil. Error handling is handled by run-classifiers below, so individual classiers do not need to handle errors themselves.

In the future, we plan to add more classifiers, including ML ones that run offline.

(ns metabase.sync.analyze.classify
  (:require
   [clojure.data :as data]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.models.interface :as mi]
   [metabase.query-processor.store :as qp.store]
   [metabase.sync.analyze.classifiers.category :as classifiers.category]
   [metabase.sync.analyze.classifiers.name :as classifiers.name]
   [metabase.sync.analyze.classifiers.no-preview-display
    :as classifiers.no-preview-display]
   [metabase.sync.analyze.classifiers.text-fingerprint
    :as classifiers.text-fingerprint]
   [metabase.sync.interface :as i]
   [metabase.sync.util :as sync-util]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [toucan2.core :as t2]))

+----------------------------------------------------------------------------------------------------------------+ | CLASSIFYING INDIVIDUAL FIELDS | +----------------------------------------------------------------------------------------------------------------+

Columns of Field that classifiers are allowed to set.

(def ^:private values-that-can-be-set
  #{:semantic_type :preview_display :has_field_values :entity_type})
(def ^:private FieldOrTableInstance
  [:or
   i/FieldInstance
   i/TableInstance])

Save the updates in updated-model (can be either a Field or Table).

(mu/defn ^:private save-model-updates!
  [original-model :- FieldOrTableInstance
   updated-model  :- FieldOrTableInstance]
  (assert (= (type original-model) (type updated-model)))
  (let [[_ values-to-set] (data/diff original-model updated-model)]
    (when (seq values-to-set)
      (log/debug (format "Based on classification, updating these values of %s: %s"
                         (sync-util/name-for-logging original-model)
                         values-to-set)))
    ;; Check that we're not trying to set anything that we're not allowed to
    (doseq [k (keys values-to-set)]
      (when-not (contains? values-that-can-be-set k)
        (throw (Exception. (format "Classifiers are not allowed to set the value of %s." k)))))
    ;; cool, now we should be ok to update the model
    (when values-to-set
      (t2/update! (if (mi/instance-of? :model/Field original-model)
                    :model/Field
                    :model/Table)
          (u/the-id original-model)
        values-to-set)
      true)))

Various classifier functions available. These should all take two args, a FieldInstance and a possibly nil Fingerprint, and return FieldInstance with any inferred property changes, or nil if none could be inferred. Order is important!

A classifier may see the original field (before any classifiers were run) in the metadata of the field at :sync.classify/original.

(def ^:private classifiers
  [#'classifiers.name/infer-and-assoc-semantic-type
   #'classifiers.category/infer-is-category-or-list
   #'classifiers.no-preview-display/infer-no-preview-display
   #'classifiers.text-fingerprint/infer-semantic-type])
(mu/defn run-classifiers :- i/FieldInstance
  "Run all the available `classifiers` against `field` and `fingerprint`, and return the resulting `field` with
  changes decided upon by the classifiers. The original field can be accessed in the metadata at
  `:sync.classify/original`."
  [field       :- i/FieldInstance
   fingerprint :- [:maybe i/Fingerprint]]
  (reduce (fn [field classifier]
            (or (sync-util/with-error-handling (format "Error running classifier on %s"
                                                       (sync-util/name-for-logging field))
                  (classifier field fingerprint))
                field))
          (vary-meta field assoc :sync.classify/original field)
          classifiers))

Run various classifiers on field and its fingerprint, and save any detected changes.

(mu/defn ^:private classify!
  ([field :- i/FieldInstance]
   (classify! field (or (:fingerprint field)
                        (when (qp.store/initialized?)
                          (:fingerprint (lib.metadata/field (qp.store/metadata-provider) (u/the-id field))))
                        (t2/select-one-fn :fingerprint :model/Field :id (u/the-id field)))))
  ([field      :- i/FieldInstance
    fingerprint :- [:maybe i/Fingerprint]]
   (sync-util/with-error-handling (format "Error classifying %s" (sync-util/name-for-logging field))
     (let [updated-field (run-classifiers field fingerprint)]
       (when-not (= field updated-field)
         (save-model-updates! field updated-field))))))

+------------------------------------------------------------------------------------------------------------------+ | CLASSIFYING ALL FIELDS IN A TABLE | +------------------------------------------------------------------------------------------------------------------+

(mu/defn ^:private fields-to-classify :- [:maybe [:sequential i/FieldInstance]]
  "Return a sequences of Fields belonging to `table` for which we should attempt to determine semantic type. This
  should include Fields that have the latest fingerprint, but have not yet *completed* analysis."
  [table :- i/TableInstance]
  (seq (t2/select :model/Field
         :table_id            (u/the-id table)
         :fingerprint_version i/*latest-fingerprint-version*
         :last_analyzed       nil)))

Run various classifiers on the appropriate fields in a table that have not been previously analyzed. These do things like inferring (and setting) the semantic types and preview display status for Fields belonging to table.

(mu/defn classify-fields!
  [table :- i/TableInstance]
  (when-let [fields (fields-to-classify table)]
    {:fields-classified (count fields)
     :fields-failed     (->> fields
                             (map classify!)
                             (filter (partial instance? Exception))
                             count)}))

Run various classifiers on the table. These do things like inferring (and setting) entitiy type of table.

(mu/defn ^:always-validate classify-table!
  [table :- i/TableInstance]
  (let [updated-table (sync-util/with-error-handling (format "Error running classifier on %s"
                                                             (sync-util/name-for-logging table))
                        (classifiers.name/infer-entity-type table))]
    (if (instance? Exception updated-table)
      table
      (save-model-updates! table updated-table))))

Classify all tables found in a given database

(mu/defn classify-tables-for-db!
  [_database :- i/DatabaseInstance
   tables    :- [:maybe [:sequential i/TableInstance]]
   log-progress-fn]
  {:total-tables      (count tables)
   :tables-classified (sync-util/sum-numbers (fn [table]
                                               (let [result (classify-table! table)]
                                                 (log-progress-fn "classify-tables" table)
                                                 (if result
                                                   1
                                                   0)))
                                             tables)})

Classify all fields found in a given database

(mu/defn classify-fields-for-db!
  [_database :- i/DatabaseInstance
   tables    :- [:maybe [:sequential i/TableInstance]]
   log-progress-fn]
  (apply merge-with +
         {:fields-classified 0, :fields-failed 0}
         (map (fn [table]
                (let [result (classify-fields! table)]
                  (log-progress-fn "classify-fields" table)
                  result))
              tables)))
 

Analysis sub-step that takes a sample of values for a Field and saving a non-identifying fingerprint used for classification. This fingerprint is saved as a column on the Field it belongs to.

(ns metabase.sync.analyze.fingerprint
  (:require
   [clojure.set :as set]
   [honey.sql.helpers :as sql.helpers]
   [metabase.db.metadata-queries :as metadata-queries]
   [metabase.db.util :as mdb.u]
   [metabase.driver :as driver]
   [metabase.driver.util :as driver.u]
   [metabase.models.field :as field :refer [Field]]
   [metabase.models.table :as table]
   [metabase.query-processor.store :as qp.store]
   [metabase.sync.analyze.fingerprint.fingerprinters :as fingerprinters]
   [metabase.sync.interface :as i]
   [metabase.sync.util :as sync-util]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.registry :as mr]
   [metabase.util.malli.schema :as ms]
   [redux.core :as redux]
   [toucan2.core :as t2]))
(comment
  metadata-queries/keep-me-for-default-table-row-sample)
(mu/defn ^:private save-fingerprint!
  [field       :- i/FieldInstance
   fingerprint :- [:maybe i/Fingerprint]]
  (log/debugf "Saving fingerprint for %s" (sync-util/name-for-logging field))
  ;; All Fields who get new fingerprints should get marked as having the latest fingerprint version, but we'll
  ;; clear their values for `last_analyzed`. This way we know these fields haven't "completed" analysis for the
  ;; latest fingerprints.
  (t2/update! Field (u/the-id field)
              {:fingerprint         fingerprint
               :fingerprint_version i/*latest-fingerprint-version*
               :last_analyzed       nil}))
(mr/def ::FingerprintStats
  [:map
   [:no-data-fingerprints   ms/IntGreaterThanOrEqualToZero]
   [:failed-fingerprints    ms/IntGreaterThanOrEqualToZero]
   [:updated-fingerprints   ms/IntGreaterThanOrEqualToZero]
   [:fingerprints-attempted ms/IntGreaterThanOrEqualToZero]])
(mu/defn empty-stats-map :- ::FingerprintStats
  "The default stats before any fingerprints happen"
  [fields-count :- ms/IntGreaterThanOrEqualToZero]
  {:no-data-fingerprints   0
   :failed-fingerprints    0
   :updated-fingerprints   0
   :fingerprints-attempted fields-count})

The maximum size of :type/Text to be selected from the database in table-rows-sample. In practice we see large text blobs and want to balance taking enough for distinct counts and but not so much that we risk out of memory issues when syncing.

(def ^:private ^:dynamic *truncation-size*
  1234)
(mu/defn ^:private fingerprint-table!
  [table  :- i/TableInstance
   fields :- [:maybe [:sequential i/FieldInstance]]]
  (let [rff (fn [_metadata]
              (redux/post-complete
               (fingerprinters/fingerprint-fields fields)
               (fn [fingerprints]
                 (reduce (fn [count-info [field fingerprint]]
                           (cond
                             (instance? Throwable fingerprint)
                             (update count-info :failed-fingerprints inc)
                             (some-> fingerprint :global :distinct-count zero?)
                             (update count-info :no-data-fingerprints inc)
                             :else
                             (do
                               (save-fingerprint! field fingerprint)
                               (update count-info :updated-fingerprints inc))))
                         (empty-stats-map (count fingerprints))
                         (map vector fields fingerprints)))))
        driver (driver.u/database->driver (table/database table))
        opts {:truncation-size *truncation-size*}]
    (driver/table-rows-sample driver table fields rff opts)))

+----------------------------------------------------------------------------------------------------------------+ | WHICH FIELDS NEED UPDATED FINGERPRINTS? | +----------------------------------------------------------------------------------------------------------------+

Logic for building the somewhat-complicated query we use to determine which Fields need new Fingerprints

This ends up giving us a SQL query that looks something like:

SELECT * FROM metabase_field WHERE active = true AND (semantictype NOT IN ('type/PK') OR semantictype IS NULL) AND preview_display = true AND visibility_type <> 'retired' AND table_id = 1 AND ((fingerprint_version < 1 AND base_type IN ("type/Longitude", "type/Latitude", "type/Integer")) OR (fingerprint_version < 2 AND base_type IN ("type/Text", "type/SerializedJSON")))

(mu/defn ^:private base-types->descendants :- [:maybe [:set ms/FieldTypeKeywordOrString]]
  "Given a set of `base-types` return an expanded set that includes those base types as well as all of their
  descendants. These types are converted to strings so HoneySQL doesn't confuse them for columns."
  [base-types :- [:set ms/FieldType]]
  (into #{}
        (comp (mapcat (fn [base-type]
                        (cons base-type (descendants base-type))))
              (map u/qualified-name))
        base-types))

It's even cooler if we could generate efficient SQL that looks at what types have already been marked for upgrade so we don't need to generate overly-complicated queries.

e.g. instead of doing:

WHERE ((version < 2 AND base_type IN ("type/Integer", "type/BigInteger", "type/Text")) OR (version < 1 AND base_type IN ("type/Boolean", "type/Integer", "type/BigInteger")))

we could do:

WHERE ((version < 2 AND base_type IN ("type/Integer", "type/BigInteger", "type/Text")) OR (version < 1 AND base_type IN ("type/Boolean")))

(In the example above, something that is a type/Integer or type/Text would get upgraded as long as it's less than version 2; so no need to also check if those types are less than 1, which would always be the case.)

This way we can also completely omit adding clauses for versions that have been "eclipsed" by others. This would keep the SQL query from growing boundlessly as new fingerprint versions are added

(mu/defn ^:private versions-clauses :- [:maybe [:sequential :any]]
  []
  ;; keep track of all the base types (including descendants) for each version, starting from most recent
  (let [versions+base-types (reverse (sort-by first (seq i/*fingerprint-version->types-that-should-be-re-fingerprinted*)))
        already-seen        (atom #{})]
    (for [[version base-types] versions+base-types
          :let  [descendants  (base-types->descendants base-types)
                 not-yet-seen (set/difference descendants @already-seen)]
          ;; if all the descendants of any given version have already been seen, we can skip this clause altogether
          :when (seq not-yet-seen)]
      ;; otherwise record the newly seen types and generate an appropriate clause
      (do
        (swap! already-seen set/union not-yet-seen)
        [:and
         [:< :fingerprint_version version]
         [:in :base_type not-yet-seen]]))))

Base clause to get fields for fingerprinting. When refingerprinting, run as is. When fingerprinting in analysis, only look for fields without a fingerprint or whose version can be updated. This clauses is added on by [[versions-clauses]].

(def ^:private fields-to-fingerprint-base-clause
  [:and
   [:= :active true]
   [:or
    [:not (mdb.u/isa :semantic_type :type/PK)]
    [:= :semantic_type nil]]
   [:not-in :visibility_type ["retired" "sensitive"]]
   [:not (mdb.u/isa :base_type :type/Structured)]])

Whether we are refingerprinting or doing the normal fingerprinting. Refingerprinting should get fields that already are analyzed and have fingerprints.

(def ^:dynamic *refingerprint?*
  false)
(mu/defn ^:private honeysql-for-fields-that-need-fingerprint-updating :- [:map
                                                                          [:where :any]]
  "Return appropriate WHERE clause for all the Fields whose Fingerprint needs to be re-calculated."
  ([]
   {:where (cond-> fields-to-fingerprint-base-clause
             (not *refingerprint?*) (conj (cons :or (versions-clauses))))})
  ([table :- i/TableInstance]
   (sql.helpers/where (honeysql-for-fields-that-need-fingerprint-updating)
                      [:= :table_id (u/the-id table)])))

+----------------------------------------------------------------------------------------------------------------+ | FINGERPRINTING ALL FIELDS IN A TABLE | +----------------------------------------------------------------------------------------------------------------+

(mu/defn ^:private fields-to-fingerprint :- [:maybe [:sequential i/FieldInstance]]
  "Return a sequences of Fields belonging to `table` for which we should generate (and save) fingerprints.
   This should include NEW fields that are active and visible."
  [table :- i/TableInstance]
  (seq (t2/select Field
         (honeysql-for-fields-that-need-fingerprint-updating table))))

Generate and save fingerprints for all the Fields in table that have not been previously analyzed.

TODO - fingerprint-fields! and fingerprint-table! should probably have their names switched

(mu/defn fingerprint-fields!
  [table :- i/TableInstance]
  (if-let [fields (fields-to-fingerprint table)]
    (let [stats (sync-util/with-error-handling
                  (format "Error fingerprinting %s" (sync-util/name-for-logging table))
                  (fingerprint-table! table fields))]
      (if (instance? Exception stats)
        (empty-stats-map 0)
        stats))
    (empty-stats-map 0)))
(def ^:private LogProgressFn
  [:=> [:cat :string [:schema i/TableInstance]] :any])

Invokes fingerprint-fields! on every table in database

(mu/defn ^:private fingerprint-fields-for-db!*
  ([database        :- i/DatabaseInstance
    tables          :- [:maybe [:sequential i/TableInstance]]
    log-progress-fn :- LogProgressFn]
   (fingerprint-fields-for-db!* database tables log-progress-fn (constantly true)))
  ;; TODO: Maybe the driver should have a function to tell you if it supports fingerprinting?
  ([database        :- i/DatabaseInstance
    tables          :- [:maybe [:sequential i/TableInstance]]
    log-progress-fn :- LogProgressFn
    continue?       :- [:=> [:cat ::FingerprintStats] :any]]
   (qp.store/with-metadata-provider (u/the-id database)
     (reduce (fn [acc table]
               (log-progress-fn (if *refingerprint?* "refingerprint-fields" "fingerprint-fields") table)
               (let [results (if (= :googleanalytics (:engine database))
                               (empty-stats-map 0)
                               (fingerprint-fields! table))
                     new-acc (merge-with + acc results)]
                 (if (continue? new-acc)
                   new-acc
                   (reduced new-acc))))
             (empty-stats-map 0)
             tables))))

Invokes [[fingerprint-fields!]] on every table in database

(mu/defn fingerprint-fields-for-db!
  [database        :- i/DatabaseInstance
   tables          :- [:maybe [:sequential i/TableInstance]]
   log-progress-fn :- LogProgressFn]
  ;; TODO: Maybe the driver should have a function to tell you if it supports fingerprinting?
  (fingerprint-fields-for-db!* database tables log-progress-fn))

Maximum number of fields to refingerprint. Balance updating our fingerprinting values while not spending too much time in the db.

(def ^:private max-refingerprint-field-count
  1000)

Invokes [[fingeprint-fields!]] on every table in database up to some limit.

(mu/defn refingerprint-fields-for-db!
  [database        :- i/DatabaseInstance
   tables          :- [:maybe [:sequential i/TableInstance]]
   log-progress-fn :- LogProgressFn]
  (binding [*refingerprint?* true]
    (fingerprint-fields-for-db!* database
                                 ;; our rudimentary refingerprint strategy is to shuffle the tables and fingerprint
                                 ;; until we are over some threshold of fields
                                 (shuffle tables)
                                 log-progress-fn
                                 (fn [stats-acc]
                                   (< (:fingerprints-attempted stats-acc) max-refingerprint-field-count)))))

Refingerprint a field

(mu/defn refingerprint-field
  [field :- i/FieldInstance]
  (let [table (field/table field)]
    (fingerprint-table! table [field])))
 

Non-identifying fingerprinters for various field types.

(ns metabase.sync.analyze.fingerprint.fingerprinters
  (:require
   [bigml.histogram.core :as hist]
   [java-time.api :as t]
   [kixi.stats.core :as stats]
   [kixi.stats.math :as math]
   [medley.core :as m]
   [metabase.sync.analyze.classifiers.name :as classifiers.name]
   [metabase.sync.util :as sync-util]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date]
   [redux.core :as redux])
  (:import
   (com.bigml.histogram Histogram)
   (com.clearspring.analytics.stream.cardinality HyperLogLogPlus)
   (java.time ZoneOffset)
   (java.time.chrono ChronoLocalDateTime ChronoZonedDateTime)
   (java.time.temporal Temporal)))
(set! *warn-on-reflection* true)

Apply reducing functinons rfs coll-wise to a seq of seqs.

(defn col-wise
  [& rfs]
  (fn
    ([] (mapv (fn [rf] (rf)) rfs))
    ([accs] (mapv (fn [rf acc] (rf (unreduced acc))) rfs accs))
    ([accs row]
     (let [all-reduced? (volatile! true)
           results      (mapv (fn [rf acc x]
                                (if-not (reduced? acc)
                                  (do (vreset! all-reduced? false)
                                      (rf acc x))
                                  acc))
                              rfs accs row)]
       (if @all-reduced?
         (reduced results)
         results)))))

Constantly return init.

(defn constant-fingerprinter
  [init]
  (fn
    ([] (reduced init))
    ([_] init)
    ([_ _] (reduced init))))

Transducer that sketches cardinality using HyperLogLog++. https://research.google.com/pubs/pub40671.html

(defn- cardinality
  ([] (HyperLogLogPlus. 14 25))
  ([^HyperLogLogPlus acc] (.cardinality acc))
  ([^HyperLogLogPlus acc x]
   (.offer acc x)
   acc))

Wrap each map value in try-catch block.

(defmacro robust-map
  [& kvs]
  `(hash-map ~@(apply concat (for [[k v] (partition 2 kvs)]
                               `[~k (try
                                      ~v
                                      (catch Throwable _#))]))))
(defmacro ^:private with-reduced-error
  [msg & body]
  `(let [result# (sync-util/with-error-handling ~msg ~@body)]
     (if (instance? Throwable result#)
       (reduced result#)
       result#)))

Wrap rf in an error-catching transducer.

(defn with-error-handling
  [rf msg]
  (fn
    ([] (with-reduced-error msg (rf)))
    ([acc]
     (unreduced
      (if (or (reduced? acc)
              (instance? Throwable acc))
        acc
        (with-reduced-error msg (rf acc)))))
    ([acc e] (with-reduced-error msg (rf acc e)))))

Like redux/fuse but wraps every reducing fn in with-error-handling and returns nil for that fn if an error has been encountered during transducing.

(defn robust-fuse
  [kfs]
  (redux/fuse (m/map-kv-vals (fn [k f]
                               (redux/post-complete
                                (with-error-handling f (format "Error reducing %s" (name k)))
                                (fn [result]
                                  (when-not (instance? Throwable result)
                                    result))))
                             kfs)))

Return a fingerprinter transducer for a given field based on the field's type.

(defmulti fingerprinter
  {:arglists '([field])}
  (fn [{base-type :base_type, effective-type :effective_type, semantic-type :semantic_type, :keys [unit]}]
    [(cond
       (u.date/extract-units unit)
       :type/Integer
       ;; for historical reasons the Temporal fingerprinter is still called `:type/DateTime` so anything that derives
       ;; from `Temporal` (such as DATEs and TIMEs) should still use the `:type/DateTime` fingerprinter
       (isa? (or effective-type base-type) :type/Temporal)
       :type/DateTime
       :else
       base-type)
     (if (isa? semantic-type :Semantic/*)
       semantic-type
       :Semantic/*)
     (if (isa? semantic-type :Relation/*)
       semantic-type
       :Relation/*)]))
(def ^:private global-fingerprinter
  (redux/post-complete
   (robust-fuse {:distinct-count cardinality
                 :nil%           (stats/share nil?)})
   (partial hash-map :global)))
(defmethod fingerprinter :default
  [_]
  global-fingerprinter)
(defmethod fingerprinter [:type/* :Semantic/* :type/FK]
  [_]
  global-fingerprinter)
(defmethod fingerprinter [:type/* :Semantic/* :type/PK]
  [_]
  (constant-fingerprinter nil))
(prefer-method fingerprinter [:type/*        :Semantic/* :type/FK]    [:type/Number :Semantic/* :Relation/*])
(prefer-method fingerprinter [:type/*        :Semantic/* :type/FK]    [:type/Text   :Semantic/* :Relation/*])
(prefer-method fingerprinter [:type/*        :Semantic/* :type/PK]    [:type/Number :Semantic/* :Relation/*])
(prefer-method fingerprinter [:type/*        :Semantic/* :type/PK]    [:type/Text   :Semantic/* :Relation/*])
(prefer-method fingerprinter [:type/DateTime :Semantic/* :Relation/*] [:type/*      :Semantic/* :type/PK])
(prefer-method fingerprinter [:type/DateTime :Semantic/* :Relation/*] [:type/*      :Semantic/* :type/FK])
(defn- with-global-fingerprinter
  [fingerprinter]
  (redux/post-complete
   (redux/juxt
    fingerprinter
    global-fingerprinter)
   (fn [[type-fingerprint global-fingerprint]]
     (merge global-fingerprint
            type-fingerprint))))
(defmacro ^:private deffingerprinter
  [field-type transducer]
  {:pre [(keyword? field-type)]}
  (let [field-type [field-type :Semantic/* :Relation/*]]
    `(defmethod fingerprinter ~field-type
       [field#]
       (with-error-handling
         (with-global-fingerprinter
           (redux/post-complete
            ~transducer
            (fn [fingerprint#]
              {:type {~(first field-type) fingerprint#}})))
         (format "Error generating fingerprint for %s" (sync-util/name-for-logging field#))))))
(declare ->temporal)
(defn- earliest
  ([] nil)
  ([acc]
   (some-> acc u.date/format))
  ([acc t]
   (if (and t acc (t/before? t acc))
     t
     (or acc t))))
(defn- latest
  ([] nil)
  ([acc]
   (some-> acc u.date/format))
  ([acc t]
   (if (and t acc (t/after? t acc))
     t
     (or acc t))))

Protocol for converting objects in resultset to a java.time temporal type.

(defprotocol ^:private ITemporalCoerceable
  (->temporal ^java.time.temporal.Temporal [this]
    "Coerce object to a `java.time` temporal type."))
(extend-protocol ITemporalCoerceable
  nil      (->temporal [_]    nil)
  String   (->temporal [this] (->temporal (u.date/parse this)))
  Long     (->temporal [this] (->temporal (t/instant this)))
  Integer  (->temporal [this] (->temporal (t/instant this)))
  ChronoLocalDateTime (->temporal [this] (.toInstant this (ZoneOffset/UTC)))
  ChronoZonedDateTime (->temporal [this] (.toInstant this))
  Temporal (->temporal [this] this)
  java.util.Date (->temporal [this] (t/instant this)))
(deffingerprinter :type/DateTime
  ((map ->temporal)
   (robust-fuse {:earliest earliest
                 :latest   latest})))

Transducer that summarizes numerical data with a histogram.

(defn- histogram
  ([] (hist/create))
  ([^Histogram histogram] histogram)
  ([^Histogram histogram x] (hist/insert-simple! histogram x)))
(deffingerprinter :type/Number
  (redux/post-complete
   ((filter u/real-number?) histogram)
   (fn [h]
     (let [{q1 0.25 q3 0.75} (hist/percentiles h 0.25 0.75)]
       (robust-map
        :min (hist/minimum h)
        :max (hist/maximum h)
        :avg (hist/mean h)
        :sd  (some-> h hist/variance math/sqrt)
        :q1  q1
        :q3  q3)))))

Is x a serialized JSON dictionary or array. Hueristically recognize maps and arrays. Uses the following strategies: - leading character {: assume valid JSON - leading character [: assume valid json unless its of the form [ident] where ident is not a boolean.

(defn- valid-serialized-json?
  [x]
  (u/ignore-exceptions
    (when (and x (string? x))
      (let [matcher (case (first x)
                      \[ (fn bracket-matcher [s]
                           (cond (re-find #"^\[\s*(?:true|false)" s) true
                                 (re-find #"^\[\s*[a-zA-Z]" s) false
                                 :else true))
                      \{ (constantly true)
                      (constantly false))]
        (matcher x)))))
(deffingerprinter :type/Text
  ((map str) ; we cast to str to support `field-literal` type overwriting:
             ; `[:field-literal "A_NUMBER" :type/Text]` (which still
             ; returns numbers in the result set)
   (robust-fuse {:percent-json   (stats/share valid-serialized-json?)
                 :percent-url    (stats/share u/url?)
                 :percent-email  (stats/share u/email?)
                 :percent-state  (stats/share u/state?)
                 :average-length ((map count) stats/mean)})))

Return a transducer for fingerprinting a resultset with fields fields.

(defn fingerprint-fields
  [fields]
  (apply col-wise (for [field fields]
                    (fingerprinter
                     (cond-> field
                       ;; Try to get a better guestimate of what we're dealing with on first sync
                       (every? nil? ((juxt :semantic_type :last_analyzed) field))
                       (assoc :semantic_type (classifiers.name/infer-semantic-type field)))))))
 

Deeper statistical analysis of results.

(ns metabase.sync.analyze.fingerprint.insights
  (:require
   [java-time.api :as t]
   [kixi.stats.core :as stats]
   [kixi.stats.math :as math]
   [kixi.stats.protocols :as p]
   [medley.core :as m]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.field :refer [Field]]
   [metabase.models.interface :as mi]
   [metabase.sync.analyze.fingerprint.fingerprinters :as fingerprinters]
   [metabase.sync.util :as sync-util]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date]
   [redux.core :as redux])
  (:import
   (java.time Instant LocalDate LocalDateTime LocalTime OffsetDateTime OffsetTime ZonedDateTime)))
(defn- last-n
  [n]
  (fn
    ([] [])
    ([acc]
     (concat (repeat (- n (count acc)) nil) acc))
    ([acc x]
     (if (< (count acc) n)
       (conj acc x)
       (conj (subvec acc 1) x)))))

Relative difference between x1 an x2.

(defn change
  [x2 x1]
  (when (and x1 x2 (not (zero? x1)))
    (let [x2 (double x2)
          x1 (double x1)]
      (cond
        (every? neg? [x1 x2])     (change (- x1) (- x2))
        (and (neg? x1) (pos? x2)) (- (change x1 x2))
        (neg? x1)                 (- (change x2 (- x1)))
        :else                     (/ (- x2 x1) x1)))))

Transducer that samples a fixed number n of samples. https://en.wikipedia.org/wiki/Reservoir_sampling

(defn reservoir-sample
  [n]
  (fn
    ([] [[] 0])
    ([[reservoir c] x]
     (let [c   (inc c)
           idx (rand-int c)]
       (cond
         (<= c n)  [(conj reservoir x) c]
         (< idx n) [(assoc reservoir idx x) c]
         :else     [reservoir c])))
    ([[reservoir _]] reservoir)))

Given two functions: (fŷ input) and (fy input), returning the predicted and actual values of y respectively, calculates the mean absolute error of the estimate. https://en.wikipedia.org/wiki/Meanabsoluteerror

(defn mae
  [fy-hat fy]
  ((map (fn [x]
          (when x
            (math/abs (- (fy x) (fy-hat x))))))
   stats/mean))
(def ^:private trendline-function-families
  ;; http://mathworld.wolfram.com/LeastSquaresFitting.html
  [{:x-link-fn identity
    :y-link-fn identity
    :model     (fn [offset slope]
                 (fn [x]
                   (+ offset (* slope x))))
    :formula   (fn [offset slope]
                 [:+ offset [:* slope :x]])}
   ;; http://mathworld.wolfram.com/LeastSquaresFittingExponential.html
   {:x-link-fn identity
    :y-link-fn math/log
    :model     (fn [offset slope]
                 (fn [x]
                   (* (math/exp offset) (math/exp (* slope x)))))
    :formula   (fn [offset slope]
                 [:* (math/exp offset) [:exp [:* slope :x]]])}
   ;; http://mathworld.wolfram.com/LeastSquaresFittingLogarithmic.html
   {:x-link-fn math/log
    :y-link-fn identity
    :model     (fn [offset slope]
                 (fn [x]
                   (+ offset (* slope (math/log x)))))
    :formula   (fn [offset slope]
                 [:+ offset [:* slope [:log :x]]])}
   ;; http://mathworld.wolfram.com/LeastSquaresFittingPowerLaw.html
   {:x-link-fn math/log
    :y-link-fn math/log
    :model     (fn [offset slope]
                 (fn [x]
                   (* (math/exp offset) (math/pow x slope))))
    :formula   (fn [offset slope]
                 [:* (math/exp offset) [:pow :x slope]])}])
(def ^:private ^:const ^Long validation-set-size 20)

Fit curves from trendline-function-families and pick the one with the smallest RMSE. To keep the operation single pass we collect a small validation set as we go using reservoir sampling, and use it to calculate RMSE.

(defn- best-fit
  [fx fy]
  (redux/post-complete
   (fingerprinters/robust-fuse
    {:fits           (->> (for [{:keys [x-link-fn y-link-fn formula model]} trendline-function-families]
                            (redux/post-complete
                             (stats/simple-linear-regression (comp (stats/somef x-link-fn) fx)
                                                             (comp (stats/somef y-link-fn) fy))
                             (fn [fit]
                               (let [[offset slope] (some-> fit p/parameters)]
                                 (when (every? u/real-number? [offset slope])
                                   {:model   (model offset slope)
                                    :formula (formula offset slope)})))))
                          (apply redux/juxt))
     :validation-set ((keep (fn [row]
                              (let [x (fx row)
                                    y (fy row)]
                                (when (and x y)
                                  [x y]))))
                      (reservoir-sample validation-set-size))})
   (fn [{:keys [validation-set fits]}]
     (some->> fits
              (remove nil?)
              (map #(assoc % :mae (transduce identity
                                             (mae (comp (:model %) first) second)
                                             validation-set)))
              (filter (comp u/real-number? :mae))
              not-empty
              (apply min-key :mae)
              :formula))))
(defn- timeseries?
  [{:keys [numbers datetimes others]}]
  (and (pos? (count numbers))
       (= (count datetimes) 1)
       (empty? others)))

We downsize UNIX timestamps to lessen the chance of overflows and numerical instabilities.

(def ^Long ^:const ^:private ms-in-a-day (* 1000 60 60 24))
(defn- ms->day
  [dt]
  (/ dt ms-in-a-day))
(defn- about=
  [a b]
  (< 0.9 (/ a b) 1.1))
(def ^:private unit->duration
  {:minute  (/ 1 24 60)
   :hour    (/ 24)
   :day     1
   :week    7
   :month   30.5
   :quarter (* 30.4 3)
   :year    365.1})
(defn- valid-period?
  [from to unit]
  (when (and from to unit)
    ;; Make sure we work for both ascending and descending time series
    (let [[from to] (sort [from to])]
      (about= (- to from) (unit->duration unit)))))
(defn- infer-unit
  [from to]
  (m/find-first (partial valid-period? from to) (keys unit->duration)))
(defn- ->millis-from-epoch [t]
  (when t
    (condp instance? t
      Instant        (t/to-millis-from-epoch t)
      OffsetDateTime (t/to-millis-from-epoch t)
      ZonedDateTime  (t/to-millis-from-epoch t)
      LocalDate      (->millis-from-epoch (t/offset-date-time t (t/local-time 0) (t/zone-offset 0)))
      LocalDateTime  (->millis-from-epoch (t/offset-date-time t (t/zone-offset 0)))
      LocalTime      (->millis-from-epoch (t/offset-date-time (t/local-date "1970-01-01") t (t/zone-offset 0)))
      OffsetTime     (->millis-from-epoch (t/offset-date-time (t/local-date "1970-01-01") t (t/zone-offset t))))))
(defn- timeseries-insight
  [{:keys [numbers datetimes]}]
  (let [datetime   (first datetimes)
        x-position (:position datetime)
        xfn        #(some-> %
                            (nth x-position)
                            ;; at this point in the pipeline, dates are still stings
                            fingerprinters/->temporal
                            ->millis-from-epoch
                            ms->day)]
    (fingerprinters/with-error-handling
      (apply redux/juxt
             (for [number-col numbers]
               (redux/post-complete
                (let [y-position (:position number-col)
                      yfn        #(nth % y-position)]
                  ((filter (comp u/real-number? yfn))
                   (redux/juxt ((map yfn) (last-n 2))
                               ((map xfn) (last-n 2))
                               (stats/simple-linear-regression xfn yfn)
                               (best-fit xfn yfn))))
                (fn [[[y-previous y-current] [x-previous x-current] fit best-fit-equation]]
                  (let [[offset slope] (some-> fit p/parameters)
                        unit         (let [unit (some-> datetime :unit mbql.u/normalize-token)]
                                       (if (or (nil? unit)
                                               (= unit :default))
                                         (infer-unit x-previous x-current)
                                         unit))
                        show-change? (valid-period? x-previous x-current unit)]
                    (fingerprinters/robust-map
                     :last-value     y-current
                     :previous-value (when show-change?
                                       y-previous)
                     :last-change    (when show-change?
                                       (change y-current y-previous))
                     :slope          slope
                     :offset         offset
                     :best-fit       best-fit-equation
                     :col            (:name number-col)
                     :unit           unit))))))
      (format "Error generating timeseries insight keyed by: %s"
              (sync-util/name-for-logging (mi/instance Field datetime))))))

Based on the shape of returned data construct a transducer to statistically analyize data.

(defn insights
  [cols]
  (let [cols-by-type (->> cols
                          (map-indexed (fn [idx col]
                                         (assoc col :position idx)))
                          (group-by (fn [{base-type      :base_type
                                          effective-type :effective_type
                                          semantic-type  :semantic_type
                                          unit           :unit}]
                                      (cond
                                        (isa? semantic-type :Relation/*)                    :others
                                        (= unit :year)                                      :datetimes
                                        (u.date/extract-units unit)                         :numbers
                                        (isa? (or effective-type base-type) :type/Temporal) :datetimes
                                        (isa? base-type :type/Number)                       :numbers
                                        :else                                               :others))))]
    (cond
      (timeseries? cols-by-type) (timeseries-insight cols-by-type)
      :else                      (fingerprinters/constant-fingerprinter nil))))
 

Analysis similar to what we do as part of the Sync process, but aimed at analyzing and introspecting query results. The current focus of this namespace is around column metadata from the results of a query. Going forward this is likely to extend beyond just metadata about columns but also about the query results as a whole and over time.

(ns metabase.sync.analyze.query-results
  (:require
   [metabase.lib.schema.expression.temporal
    :as lib.schema.expression.temporal]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.predicates :as mbql.preds]
   [metabase.mbql.schema :as mbql.s]
   [metabase.sync.analyze.classifiers.name :as classifiers.name]
   [metabase.sync.analyze.fingerprint.fingerprinters :as fingerprinters]
   [metabase.sync.analyze.fingerprint.insights :as insights]
   [metabase.sync.interface :as i]
   [metabase.util :as u]
   [metabase.util.i18n :as i18n]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.registry :as mr]
   [metabase.util.malli.schema :as ms]
   [redux.core :as redux]))

Schema for a valid datetime unit string like "default" or "minute-of-hour".

(def ^:private DateTimeUnitKeywordOrString
  [:and
   ms/KeywordOrString
   [:fn
    {:error/message "Valid field datetime unit keyword or string"}
    #(mbql.preds/DateTimeUnit? (keyword %))]])
(mr/def ::MaybeUnnormalizedReference
  [:fn
   {:error/message "Field or aggregation reference as it comes in to the API"}
   (fn [x]
     (mr/validate mbql.s/Reference (mbql.normalize/normalize-tokens x)))])
(mr/def ::ResultColumnMetadata
  [:map
   [:name         :string]
   [:display_name :string]
   [:base_type    ms/FieldTypeKeywordOrString]
   [:description        {:optional true} [:maybe :string]]
   [:semantic_type      {:optional true} [:maybe ms/FieldSemanticOrRelationTypeKeywordOrString]]
   [:unit               {:optional true} [:maybe DateTimeUnitKeywordOrString]]
   [:fingerprint        {:optional true} [:maybe i/Fingerprint]]
   [:id                 {:optional true} [:maybe ::lib.schema.id/field]]
   ;; only optional because it's not present right away, but it should be present at the end.
   [:field_ref          {:optional true} [:ref ::MaybeUnnormalizedReference]]
   ;; the timezone in which the column was converted to using `:convert-timezone` expression
   [:converted_timezone {:optional true} ::lib.schema.expression.temporal/timezone-id]])

Result metadata for a single column

(def ^:private ResultColumnMetadata
  ;; this schema is used for both the API and the QP, so it should handle either normalized or unnormalized values. In
  ;; the QP, everything will be normalized.
  [:ref ::ResultColumnMetadata])
(mr/def ::ResultsMetadata
  (mu/with-api-error-message
   [:maybe [:sequential ResultColumnMetadata]]
   (i18n/deferred-tru "value must be an array of valid results column metadata maps.")))

Schema for valid values of the result_metadata column.

(def ResultsMetadata
  [:ref ::ResultsMetadata])
(mu/defn ^:private maybe-infer-semantic-type :- ResultColumnMetadata
  "Infer the semantic type and add it to the result metadata. If the inferred semantic type is nil, don't override the
  semantic type with a nil semantic type"
  [col]
  (update
   col
   :semantic_type
   (fn [original-value]
     ;; If we already know the semantic type, becouse it is stored, don't classify again, but try to refine semantic
     ;; type set upstream for aggregation cols (which come back as :type/Number).
     (case original-value
       (nil :type/Number) (classifiers.name/infer-semantic-type col)
       original-value))))
(mu/defn ^:private col->ResultColumnMetadata :- ResultColumnMetadata
  "Make sure a `column` as it comes back from a driver's initial results metadata matches the schema for valid results
  column metadata, adding placeholder values and removing nil keys."
  [column]
  ;; HACK - not sure why we don't have display_name yet in some cases
  (merge
   {:base_type    :type/*
    :display_name (:name column)}
   (u/select-non-nil-keys
    column
    [:name :display_name :description :base_type :semantic_type :unit :fingerprint :id :field_ref])))

A reducing function that calculates what is ultimately returned as [:data :results_metadata] in userland QP results. metadata is the usual QP results metadata e.g. as received by an rff.

(defn insights-rf
  {:arglists '([metadata])}
  [{:keys [cols]}]
  (let [cols (for [col cols]
               (try
                 (maybe-infer-semantic-type (col->ResultColumnMetadata col))
                 (catch Throwable e
                   (log/errorf e "Error generating insights for column: %s" col)
                   col)))]
    (redux/post-complete
     (redux/juxt
      (apply fingerprinters/col-wise (for [{:keys [fingerprint], :as metadata} cols]
                                      (if-not fingerprint
                                        (fingerprinters/fingerprinter metadata)
                                        (fingerprinters/constant-fingerprinter fingerprint))))
      (insights/insights cols))
     (fn [[fingerprints insights]]
       {:metadata (map (fn [fingerprint metadata]
                         (if (instance? Throwable fingerprint)
                           metadata
                           (assoc metadata :fingerprint fingerprint)))
                       fingerprints
                       cols)
        :insights (when-not (instance? Throwable insights)
                    insights)}))))
 

Namespace with helpers for concurrent tasks in sync. Intended for quick, one-off tasks like re-syncing a table, fingerprinting a field, etc.

(ns metabase.sync.concurrent
  (:import
   (java.util.concurrent Callable Executors ExecutorService Future ThreadFactory)))
(set! *warn-on-reflection* true)
(defonce ^:private thread-factory
  (reify ThreadFactory
    (newThread [_ r]
      (doto (Thread. r)
        (.setName "table sync worker")
        (.setDaemon true)))))
(defonce ^:private executor
  (delay (Executors/newFixedThreadPool 1 ^ThreadFactory thread-factory)))

Submit a task to the single thread executor. This will attempt to serialize repeated requests to sync tables. It obviously cannot work across multiple instances.

(defn submit-task
  ^Future [^Callable f]
  (let [task (bound-fn [] (f))]
    (.submit ^ExecutorService @executor ^Callable task)))
 

Fetch metadata functions fetch 'snapshots' of the schema for a data warehouse database, including information about tables, schemas, and fields, and their types. For example, with SQL databases, these functions use the JDBC DatabaseMetaData to get this information.

(ns metabase.sync.fetch-metadata
  (:require
   [metabase.driver :as driver]
   [metabase.driver.sql-jdbc.sync :as sql-jdbc.sync]
   [metabase.driver.util :as driver.u]
   [metabase.sync.interface :as i]
   [metabase.util.malli :as mu]))
(mu/defn db-metadata :- i/DatabaseMetadata
  "Get basic Metadata about a `database` and its Tables. Doesn't include information about the Fields."
  [database :- i/DatabaseInstance]
  (driver/describe-database (driver.u/database->driver database) database))
(mu/defn table-metadata :- i/TableMetadata
  "Get more detailed information about a `table` belonging to `database`. Includes information about the Fields."
  [database :- i/DatabaseInstance
   table    :- i/TableInstance]
  (driver/describe-table (driver.u/database->driver database) database table))
(mu/defn fk-metadata :- i/FKMetadata
  "Get information about the foreign keys belonging to `table`."
  [database :- i/DatabaseInstance
   table    :- i/TableInstance]
  (let [driver (driver.u/database->driver database)]
    (when (driver/database-supports? driver :foreign-keys database)
      (driver/describe-table-fks driver database table))))
(mu/defn nfc-metadata :- [:maybe [:set i/TableMetadataField]]
  "Get information about the nested field column fields within `table`."
  [database :- i/DatabaseInstance
   table    :- i/TableInstance]
  (let [driver (driver.u/database->driver database)]
    (when (driver/database-supports? driver :nested-field-columns database)
      (sql-jdbc.sync/describe-nested-field-columns driver database table))))
(mu/defn index-metadata :- [:maybe i/TableIndexMetadata]
  "Get information about the indexes belonging to `table`."
  [database :- i/DatabaseInstance
   table    :- i/TableInstance]
  (driver/describe-table-indexes (driver.u/database->driver database) database table))
 

Logic for updating FieldValues for fields in a database.

(ns metabase.sync.field-values
  (:require
   [java-time.api :as t]
   [metabase.db :as mdb]
   [metabase.driver.sql.query-processor :as sql.qp]
   [metabase.models.field :refer [Field]]
   [metabase.models.field-values :as field-values :refer [FieldValues]]
   [metabase.sync.interface :as i]
   [metabase.sync.util :as sync-util]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [toucan2.core :as t2]))
(mu/defn ^:private clear-field-values-for-field!
  [field :- i/FieldInstance]
  (when (t2/exists? FieldValues :field_id (u/the-id field))
    (log/debug (format "Based on cardinality and/or type information, %s should no longer have field values.\n"
                       (sync-util/name-for-logging field))
               "Deleting FieldValues...")
    (field-values/clear-field-values-for-field! field)
    ::field-values/fv-deleted))
(mu/defn ^:private update-field-values-for-field!
  [field :- i/FieldInstance]
  (log/debug (u/format-color 'green "Looking into updating FieldValues for %s" (sync-util/name-for-logging field)))
  (let [field-values (t2/select-one FieldValues :field_id (u/the-id field) :type :full)]
    (if (field-values/inactive? field-values)
      (log/debugf "Field %s has not been used since %s. Skipping..."
                  (sync-util/name-for-logging field) (t/format "yyyy-MM-dd" (t/local-date-time (:last_used_at field-values))))
      (field-values/create-or-update-full-field-values! field))))
(defn- update-field-value-stats-count [counts-map result]
  (if (instance? Exception result)
    (update counts-map :errors inc)
    (case result
      ::field-values/fv-created
      (update counts-map :created inc)
      ::field-values/fv-updated
      (update counts-map :updated inc)
      ::field-values/fv-deleted
      (update counts-map :deleted inc)
      counts-map)))
(defn- table->fields-to-scan
  [table]
  (t2/select Field :table_id (u/the-id table), :active true, :visibility_type "normal"))

Update the FieldValues for all Fields (as needed) for table.

(mu/defn update-field-values-for-table!
  [table :- i/TableInstance]
  (reduce (fn [fv-change-counts field]
            (let [result (sync-util/with-error-handling (format "Error updating field values for %s" (sync-util/name-for-logging field))
                           (if (field-values/field-should-have-field-values? field)
                             (update-field-values-for-field! field)
                             (clear-field-values-for-field! field)))]
              (update-field-value-stats-count fv-change-counts result)))
          {:errors 0, :created 0, :updated 0, :deleted 0}
          (table->fields-to-scan table)))
(mu/defn ^:private update-field-values-for-database!
  [_database :- i/DatabaseInstance
   tables    :- [:maybe [:sequential i/TableInstance]]]
  (apply merge-with + (map update-field-values-for-table! tables)))
(defn- update-field-values-summary [{:keys [created updated deleted errors]}]
  (format "Updated %d field value sets, created %d, deleted %d with %d errors"
       updated created deleted errors))
(defn- delete-expired-advanced-field-values-summary [{:keys [deleted]}]
  (format "Deleted %d expired advanced fieldvalues" deleted))
(defn- delete-expired-advanced-field-values-for-field!
  [field]
  (sync-util/with-error-handling (format "Error deleting expired advanced field values for %s" (sync-util/name-for-logging field))
    (let [conditions [:field_id   (:id field)
                      :type       [:in field-values/advanced-field-values-types]
                      :created_at [:< (sql.qp/add-interval-honeysql-form
                                       (mdb/db-type)
                                       :%now
                                       (- (t/as field-values/advanced-field-values-max-age :days))
                                       :day)]]
          rows-count (apply t2/count FieldValues conditions)]
      (apply t2/delete! FieldValues conditions)
      rows-count)))

Delete all expired advanced FieldValues for a table and returns the number of deleted rows. For more info about advanced FieldValues, check the docs in [[metabase.models.field-values/field-values-types]]

(mu/defn delete-expired-advanced-field-values-for-table!
  [table :- i/TableInstance]
  (->> (table->fields-to-scan table)
       (map delete-expired-advanced-field-values-for-field!)
       (reduce +)))
(mu/defn ^:private delete-expired-advanced-field-values-for-database!
  [_database :- i/DatabaseInstance
   tables :- [:maybe [:sequential i/TableInstance]]]
  {:deleted (transduce (comp (map delete-expired-advanced-field-values-for-table!)
                             (map (fn [result]
                                    (if (instance? Throwable result)
                                      (throw result)
                                      result))))
                       +
                       0
                       tables)})
(defn- make-sync-field-values-steps
  [tables]
  [(sync-util/create-sync-step "delete-expired-advanced-field-values"
                               #(delete-expired-advanced-field-values-for-database! % tables)
                               delete-expired-advanced-field-values-summary)
   (sync-util/create-sync-step "update-field-values"
                               #(update-field-values-for-database! % tables)
                               update-field-values-summary)])

Update the advanced FieldValues (distinct values for categories and certain other fields that are shown in widgets like filters) for the Tables in database (as needed).

(mu/defn update-field-values!
  [database :- i/DatabaseInstance]
  (sync-util/sync-operation :cache-field-values database (format "Cache field values in %s"
                                                                 (sync-util/name-for-logging database))
    (let [tables (sync-util/db->sync-tables database)]
     (sync-util/run-sync-operation "field values scanning" database (make-sync-field-values-steps tables)))))
 

Schemas and constants used by the sync code.

(ns metabase.sync.interface
  (:require
   [clojure.string :as str]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.util.malli.registry :as mr]
   [metabase.util.malli.schema :as ms]))
(mr/def ::DatabaseMetadataTable
  [:map
   [:name           ::lib.schema.common/non-blank-string]
   [:schema         [:maybe ::lib.schema.common/non-blank-string]]
   [:require-filter {:optional true} :boolean]
   ;; `:description` in this case should be a column/remark on the Table, if there is one.
   [:description    {:optional true} [:maybe :string]]])

Schema for the expected output of describe-database for a Table.

(def DatabaseMetadataTable
  [:ref ::DatabaseMetadataTable])
(mr/def ::DatabaseMetadata
  [:map
   [:tables [:set DatabaseMetadataTable]]
   [:version {:optional true} [:maybe ::lib.schema.common/non-blank-string]]])

Schema for the expected output of describe-database.

(def DatabaseMetadata
  [:ref ::DatabaseMetadata])
(mr/def ::TableMetadataField
  [:map
   [:name              ::lib.schema.common/non-blank-string]
   [:database-type     [:maybe ::lib.schema.common/non-blank-string]] ; blank if the Field is all NULL & untyped, i.e. in Mongo
   [:base-type         ::lib.schema.common/base-type]
   [:database-position ::lib.schema.common/int-greater-than-or-equal-to-zero]
   [:position                   {:optional true} ::lib.schema.common/int-greater-than-or-equal-to-zero]
   [:semantic-type              {:optional true} [:maybe ::lib.schema.common/semantic-or-relation-type]]
   [:effective-type             {:optional true} [:maybe ::lib.schema.common/base-type]]
   [:coercion-strategy          {:optional true} [:maybe ms/CoercionStrategy]]
   [:field-comment              {:optional true} [:maybe ::lib.schema.common/non-blank-string]]
   [:pk?                        {:optional true} :boolean]
   [:nested-fields              {:optional true} [:set [:ref ::TableMetadataField]]]
   [:json-unfolding             {:optional true} :boolean]
   [:nfc-path                   {:optional true} [:any]]
   [:custom                     {:optional true} :map]
   [:database-is-auto-increment {:optional true} :boolean]
   ;; nullable for databases that don't support field partition
   [:database-partitioned       {:optional true} [:maybe :boolean]]
   [:database-required          {:optional true} :boolean]])

Schema for a given Field as provided in [[metabase.driver/describe-table]].

(def TableMetadataField
  [:ref ::TableMetadataField])
(mr/def ::TableIndexMetadata
  [:set
   [:and
    [:map
     [:type [:enum :normal-column-index :nested-column-index]]]
    [:multi {:dispatch :type}
     [:normal-column-index [:map [:value ::lib.schema.common/non-blank-string]]]
     [:nested-column-index [:map [:value [:sequential ::lib.schema.common/non-blank-string]]]]]]])

Schema for a given Table as provided in [[metabase.driver/describe-table-indexes]].

(def TableIndexMetadata
  [:ref ::TableIndexMetadata])
(mr/def ::TableMetadata
  [:map
   [:name                         ::lib.schema.common/non-blank-string]
   [:schema                       [:maybe ::lib.schema.common/non-blank-string]]
   [:fields                       [:set TableMetadataField]]
   [:description {:optional true} [:maybe :string]]])

Schema for the expected output of [[metabase.driver/describe-table]].

(def TableMetadata
  [:ref ::TableMetadata])

Schema for the expected output of [[metabase.driver.sql-jdbc.sync/describe-nested-field-columns]].

not actually used; leaving here for now because it serves as documentation

(comment
  (def NestedFCMetadata
    [:maybe [:set TableMetadataField]]))
(mr/def ::FKMetadataEntry
  [:map
   [:fk-column-name   ::lib.schema.common/non-blank-string]
   [:dest-table       [:map
                       [:name   ::lib.schema.common/non-blank-string]
                       [:schema [:maybe ::lib.schema.common/non-blank-string]]]]
   [:dest-column-name ::lib.schema.common/non-blank-string]])

Schema for an individual entry in FKMetadata.

(def FKMetadataEntry
  [:ref ::FKMetadataEntry])
(mr/def ::FKMetadata
  [:maybe [:set FKMetadataEntry]])

Schema for the expected output of describe-table-fks.

(def FKMetadata
  [:ref ::FKMetadata])

These schemas are provided purely as conveniences since adding :import statements to get the corresponding classes from the model namespaces also requires a :require, which clj-refactor seems more than happy to strip out from the ns declaration when running cljr-clean-ns. Plus as a bonus in the future we could add additional validations to these, e.g. requiring that a Field have a base_type

(mr/def ::no-kebab-case-keys
  [:fn
   {:error/message "Map should not contain any kebab-case keys"}
   (fn [m]
     (every? (fn [k]
               (not (str/includes? k "-")))
             (keys m)))])
(mr/def ::DatabaseInstance
  [:and
   (ms/InstanceOf :model/Database)
   ::no-kebab-case-keys])

Schema for a valid instance of a Metabase Database.

(def DatabaseInstance
  [:ref ::DatabaseInstance])
(mr/def ::TableInstance
  [:and
   (ms/InstanceOf :model/Table)
   ::no-kebab-case-keys])

Schema for a valid instance of a Metabase Table.

(def TableInstance
  [:ref ::TableInstance])
(mr/def ::FieldInstance
  [:and
   [:and
    (ms/InstanceOf :model/Field)
    ::no-kebab-case-keys]])

Schema for a valid instance of a Metabase Field.

(def FieldInstance
  [:ref ::FieldInstance])

+----------------------------------------------------------------------------------------------------------------+ | SAMPLING & FINGERPRINTS | +----------------------------------------------------------------------------------------------------------------+

(mr/def ::Percent
  [:and
   number?
   [:fn
    {:error/message "Valid percentage between (inclusive) 0 and 1."}
    #(<= 0 % 1)]])

Schema for something represting a percentage. A floating-point value between (inclusive) 0 and 1.

(def Percent
  [:ref ::Percent])
(mr/def ::GlobalFingerprint
  [:map
   [:distinct-count {:optional true} :int]
   [:nil%           {:optional true} [:maybe Percent]]])

Fingerprint values that Fields of all types should have.

(def GlobalFingerprint
  [:ref ::GlobalFingerprint])
(mr/def ::NumberFingerprint
  [:map
   [:min {:optional true} [:maybe number?]]
   [:max {:optional true} [:maybe number?]]
   [:avg {:optional true} [:maybe number?]]
   [:q1  {:optional true} [:maybe number?]]
   [:q3  {:optional true} [:maybe number?]]
   [:sd  {:optional true} [:maybe number?]]])

Schema for fingerprint information for Fields deriving from :type/Number.

(def NumberFingerprint
  [:ref ::NumberFingerprint])
(mr/def ::TextFingerprint
  [:map
   [:percent-json   {:optional true} [:maybe Percent]]
   [:percent-url    {:optional true} [:maybe Percent]]
   [:percent-email  {:optional true} [:maybe Percent]]
   [:percent-state  {:optional true} [:maybe Percent]]
   [:average-length {:optional true} [:maybe number?]]])

Schema for fingerprint information for Fields deriving from :type/Text.

(def TextFingerprint
  [:ref ::TextFingerprint])
(mr/def ::TemporalFingerprint
  [:map
   [:earliest {:optional true} [:maybe :string]]
   [:latest   {:optional true} [:maybe :string]]])

Schema for fingerprint information for Fields deriving from :type/Temporal.

(def TemporalFingerprint
  [:ref ::TemporalFingerprint])
(mr/def ::TypeSpecificFingerprint
  [:and
   [:map
    [:type/Number   {:optional true} NumberFingerprint]
    [:type/Text     {:optional true} TextFingerprint]
    ;; temporal fingerprints are keyed by `:type/DateTime` for historical reasons. `DateTime` used to be the parent of
    ;; all temporal MB types.
    [:type/DateTime {:optional true} TemporalFingerprint]]
   [:fn
    {:error/message "Type-specific fingerprint with exactly one key"}
    (fn [m]
      (= 1 (count (keys m))))]])

Schema for type-specific fingerprint information.

(def TypeSpecificFingerprint
  [:ref ::TypeSpecificFingerprint])
(mr/def ::Fingerprint
  [:map
   [:global       {:optional true} GlobalFingerprint]
   [:type         {:optional true} TypeSpecificFingerprint]
   [:experimental {:optional true} :map]])

Schema for a Field 'fingerprint' generated as part of the analysis stage. Used to power the 'classification' sub-stage of analysis. Stored as the fingerprint column of Field.

(def Fingerprint
  [:ref ::Fingerprint])

+----------------------------------------------------------------------------------------------------------------+ | FINGERPRINT VERSIONING | +----------------------------------------------------------------------------------------------------------------+

Occasionally we want to update the schema of our Field fingerprints and add new logic to populate the additional keys. However, by default, analysis (which includes fingerprinting) only runs on NEW Fields, meaning EXISTING Fields won't get new fingerprints with the updated info.

To work around this, we can use a versioning system. Fields whose Fingerprint's version is lower than the current version should get updated during the next sync/analysis regardless of whether they are or are not new Fields. However, this could be quite inefficient: if we add a new fingerprint field for :type/Number Fields, why should we re-fingerprint :type/Text Fields? Ideally, we'd only re-fingerprint the numeric Fields.

Thus, our implementation below. Each new fingerprint version lists a set of types that should be upgraded to it. Our fingerprinting logic will calculate whether a fingerprint needs to be recalculated based on its version and the changes that have been made in subsequent versions. Only the Fields that would benefit from the new Fingerprint info need be re-fingerprinted.

Thus, if Fingerprint v2 contains some new info for numeric Fields, only Fields that derive from :type/Number need be upgraded to v2. Textual Fields with a v1 fingerprint can stay at v1 for the time being. Later, if we introduce a v3 that includes new "global" fingerprint info, both the v2-fingerprinted numeric Fields and the v1-fingerprinted textual Fields can be upgraded to v3.

Map of fingerprint version to the set of Field base types that need to be upgraded to this version the next time we do analysis. The highest-numbered entry is considered the latest version of fingerprints.

(def ^:dynamic *fingerprint-version->types-that-should-be-re-fingerprinted*
  {1 #{:type/*}
   2 #{:type/Number}
   3 #{:type/DateTime}
   4 #{:type/*}
   5 #{:type/Text}})

The newest (highest-numbered) version of our Field fingerprints.

(def ^:dynamic ^Long *latest-fingerprint-version*
  (apply max (keys *fingerprint-version->types-that-should-be-re-fingerprinted*)))
 

Types and defaults for the syncing schedules used for the scheduled sync tasks. Has defaults for the two schedules maps and some helper methods for turning those into appropriately named cron strings as stored in the metabase_database table.

(ns metabase.sync.schedules
  (:require
   [metabase.util.cron :as u.cron]
   [metabase.util.i18n :refer [deferred-tru]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.registry :as mr]))

Schema with values for a DB's schedules that can be put directly into the DB.

(def ^:private CronSchedulesMap
  [:map
   [:metadata_sync_schedule      {:optional true} u.cron/CronScheduleString]
   [:cache_field_values_schedule {:optional true} u.cron/CronScheduleString]])
(mr/def ::ExpandedSchedulesMap
  (mu/with-api-error-message
   [:map
    {:error/message "Map of expanded schedule maps"}
    [:cache_field_values {:optional true} u.cron/ScheduleMap]
    [:metadata_sync      {:optional true} u.cron/ScheduleMap]]
   (deferred-tru "value must be a valid map of schedule maps for a DB.")))

Schema for the :schedules key we add to the response containing 'expanded' versions of the CRON schedules. This same key is used in reverse to update the schedules.

(def ExpandedSchedulesMap
  [:ref ::ExpandedSchedulesMap])
(mu/defn schedule-map->cron-strings :- CronSchedulesMap
  "Convert a map of `:schedules` as passed in by the frontend to a map of cron strings with the approriate keys for
   Database. This map can then be merged directly inserted into the DB, or merged with a map of other columns to
   insert/update."
  [{:keys [metadata_sync cache_field_values]} :- ExpandedSchedulesMap]
  (cond-> {}
    metadata_sync      (assoc :metadata_sync_schedule      (u.cron/schedule-map->cron-string metadata_sync))
    cache_field_values (assoc :cache_field_values_schedule (u.cron/schedule-map->cron-string cache_field_values))))

Schedule map for once an hour at a random minute of the hour.

(defn randomly-once-an-hour
  []
  ;; prevent zeros and 50s which would appear as non-random choices
  (let [choices (into [] (remove #{0 50}) (range 60))]
    {:schedule_minute (rand-nth choices)
     :schedule_type   "hourly"}))

Schedule map for once a day at a random hour of the day.

(defn randomly-once-a-day
  []
  ;; prevent zeros which would appear as non-random
  {:schedule_hour  (inc (rand-int 23))
   :schedule_type  "daily"})

Default schedule maps for caching field values and sync. Defaults to :cache_field_values randomly once a day and :metadata_sync randomly once an hour.

(defn default-randomized-schedule
  []
  {:cache_field_values (randomly-once-a-day)
   :metadata_sync      (randomly-once-an-hour)})

Default :cache_field_values_schedules (two as application and db have different defaults).

two because application and db each have defaults

(def default-cache-field-values-schedule-cron-strings
  #{"0 0 0 * * ? *" "0 50 0 * * ? *"})

Default :metadata_sync_schedules (two as application and db have different defaults).

(def default-metadata-sync-schedule-cron-strings
  #{"0 0 * * * ? *" "0 50 * * * ? *"})

Adds sync schedule defaults to a map of schedule-maps.

(defn scheduling
  [{:keys [cache_field_values metadata_sync] :as _schedules}]
  {:cache_field_values (or cache_field_values (randomly-once-a-day))
   :metadata_sync      (or metadata_sync (randomly-once-an-hour))})
 

Logic responsible for syncing the metadata for an entire database. Delegates to different subtasks:

  1. Sync tables (metabase.sync.sync-metadata.tables)
  2. Sync fields (metabase.sync.sync-metadata.fields)
  3. Sync FKs (metabase.sync.sync-metadata.fks)
  4. Sync Metabase Metadata table (metabase.sync.sync-metadata.metabase-metadata)
(ns metabase.sync.sync-metadata
  (:require
   [metabase.models.table :as table]
   [metabase.sync.fetch-metadata :as fetch-metadata]
   [metabase.sync.interface :as i]
   [metabase.sync.sync-metadata.dbms-version :as sync-dbms-ver]
   [metabase.sync.sync-metadata.fields :as sync-fields]
   [metabase.sync.sync-metadata.fks :as sync-fks]
   [metabase.sync.sync-metadata.indexes :as sync-indexes]
   [metabase.sync.sync-metadata.metabase-metadata :as metabase-metadata]
   [metabase.sync.sync-metadata.sync-table-privileges :as sync-table-privileges]
   [metabase.sync.sync-metadata.sync-timezone :as sync-tz]
   [metabase.sync.sync-metadata.tables :as sync-tables]
   [metabase.sync.util :as sync-util]
   [metabase.util :as u]
   [metabase.util.malli :as mu]))
(defn- sync-dbms-version-summary [{:keys [version] :as _step-info}]
  (if version
    (format "Found DBMS version %s" version)
    "Could not determine DBMS version"))
(defn- sync-fields-summary [{:keys [total-fields updated-fields] :as _step-info}]
  (format "Total number of fields sync''d %d, number of fields updated %d"
          total-fields updated-fields))
(defn- sync-tables-summary [{:keys [total-tables updated-tables] :as _step-info}]
  (format "Total number of tables sync''d %d, number of tables updated %d"
          total-tables updated-tables))
(defn- sync-timezone-summary [{:keys [timezone-id]}]
  (format "Found timezone id %s" timezone-id))
(defn- sync-fks-summary [{:keys [total-fks updated-fks total-failed]}]
  (format "Total number of foreign keys sync''d %d, %d updated and %d tables failed to update"
          total-fks updated-fks total-failed))
(defn- sync-indexes-summary [{:keys [total-indexes added-indexes removed-indexes]}]
  (format "Total number of indexes sync''d %d, %d added and %d removed"
          total-indexes added-indexes removed-indexes))
(defn- make-sync-steps [db-metadata]
  [(sync-util/create-sync-step "sync-dbms-version" sync-dbms-ver/sync-dbms-version! sync-dbms-version-summary)
   (sync-util/create-sync-step "sync-timezone" sync-tz/sync-timezone! sync-timezone-summary)
   ;; Make sure the relevant table models are up-to-date
   (sync-util/create-sync-step "sync-tables" #(sync-tables/sync-tables-and-database! % db-metadata) sync-tables-summary)
   ;; Now for each table, sync the fields
   (sync-util/create-sync-step "sync-fields" sync-fields/sync-fields! sync-fields-summary)
   ;; Now for each table, sync the FKS. This has to be done after syncing all the fields to make sure target fields exist
   (sync-util/create-sync-step "sync-fks" sync-fks/sync-fks! sync-fks-summary)
   ;; Sync index info if the database supports it
   (sync-util/create-sync-step "sync-indexes" sync-indexes/maybe-sync-indexes! sync-indexes-summary)
   ;; finally, sync the metadata metadata table if it exists.
   (sync-util/create-sync-step "sync-metabase-metadata" #(metabase-metadata/sync-metabase-metadata! % db-metadata))
   ;; Now sync the table privileges
   (sync-util/create-sync-step "sync-table-privileges" sync-table-privileges/sync-table-privileges!)])

Sync the metadata for a Metabase database. This makes sure child Table & Field objects are synchronized.

(mu/defn sync-db-metadata!
  [database :- i/DatabaseInstance]
  (let [db-metadata (fetch-metadata/db-metadata database)]
    (sync-util/sync-operation :sync-metadata database (format "Sync metadata for %s" (sync-util/name-for-logging database))
      (u/prog1 (sync-util/run-sync-operation "sync" database (make-sync-steps db-metadata))
        (if (some sync-util/abandon-sync? (map second (:steps <>)))
          (sync-util/set-initial-database-sync-aborted! database)
          (sync-util/set-initial-database-sync-complete! database))))))

Sync the metadata for an individual table -- make sure Fields and FKs are up-to-date.

(mu/defn sync-table-metadata!
  [table :- i/TableInstance]
  (let [database (table/database table)]
    (sync-fields/sync-fields-for-table! database table)
    (sync-fks/sync-fks-for-table! database table)
    (sync-indexes/maybe-sync-indexes-for-table! database table)))
 
(ns metabase.sync.sync-metadata.dbms-version
  (:require
   [metabase.driver :as driver]
   [metabase.driver.util :as driver.u]
   [metabase.models.database :refer [Database]]
   [metabase.sync.interface :as i]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

Schema for the expected output of [[sync-dbms-version!]].

(def DBMSVersion
  [:map
   [:version ms/NonBlankString]])
(mu/defn sync-dbms-version! :- [:maybe DBMSVersion]
  "Get the DBMS version as provided by the driver and save it in the Database."
  [database :- i/DatabaseInstance]
  (let [driver  (driver.u/database->driver database)
        version (driver/dbms-version driver database)]
    (when (not= version (:dbms_version database))
      (t2/update! Database (:id database) {:dbms_version version}))
    version))
 

Logic for updating Metabase Field models from metadata fetched from a physical DB.

The basic idea here is to look at the metadata we get from calling describe-table on a connected database, then construct an identical set of metadata from what we have about that Table in the Metabase DB. Then we iterate over both sets of Metadata and perform whatever steps are needed to make sure the things in the DB match the things that came back from describe-table. These steps are broken out into three main parts:

  • Fetch Metadata - logic is in metabase.sync.sync-metadata.fields.fetch-metadata. Construct a map of metadata from the Metabase application database that matches the form of DB metadata about Fields in a Table. This metadata is used to next two steps to determine what sync operations need to be performed by comparing the differences in the two sets of Metadata.

  • Sync Field instances -- logic is in metabase.sync.sync-metadata.fields.sync-instances. Make sure the Field instances in the Metabase application database match up with those in the DB metadata, creating new Fields as needed, and marking existing ones as active or inactive as appropriate.

  • Update instance metadata -- logic is in metabase.sync.sync-metadata.fields.sync-metadata. Update metadata properties of Field instances in the application database as needed -- this includes the base type, database type, semantic type, and comment/remark (description) properties. This primarily affects Fields that were not newly created; newly created Fields are given appropriate metadata when first synced (by sync-instances).

A note on terminology used in metabase.sync.sync-metadata.fields.* namespaces:

  • db-metadata is a set of field-metadata maps coming back from the DB (e.g. from something like JDBC DatabaseMetaData) describing the columns (or equivalent) currently present in the table (or equivalent) that we're syncing.

  • field-metadata is a map of information describing a single columnn currently present in the table being synced

  • our-metadata is a set of maps of Field metadata reconstructed from the Metabase application database.

  • metabase-field is a single map of Field metadata reconstructed from the Metabase application database; there is a 1:1 correspondance between this metadata and a row in the Field table. Unlike field-metadata, these entries always have an :id associated with them (because they are present in the Metabase application DB).

Other notes:

  • In general the methods in these namespaces return the number of rows updated; these numbers are summed and used for logging purposes by higher-level sync logic.
(ns metabase.sync.sync-metadata.fields
  (:require
   [metabase.models.table :as table]
   [metabase.sync.interface :as i]
   [metabase.sync.sync-metadata.fields.fetch-metadata :as fetch-metadata]
   [metabase.sync.sync-metadata.fields.sync-instances :as sync-instances]
   [metabase.sync.sync-metadata.fields.sync-metadata :as sync-metadata]
   [metabase.sync.util :as sync-util]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]))

+----------------------------------------------------------------------------------------------------------------+ | PUTTING IT ALL TOGETHER | +----------------------------------------------------------------------------------------------------------------+

(mu/defn ^:private sync-and-update! :- ms/IntGreaterThanOrEqualToZero
  "Sync Field instances (i.e., rows in the Field table in the Metabase application DB) for a Table, and update metadata
  properties (e.g. base type and comment/remark) as needed. Returns number of Fields synced."
  [table       :- i/TableInstance
   db-metadata :- [:set i/TableMetadataField]]
  (+ (sync-instances/sync-instances! table db-metadata (fetch-metadata/our-metadata table))
     ;; Now that tables are synced and fields created as needed make sure field properties are in sync.
     ;; Re-fetch our metadata because there might be somethings that have changed after calling
     ;; `sync-instances`
     (sync-metadata/update-metadata! table db-metadata (fetch-metadata/our-metadata table))))

Sync the Fields in the Metabase application database for a specific table.

(mu/defn sync-fields-for-table!
  ([table :- i/TableInstance]
   (sync-fields-for-table! (table/database table) table))
  ([database :- i/DatabaseInstance
    table    :- i/TableInstance]
   (sync-util/with-error-handling (format "Error syncing Fields for Table ''%s''" (sync-util/name-for-logging table))
     (let [db-metadata (fetch-metadata/db-metadata database table)]
       {:total-fields   (count db-metadata)
        :updated-fields (sync-and-update! table db-metadata)}))))
(mu/defn sync-fields! :- [:maybe
                          [:map
                           [:updated-fields ms/IntGreaterThanOrEqualToZero]
                           [:total-fields   ms/IntGreaterThanOrEqualToZero]]]
  "Sync the Fields in the Metabase application database for all the Tables in a `database`."
  [database :- i/DatabaseInstance]
  (->> database
       sync-util/db->sync-tables
       (map (partial sync-fields-for-table! database))
       (remove (partial instance? Throwable))
       (apply merge-with +)))
 

Schemas and functions shared by different metabase.sync.sync-metadata.fields.* namespaces.

(ns metabase.sync.sync-metadata.fields.common
  (:require
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.sync.interface :as i]
   [metabase.sync.util :as sync-util]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.registry :as mr]
   [metabase.util.malli.schema :as ms]))

Schema for the parent-id of a Field, i.e. an optional ID.

(def ParentID
  [:maybe ::lib.schema.id/field])
(mr/def ::TableMetadataFieldWithID
  [:merge
   i/TableMetadataField
   [:map
    [:id                             ::lib.schema.id/field]
    [:nested-fields {:optional true} [:set [:ref ::TableMetadataFieldWithID]]]]])

Schema for TableMetadataField with an included ID of the corresponding Metabase Field object. our-metadata is always returned in this format. (The ID is needed in certain places so we know which Fields to retire, and the parent ID of any nested-fields.)

(def TableMetadataFieldWithID
  [:ref ::TableMetadataFieldWithID])
(mr/def ::TableMetadataFieldWithOptionalID
  [:merge
   [:ref ::TableMetadataFieldWithID]
   [:map
    [:id {:optional true}            ::lib.schema.id/field]
    [:nested-fields {:optional true} [:set [:ref ::TableMetadataFieldWithOptionalID]]]]])

Schema for either i/TableMetadataField (db-metadata) or TableMetadataFieldWithID (our-metadata).

(def TableMetadataFieldWithOptionalID
  [:ref ::TableMetadataFieldWithOptionalID])
(mu/defn field-metadata-name-for-logging :- :string
  "Return a 'name for logging' for a map that conforms to the `TableMetadataField` schema.
      (field-metadata-name-for-logging table field-metadata) ; -> \"Table 'venues' Field 'name'\
  [table :- i/TableInstance field-metadata :- TableMetadataFieldWithOptionalID]
  (format "%s %s '%s'" (sync-util/name-for-logging table) "Field" (:name field-metadata)))

Return the lower-cased 'canonical' name that should be used to uniquely identify field -- this is done to ignore case differences when syncing, e.g. we will consider field and field to mean the same thing.

(defn canonical-name
  [field]
  (u/lower-case-en (:name field)))
(mu/defn semantic-type :- [:maybe ms/FieldSemanticOrRelationType]
  "Determine a the appropriate `semantic-type` for a Field with `field-metadata`."
  [field-metadata :- [:maybe i/TableMetadataField]]
  (and field-metadata
       (or (:semantic-type field-metadata)
           (when (:pk? field-metadata) :type/PK))))
(mu/defn matching-field-metadata :- [:maybe TableMetadataFieldWithOptionalID]
  "Find Metadata that matches `field-metadata` from a set of `other-metadata`, if any exists. Useful for finding the
  corresponding Metabase Field for field metadata from the DB, or vice versa. Will prefer exact matches."
  [field-metadata :- TableMetadataFieldWithOptionalID
   other-metadata :- [:set TableMetadataFieldWithOptionalID]]
  (let [matches (keep
                  (fn [other-field-metadata]
                    (when (= (canonical-name field-metadata)
                             (canonical-name other-field-metadata))
                      other-field-metadata))
                  other-metadata)]
    (case (count matches)
      0
      nil
      1
      (first matches)
      (if-let [exact (some (fn [match]
                             (when (= (:name field-metadata) (:name match))
                               match))
                           matches)]
        exact
        (do
          (log/warn "Found multiple matching field metadata for:" (:name field-metadata) (map :name matches))
          (first matches))))))
 

Logic for constructing a map of metadata from the Metabase application database that matches the form of DB metadata about Fields in a Table, and for fetching the DB metadata itself. This metadata is used by the logic in other metabase.sync.sync-metadata.fields.* namespaces to determine what sync operations need to be performed by comparing the differences in the two sets of Metadata.

(ns metabase.sync.sync-metadata.fields.fetch-metadata
  (:require
   [clojure.set :as set]
   [medley.core :as m]
   [metabase.driver :as driver]
   [metabase.models.table :as table]
   [metabase.sync.fetch-metadata :as fetch-metadata]
   [metabase.sync.interface :as i]
   [metabase.sync.sync-metadata.fields.common :as common]
   [metabase.util :as u]
   [metabase.util.malli :as mu]
   [toucan2.core :as t2]))

+----------------------------------------------------------------------------------------------------------------+ | FETCHING OUR CURRENT METADATA | +----------------------------------------------------------------------------------------------------------------+

(mu/defn ^:private fields->parent-id->fields :- [:map-of common/ParentID [:set common/TableMetadataFieldWithID]]
  [fields :- [:maybe [:sequential i/FieldInstance]]]
  (->> (for [field fields]
         {:parent-id                 (:parent_id field)
          :id                        (:id field)
          :name                      (:name field)
          :database-type             (:database_type field)
          :effective-type            (:effective_type field)
          :coercion-strategy         (:coercion_strategy field)
          :base-type                 (:base_type field)
          :semantic-type             (:semantic_type field)
          :pk?                       (isa? (:semantic_type field) :type/PK)
          :field-comment             (:description field)
          :json-unfolding            (:json_unfolding field)
          :database-is-auto-increment (:database_is_auto_increment field)
          :position                  (:position field)
          :database-position         (:database_position field)
          :database-partitioned      (:database_partitioned field)
          :database-required         (:database_required field)})
       ;; make a map of parent-id -> set of child Fields
       (group-by :parent-id)
       ;; remove the parent ID because the Metadata from `describe-table` won't have it. Save the results as a set
       (m/map-vals (fn [fields]
                     (set (for [field fields]
                            (dissoc field :parent-id)))))))
(mu/defn ^:private add-nested-fields :- common/TableMetadataFieldWithID
  "Recursively add entries for any nested-fields to `field`."
  [metabase-field    :- common/TableMetadataFieldWithID
   parent-id->fields :- [:map-of common/ParentID [:set common/TableMetadataFieldWithID]]]
  (let [nested-fields (get parent-id->fields (u/the-id metabase-field))]
    (if-not (seq nested-fields)
      metabase-field
      (assoc metabase-field :nested-fields (set (for [nested-field nested-fields]
                                                  (add-nested-fields nested-field parent-id->fields)))))))
(mu/defn fields->our-metadata :- [:set common/TableMetadataFieldWithID]
  "Given a sequence of Metabase Fields, format them and return them in a hierachy so the format matches the one
  `db-metadata` comes back in."
  ([fields :- [:maybe [:sequential i/FieldInstance]]]
   (fields->our-metadata fields nil))
  ([fields :- [:maybe [:sequential i/FieldInstance]], top-level-parent-id :- common/ParentID]
   (let [parent-id->fields (fields->parent-id->fields fields)]
     ;; get all the top-level fields, then call `add-nested-fields` to recursively add the fields
     (set (for [metabase-field (get parent-id->fields top-level-parent-id)]
            (add-nested-fields metabase-field parent-id->fields))))))
(mu/defn ^:private table->fields :- [:maybe [:sequential i/FieldInstance]]
  "Fetch active Fields from the Metabase application database for a given `table`."
  [table :- i/TableInstance]
  (t2/select [:model/Field :name :database_type :base_type :effective_type :coercion_strategy :semantic_type
              :parent_id :id :description :database_position :nfc_path :database_is_auto_increment :database_required
              :database_partitioned :json_unfolding :position]
             :table_id  (u/the-id table)
             :active    true
             {:order-by table/field-order-rule}))
(mu/defn our-metadata :- [:set common/TableMetadataFieldWithID]
  "Return information we have about Fields for a `table` in the application database in (almost) exactly the same
   `TableMetadataField` format returned by `describe-table`."
  [table :- i/TableInstance]
  (-> table table->fields fields->our-metadata))

+----------------------------------------------------------------------------------------------------------------+ | FETCHING METADATA FROM CONNECTED DB | +----------------------------------------------------------------------------------------------------------------+

(mu/defn db-metadata :- [:set i/TableMetadataField]
  "Fetch metadata about Fields belonging to a given `table` directly from an external database by calling its driver's
  implementation of `describe-table`."
  [database :- i/DatabaseInstance
   table    :- i/TableInstance]
  (cond-> (:fields (fetch-metadata/table-metadata database table))
    (driver/database-supports? (:engine database) :nested-field-columns database)
    (set/union (fetch-metadata/nfc-metadata database table))))
 

Logic for syncing the instances of Field in the Metabase application DB with the set of Fields in the DB metadata. Responsible for creating new instances of Field as needed, and marking existing ones as active or inactive as needed. Recursively handles nested Fields.

All nested Fields recursion is handled in one place, by the main entrypoint (sync-instances!) and helper functions sync-nested-field-instances! and sync-nested-fields-of-one-field!. All other functions in this namespace should ignore nested fields entirely; the will be invoked with those Fields as appropriate.

(ns metabase.sync.sync-metadata.fields.sync-instances
  (:require
   [medley.core :as m]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.models.field :as field :refer [Field]]
   [metabase.models.humanization :as humanization]
   [metabase.sync.interface :as i]
   [metabase.sync.sync-metadata.fields.common :as common]
   [metabase.sync.sync-metadata.fields.fetch-metadata :as fetch-metadata]
   [metabase.sync.util :as sync-util]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

+----------------------------------------------------------------------------------------------------------------+ | CREATING / REACTIVATING FIELDS | +----------------------------------------------------------------------------------------------------------------+

(mu/defn ^:private matching-inactive-fields :- [:maybe [:sequential i/FieldInstance]]
  "Return inactive Metabase Fields that match any of the Fields described by `new-field-metadatas`, if any such Fields
  exist."
  [table               :- i/TableInstance
   new-field-metadatas :- [:maybe [:sequential i/TableMetadataField]]
   parent-id           :- common/ParentID]
  (when (seq new-field-metadatas)
    (t2/select     Field
      :table_id    (u/the-id table)
      :%lower.name [:in (map common/canonical-name new-field-metadatas)]
      :parent_id   parent-id
      :active      false)))
(mu/defn ^:private insert-new-fields! :- [:maybe [:sequential ::lib.schema.id/field]]
  "Insert new Field rows for for all the Fields described by `new-field-metadatas`. Returns IDs of newly inserted
  Fields."
  [table               :- i/TableInstance
   new-field-metadatas :- [:maybe [:sequential i/TableMetadataField]]
   parent-id           :- common/ParentID]
  (when (seq new-field-metadatas)
    (t2/insert-returning-pks! Field
      (for [{:keys [base-type coercion-strategy database-is-auto-increment database-partitioned database-position
                    database-required database-type effective-type field-comment json-unfolding nfc-path visibility-type]
             field-name :name :as field} new-field-metadatas]
        (do
          (when (and effective-type
                     base-type
                     (not= effective-type base-type)
                     (nil? coercion-strategy))
            (log/warn (u/format-color 'red
                                      (str
                                       "WARNING: Field `%s`: effective type `%s` provided but no coercion strategy provided."
                                       " Using base-type: `%s`")
                                      field-name
                                      effective-type
                                      base-type)))
          {:table_id                   (u/the-id table)
           :name                       field-name
           :display_name               (humanization/name->human-readable-name field-name)
           :database_type              (or database-type "NULL") ; placeholder for Fields w/ no type info (e.g. Mongo) & all NULL
           :base_type                  base-type
           ;; todo test this?
           :effective_type             (if (and effective-type coercion-strategy) effective-type base-type)
           :coercion_strategy          (when effective-type coercion-strategy)
           :semantic_type              (common/semantic-type field)
           :parent_id                  parent-id
           :nfc_path                   nfc-path
           :description                field-comment
           :position                   database-position
           :database_position          database-position
           :json_unfolding             (or json-unfolding false)
           :database_is_auto_increment (or database-is-auto-increment false)
           :database_required          (or database-required false)
           :database_partitioned       database-partitioned ;; nullable for database that doesn't support partitioned fields
           :visibility_type            (or visibility-type :normal)})))))
(mu/defn ^:private create-or-reactivate-fields! :- [:maybe [:sequential i/FieldInstance]]
  "Create (or reactivate) Metabase Field object(s) for any Fields in `new-field-metadatas`. Does *NOT* recursively
  handle nested Fields."
  [table               :- i/TableInstance
   new-field-metadatas :- [:maybe [:sequential i/TableMetadataField]]
   parent-id           :- common/ParentID]
  (let [fields-to-reactivate (matching-inactive-fields table new-field-metadatas parent-id)]
    ;; if the fields already exist but were just marked inactive then reäctivate them
    (when (seq fields-to-reactivate)
      (t2/update! Field {:id [:in (map u/the-id fields-to-reactivate)]}
                  {:active true}))
    (let [reactivated?  (comp (set (map common/canonical-name fields-to-reactivate))
                              common/canonical-name)
          ;; If we reactivated the fields, no need to insert them; insert new rows for any that weren't reactivated
          new-field-ids (insert-new-fields! table (remove reactivated? new-field-metadatas) parent-id)]
      ;; now return the newly created or reactivated Fields
      (when-let [new-and-updated-fields (seq (map u/the-id (concat fields-to-reactivate new-field-ids)))]
        (t2/select Field :id [:in new-and-updated-fields])))))

+----------------------------------------------------------------------------------------------------------------+ | SYNCING INSTANCES OF 'ACTIVE' FIELDS (FIELDS IN DB METADATA) | +----------------------------------------------------------------------------------------------------------------+

Schema for the value returned by sync-active-instances!. Because we need to know about newly-inserted/reactivated parent Fields when recursively syncing nested Fields, we need to propogate the updates to our-metadata made by this function and pass them to other steps of the sync-instances! process.

(def ^:private Updates
  [:map
   [:num-updates  ms/IntGreaterThanOrEqualToZero]
   [:our-metadata [:set common/TableMetadataFieldWithID]]])
(mu/defn ^:private sync-active-instances! :- Updates
  "Sync instances of `Field` in the application database with 'active' Fields in the DB being synced (i.e., ones that
  are returned as part of the `db-metadata`). Creates or reactivates Fields as needed. Returns number of Fields
  synced and updated `our-metadata` including the new Fields and their IDs."
  [table        :- i/TableInstance
   db-metadata  :- [:set i/TableMetadataField]
   our-metadata :- [:set common/TableMetadataFieldWithID]
   parent-id    :- common/ParentID]
  (let [known-fields (m/index-by common/canonical-name our-metadata)
        our-metadata (atom our-metadata)]
    {:num-updates
     ;; Field sync logic below is broken out into chunks of 1000 fields for huge star schemas or other situations
     ;; where we don't want to be updating way too many rows at once
     (sync-util/sum-for [db-field-chunk (partition-all 1000 db-metadata)]
       (sync-util/with-error-handling (format "Error checking if Fields %s need to be created or reactivated"
                                              (pr-str (map :name db-field-chunk)))
        (let [known-field?        (comp known-fields common/canonical-name)
              new-fields          (remove known-field? db-field-chunk)
              new-field-instances (create-or-reactivate-fields! table new-fields parent-id)]
          ;; save any updates to `our-metadata`
          (swap! our-metadata into (fetch-metadata/fields->our-metadata new-field-instances parent-id))
          ;; now return count of rows updated
          (count new-fields))))
     :our-metadata
     @our-metadata}))

+----------------------------------------------------------------------------------------------------------------+ | "RETIRING" INACTIVE FIELDS | +----------------------------------------------------------------------------------------------------------------+

(mu/defn ^:private retire-field! :- [:maybe [:= 1]]
  "Mark an `old-field` belonging to `table` as inactive if corresponding Field object exists. Does *NOT* recurse over
  nested Fields. Returns `1` if a Field was marked inactive, `nil` otherwise."
  [table          :- i/TableInstance
   metabase-field :- common/TableMetadataFieldWithID]
  (log/infof "Marking Field ''%s'' as inactive." (common/field-metadata-name-for-logging table metabase-field))
  (when (pos? (t2/update! Field (u/the-id metabase-field) {:active false}))
    1))
(mu/defn ^:private retire-fields! :- ms/IntGreaterThanOrEqualToZero
  "Mark inactive any Fields in the application database that are no longer present in the DB being synced. These
  Fields are ones that are in `our-metadata`, but not in `db-metadata`. Does *NOT* recurse over nested Fields.
  Returns `1` if a Field was marked inactive."
  [table        :- i/TableInstance
   db-metadata  :- [:set i/TableMetadataField]
   our-metadata :- [:set common/TableMetadataFieldWithID]]
  ;; retire all the Fields not present in `db-metadata`, and count how many rows were actually affected
  (sync-util/sum-for [metabase-field our-metadata
                      :when          (not (common/matching-field-metadata metabase-field db-metadata))]
    (sync-util/with-error-handling (format "Error retiring %s"
                                           (common/field-metadata-name-for-logging table metabase-field))
      (retire-field! table metabase-field))))

+----------------------------------------------------------------------------------------------------------------+ | HIGH-LEVEL INSTANCE SYNCING LOGIC (CREATING/REACTIVATING/RETIRING/UPDATING) | +----------------------------------------------------------------------------------------------------------------+

(declare sync-instances!)
(mu/defn ^:private sync-nested-fields-of-one-field! :- [:maybe ms/IntGreaterThanOrEqualToZero]
  "Recursively sync Field instances (i.e., rows in application DB) for nested Fields of a single Field, one or both
  `field-metadata` (from synced DB) and `metabase-field` (from application DB)."
  [table          :- i/TableInstance
   field-metadata :- [:maybe i/TableMetadataField]
   metabase-field :- [:maybe common/TableMetadataFieldWithID]]
  (let [nested-fields-metadata (:nested-fields field-metadata)
        metabase-nested-fields (:nested-fields metabase-field)]
    (when (or (seq nested-fields-metadata)
              (seq metabase-nested-fields))
      (sync-instances!
       table
       (set nested-fields-metadata)
       (set metabase-nested-fields)
       (some-> metabase-field u/the-id)))))
(mu/defn ^:private sync-nested-field-instances! :- [:maybe ms/IntGreaterThanOrEqualToZero]
  "Recursively sync Field instances (i.e., rows in application DB) for *all* the nested Fields of all Fields in
  `db-metadata` and `our-metadata`.
  Not for the flattened nested fields for JSON columns in normal RDBMSes (nested field columns)"
  [table        :- i/TableInstance
   db-metadata  :- [:set i/TableMetadataField]
   our-metadata :- [:set common/TableMetadataFieldWithID]]
  (let [name->field-metadata (m/index-by common/canonical-name db-metadata)
        name->metabase-field (m/index-by common/canonical-name our-metadata)
        all-field-names      (set (concat (keys name->field-metadata)
                                          (keys name->metabase-field)))]
    (sync-util/sum-for [field-name all-field-names
                        :let [field-metadata (get name->field-metadata field-name)
                              metabase-field (get name->metabase-field field-name)]]
      (sync-nested-fields-of-one-field! table field-metadata metabase-field))))
(mu/defn sync-instances! :- ms/IntGreaterThanOrEqualToZero
  "Sync rows in the Field table with `db-metadata` describing the current schema of the Table currently being synced,
  creating Field objects or marking them active/inactive as needed."
  ([table        :- i/TableInstance
    db-metadata  :- [:set i/TableMetadataField]
    our-metadata :- [:set common/TableMetadataFieldWithID]]
   (sync-instances! table db-metadata our-metadata nil))
  ([table        :- i/TableInstance
    db-metadata  :- [:set i/TableMetadataField]
    our-metadata :- [:set common/TableMetadataFieldWithID]
    parent-id    :- common/ParentID]
   ;; syncing the active instances makes important changes to `our-metadata` that need to be passed to recursive
   ;; calls, such as adding new Fields or making inactive ones active again. Keep updated version returned by
   ;; `sync-active-instances!`
   (let [{:keys [num-updates our-metadata]} (sync-active-instances! table db-metadata our-metadata parent-id)]
     (+ num-updates
        (retire-fields! table db-metadata our-metadata)
        (sync-nested-field-instances! table db-metadata our-metadata)))))
 

Logic for updating metadata properties of Field instances in the application database as needed -- this includes the base type, database type, semantic type, and comment/remark (description) properties. This primarily affects Fields that were not newly created; newly created Fields are given appropriate metadata when first synced.

(ns metabase.sync.sync-metadata.fields.sync-metadata
  (:require
   [clojure.string :as str]
   [metabase.models.field :as field :refer [Field]]
   [metabase.sync.interface :as i]
   [metabase.sync.sync-metadata.fields.common :as common]
   [metabase.sync.util :as sync-util]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))
(mu/defn ^:private update-field-metadata-if-needed! :- [:enum 0 1]
  "Update the metadata for a Metabase Field as needed if any of the info coming back from the DB has changed. Syncs
  base type, database type, semantic type, and comments/remarks; returns `1` if the Field was updated; `0` otherwise."
  [table          :- i/TableInstance
   field-metadata :- i/TableMetadataField
   metabase-field :- common/TableMetadataFieldWithID]
  (let [{old-database-type              :database-type
         old-base-type                  :base-type
         old-field-comment              :field-comment
         old-semantic-type              :semantic-type
         old-database-position          :database-position
         old-position                   :position
         old-database-name              :name
         old-database-is-auto-increment :database-is-auto-increment
         old-db-partitioned             :database-partitioned
         old-db-required                :database-required} metabase-field
        {new-database-type              :database-type
         new-base-type                  :base-type
         new-field-comment              :field-comment
         new-database-position          :database-position
         new-database-name              :name
         new-database-is-auto-increment :database-is-auto-increment
         new-db-partitioned             :database-partitioned
         new-db-required                :database-required} field-metadata
        new-database-is-auto-increment             (boolean new-database-is-auto-increment)
        new-db-required                            (boolean new-db-required)
        new-database-type                          (or new-database-type "NULL")
        new-semantic-type                          (common/semantic-type field-metadata)
        new-db-type?
        (not= old-database-type new-database-type)
        new-base-type?
        (not= old-base-type new-base-type)
        ;; only sync comment if old value was blank so we don't overwrite user-set values
        new-semantic-type?
        (and (nil? old-semantic-type)
             (not= old-semantic-type new-semantic-type))
        new-comment?
        (and (str/blank? old-field-comment)
             (not (str/blank? new-field-comment)))
        new-database-position?
        (not= old-database-position new-database-position)
        ;; these fields are paired by by metabase.sync.sync-metadata.fields.common/canonical-name, so if they are
        ;; different they have the same canonical representation (lower-casing at the moment).
        new-name? (not= old-database-name new-database-name)
        new-db-auto-incremented? (not= old-database-is-auto-increment new-database-is-auto-increment)
        new-db-partitioned?      (not= new-db-partitioned old-db-partitioned)
        new-db-required?         (not= old-db-required new-db-required)
        ;; calculate combined updates
        updates
        (merge
         (when new-db-type?
           (log/infof "Database type of %s has changed from ''%s'' to ''%s''."
                      (common/field-metadata-name-for-logging table metabase-field)
                      old-database-type
                      new-database-type)
           {:database_type new-database-type})
         (when new-base-type?
           (log/infof "Base type of %s has changed from ''%s'' to ''%s''."
                     (common/field-metadata-name-for-logging table metabase-field)
                     old-base-type
                     new-base-type)
           {:base_type new-base-type})
         (when new-semantic-type?
           (log/infof "Semantic type of {0} has changed from ''%s'' to ''%s''."
                      (common/field-metadata-name-for-logging table metabase-field)
                      old-semantic-type
                      new-semantic-type)
           {:semantic_type new-semantic-type})
         (when new-comment?
           (log/infof "Comment has been added for %s."
                      (common/field-metadata-name-for-logging table metabase-field))
           {:description new-field-comment})
         (when new-database-position?
           (log/infof "Database position of %s has changed from ''%s'' to ''%s''."
                      (common/field-metadata-name-for-logging table metabase-field)
                      old-database-position
                      new-database-position)
           {:database_position new-database-position})
         (when (and (= (:field_order table) :database)
                    (not= old-position new-database-position))
           (log/infof "Position of %s has changed from ''%s'' to ''%s''."
                      (common/field-metadata-name-for-logging table metabase-field)
                      old-position
                      new-database-position)
           {:position new-database-position})
         (when new-name?
           (log/infof "Name of %s has changed from ''%s'' to ''%s''."
                      (common/field-metadata-name-for-logging table metabase-field)
                      old-database-name
                      new-database-name)
           {:name new-database-name})
         (when new-db-auto-incremented?
           (log/infof "Database auto incremented of %s has changed from ''%s'' to ''%s''."
                      (common/field-metadata-name-for-logging table metabase-field)
                      old-database-is-auto-increment
                      new-database-is-auto-increment)
           {:database_is_auto_increment new-database-is-auto-increment})
         (when new-db-partitioned?
           (log/infof "Database partitioned of %s has changed from ''%s'' to ''%s''."
                      (common/field-metadata-name-for-logging table metabase-field)
                      old-db-partitioned
                      new-db-partitioned)
           {:database_partitioned new-db-partitioned})
         (when new-db-required?
           (log/infof "Database required of %s has changed from ''%s'' to ''%s''."
                      (common/field-metadata-name-for-logging table metabase-field)
                      old-db-required
                      new-db-required)
           {:database_required new-db-required}))]
    ;; if any updates need to be done, do them and return 1 (because 1 Field was updated), otherwise return 0
    (if (and (seq updates)
             (pos? (t2/update! Field (u/the-id metabase-field) updates)))
      1
      0)))
(declare update-metadata!)
(mu/defn ^:private update-nested-fields-metadata! :- ms/IntGreaterThanOrEqualToZero
  "Recursively call `update-metadata!` for all the nested Fields in a `metabase-field`."
  [table          :- i/TableInstance
   field-metadata :- i/TableMetadataField
   metabase-field :- common/TableMetadataFieldWithID]
  (let [nested-fields-metadata (:nested-fields field-metadata)
        metabase-nested-fields (:nested-fields metabase-field)]
    (if (seq metabase-nested-fields)
      (update-metadata! table (set nested-fields-metadata) (set metabase-nested-fields))
      0)))
(mu/defn update-metadata! :- ms/IntGreaterThanOrEqualToZero
  "Make sure things like PK status and base-type are in sync with what has come back from the DB. Recursively updates
  nested Fields. Returns total number of Fields updated."
  [table        :- i/TableInstance
   db-metadata  :- [:set i/TableMetadataField]
   our-metadata :- [:set common/TableMetadataFieldWithID]]
  (sync-util/sum-for [metabase-field our-metadata]
    ;; only update metadata for 'existing' Fields that are present in our Metadata (i.e., present in the application
    ;; database) and that are still considered active (i.e., present in DB metadata)
    (when-let [field-metadata (common/matching-field-metadata metabase-field db-metadata)]
      (+ (update-field-metadata-if-needed! table field-metadata metabase-field)
         (update-nested-fields-metadata! table field-metadata metabase-field)))))
 

Logic for updating FK properties of Fields from metadata fetched from a physical DB.

(ns metabase.sync.sync-metadata.fks
  (:require
   [metabase.models.field :refer [Field]]
   [metabase.models.table :as table :refer [Table]]
   [metabase.sync.fetch-metadata :as fetch-metadata]
   [metabase.sync.interface :as i]
   [metabase.sync.util :as sync-util]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [toucan2.core :as t2]))

Relevant objects for a foreign key relationship.

(def ^:private FKRelationshipObjects
  [:map
   [:source-field i/FieldInstance]
   [:dest-table   i/TableInstance]
   [:dest-field   i/FieldInstance]])
(mu/defn ^:private fetch-fk-relationship-objects :- [:maybe FKRelationshipObjects]
  "Fetch the Metabase objects (Tables and Fields) that are relevant to a foreign key relationship described by FK."
  [database :- i/DatabaseInstance
   table    :- i/TableInstance
   fk       :- i/FKMetadataEntry]
  (when-let [source-field (t2/select-one Field
                            :table_id           (u/the-id table)
                            :%lower.name        (u/lower-case-en (:fk-column-name fk))
                            :fk_target_field_id nil
                            :active             true
                            :visibility_type    [:not= "retired"])]
    (when-let [dest-table (t2/select-one Table
                            :db_id           (u/the-id database)
                            :%lower.name     (u/lower-case-en (-> fk :dest-table :name))
                            :%lower.schema   (when-let [schema (-> fk :dest-table :schema)]
                                               (u/lower-case-en schema))
                            :active          true
                            :visibility_type nil)]
      (when-let [dest-field (t2/select-one Field
                              :table_id           (u/the-id dest-table)
                              :%lower.name        (u/lower-case-en (:dest-column-name fk))
                              :active             true
                              :visibility_type    [:not= "retired"])]
        {:source-field source-field
         :dest-table   dest-table
         :dest-field   dest-field}))))
(mu/defn ^:private mark-fk!
  [database :- i/DatabaseInstance
   table    :- i/TableInstance
   fk       :- i/FKMetadataEntry]
  (when-let [{:keys [source-field dest-table dest-field]} (fetch-fk-relationship-objects database table fk)]
    (log/info (u/format-color 'cyan "Marking foreign key from %s %s -> %s %s"
                (sync-util/name-for-logging table)
                (sync-util/name-for-logging source-field)
                (sync-util/name-for-logging dest-table)
                (sync-util/name-for-logging dest-field)))
    (t2/update! Field (u/the-id source-field)
                {:semantic_type      :type/FK
                 :fk_target_field_id (u/the-id dest-field)})
    true))

Sync the foreign keys for a specific table.

(mu/defn sync-fks-for-table!
  ([table :- i/TableInstance]
   (sync-fks-for-table! (table/database table) table))
  ([database :- i/DatabaseInstance
    table    :- i/TableInstance]
   (sync-util/with-error-handling (format "Error syncing FKs for %s" (sync-util/name-for-logging table))
     (let [fks-to-update (fetch-metadata/fk-metadata database table)]
       {:total-fks   (count fks-to-update)
        :updated-fks (sync-util/sum-numbers (fn [fk]
                                              (if (mark-fk! database table fk)
                                                1
                                                0))
                                            fks-to-update)}))))

Sync the foreign keys in a database. This sets appropriate values for relevant Fields in the Metabase application DB based on values from the FKMetadata returned by [[metabase.driver/describe-table-fks]].

(mu/defn sync-fks!
  [database :- i/DatabaseInstance]
  (reduce (fn [update-info table]
            (let [table-fk-info (sync-fks-for-table! database table)]
              ;; Mark the table as done with its initial sync once this step is done even if it failed, because only
              ;; sync-aborting errors should be surfaced to the UI (see
              ;; `:metabase.sync.util/exception-classes-not-to-retry`).
              (sync-util/set-initial-table-sync-complete! table)
              (if (instance? Exception table-fk-info)
                (update update-info :total-failed inc)
                (merge-with + update-info table-fk-info))))
          {:total-fks    0
           :updated-fks  0
           :total-failed 0}
          (sync-util/db->sync-tables database)))
 
(ns metabase.sync.sync-metadata.indexes
  (:require
   [clojure.data :as data]
   [metabase.driver :as driver]
   [metabase.driver.util :as driver.u]
   [metabase.models.field :as field]
   [metabase.sync.fetch-metadata :as fetch-metadata]
   [metabase.sync.util :as sync-util]
   [metabase.util.log :as log]
   [toucan2.core :as t2]))
(def ^:private empty-stats
  {:total-indexes 0
   :added-indexes 0
   :removed-indexes 0})
(defn- indexes->field-ids
  [table-id indexes]
  (when (seq indexes)
    (let [normal-indexes           (->> indexes (filter #(= (:type %) :normal-column-index)) (map :value))
          nested-indexes           (->> indexes (filter #(= (:type %) :nested-column-index)) (map :value))
          normal-indexes-field-ids (when (seq normal-indexes)
                                     (t2/select-pks-vec :model/Field :name [:in normal-indexes] :table_id table-id))
          nested-indexes-field-ids (remove nil? (map #(field/nested-field-names->field-id table-id %) nested-indexes))]
      (set (filter some? (concat normal-indexes-field-ids nested-indexes-field-ids))))))

Sync the indexes for table if the driver supports storing index info.

(defn maybe-sync-indexes-for-table!
  [database table]
  (if (driver/database-supports? (driver.u/database->driver database) :index-info database)
    (sync-util/with-error-handling (format "Error syncing Indexes for %s" (sync-util/name-for-logging table))
      (let [indexes                    (fetch-metadata/index-metadata database table)
            indexed-field-ids          (indexes->field-ids (:id table) indexes)
            existing-indexed-field-ids (t2/select-pks-set :model/Field :table_id (:id table) :database_indexed true)
            [removing adding]          (data/diff existing-indexed-field-ids indexed-field-ids)]
        (doseq [field-id removing]
          (log/infof "Unmarking Field %d as indexed" field-id))
        (doseq [field-id adding]
          (log/infof "Marking Field %d as indexed" field-id))
        (if (or (seq adding) (seq removing))
          (do (t2/update! :model/Field {:table_id (:id table)}
                          {:database_indexed (if (seq indexed-field-ids)
                                               [:case [:in :id indexed-field-ids] true :else false]
                                               false)})
              {:total-indexes   (count indexed-field-ids)
               :added-indexes   (count adding)
               :removed-indexes (count removing)})
          empty-stats)))
    empty-stats))

Sync the indexes for all tables in database if the driver supports storing index info.

(defn maybe-sync-indexes!
  [database]
  (if (driver/database-supports? (driver.u/database->driver database) :index-info database)
    (apply merge-with + empty-stats
           (map #(maybe-sync-indexes-for-table! database %) (sync-util/db->sync-tables database)))
    empty-stats))
 

Logic for syncing the special _metabase_metadata table, which is a way for datasets such as the Sample Database to specific properties such as semantic types that should be applied during sync.

Currently, this is only used by the Sample Database, but theoretically in the future we could add additional sample datasets and preconfigure them by populating this Table; or 3rd-party applications or users can add this table to their database for an enhanced Metabase experience out-of-the box.

(ns metabase.sync.sync-metadata.metabase-metadata
  (:require
   [clojure.string :as str]
   [metabase.driver :as driver]
   [metabase.driver.util :as driver.u]
   [metabase.models.database :refer [Database]]
   [metabase.models.field :refer [Field]]
   [metabase.models.table :refer [Table]]
   [metabase.sync.fetch-metadata :as fetch-metadata]
   [metabase.sync.interface :as i]
   [metabase.sync.util :as sync-util]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))
(def ^:private KeypathComponents
  [:map
   [:table-name [:maybe ms/NonBlankString]]
   [:field-name [:maybe ms/NonBlankString]]
   [:k          :keyword]])
(mu/defn ^:private parse-keypath :- KeypathComponents
  "Parse a `keypath` into components for easy use."
  ;; TODO: this does not support schemas in dbs :(
  [keypath :- ms/NonBlankString]
  ;; keypath will have one of three formats:
  ;; property (for database-level properties)
  ;; table_name.property
  ;; table_name.field_name.property
  (let [[first-part second-part third-part] (str/split keypath #"\.")]
    {:table-name (when second-part first-part)
     :field-name (when third-part second-part)
     :k          (keyword (or third-part second-part first-part))}))
(mu/defn ^:private set-property! :- :boolean
  "Set a property for a Field or Table in `database`. Returns `true` if a property was successfully set."
  [database                          :- i/DatabaseInstance
   {:keys [table-name field-name k]} :- KeypathComponents
   value]
  (boolean
    ;; ignore legacy entries that try to set field_type since it's no longer part of Field
    (when-not (= k :field_type)
      ;; fetch the corresponding Table, then set the Table or Field property
      (if table-name
        (when-let [table-id (t2/select-one-pk Table
                                              ;; TODO: this needs to support schemas
                                              :db_id  (u/the-id database)
                                              :name   table-name
                                              :active true)]
          (if field-name
            (pos? (t2/update! Field {:name field-name, :table_id table-id} {k value}))
            (pos? (t2/update! Table table-id {k value}))))
        (pos? (t2/update! Database (u/the-id database) {k value}))))))

Databases may include a table named _metabase_metadata (case-insentive) which includes descriptions or other metadata about the Tables and Fields it contains. This table is not synced normally, i.e. a Metabase Table is not created for it. Instead, this function is called, which reads the data it contains and updates the relevant Metabase objects.

The table should have the following schema:

column | type | example --------+---------+------------------------------------------------- keypath | varchar | "products.created_at.description" value | varchar | "The date the product was added to our catalog."

keypath is of the form table-name.key or table-name.field-name.key, where key is the name of some property of Table or Field.

This functionality is currently only used by the Sample Database. In order to use this functionality, drivers must implement optional fn :table-rows-seq.

(mu/defn ^:private sync-metabase-metadata-table!
  [driver
   database                :- i/DatabaseInstance
   metabase-metadata-table :- i/DatabaseMetadataTable]
  (doseq [{:keys [keypath value]} (driver/table-rows-seq driver database metabase-metadata-table)]
    (sync-util/with-error-handling (format "Error handling metabase metadata entry: set %s -> %s" keypath value)
      (or (set-property! database (parse-keypath keypath) value)
          (log/error (u/format-color 'red "Error syncing _metabase_metadata: no matching keypath: %s" keypath))))))

Is this TABLE the special _metabase_metadata table?

(mu/defn is-metabase-metadata-table?
  [table :- i/DatabaseMetadataTable]
  (= "_metabase_metadata" (u/lower-case-en (:name table))))

Sync the _metabase_metadata table, a special table with Metabase metadata, if present. This table contains information about type information, descriptions, and other properties that should be set for Metabase objects like Tables and Fields.

(mu/defn sync-metabase-metadata!
  ([database :- i/DatabaseInstance]
   (sync-metabase-metadata! database (fetch-metadata/db-metadata database)))
  ([database :- i/DatabaseInstance db-metadata]
   (sync-util/with-error-handling (format "Error syncing _metabase_metadata table for %s"
                                          (sync-util/name-for-logging database))
     (let [driver (driver.u/database->driver database)]
       ;; `sync-metabase-metadata-table!` relies on `driver/table-rows-seq` being defined
       (when (get-method driver/table-rows-seq driver)
         ;; If there's more than one metabase metadata table (in different schemas) we'll sync each one in turn.
         ;; Hopefully this is never the case.
         (doseq [table (:tables db-metadata)]
           (when (is-metabase-metadata-table? table)
             (sync-metabase-metadata-table! driver database table))))
       {}))))
 
(ns metabase.sync.sync-metadata.sync-table-privileges
  (:require
   [metabase.driver :as driver]
   [metabase.driver.util :as driver.u]
   [metabase.models.interface :as mi]
   [metabase.util.malli :as mu]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

Sync the table_privileges table with the privileges in the database.

This is a cache of the data returned from driver/table-privileges, but it's stored in the database for performance.

(mu/defn sync-table-privileges!
  [database :- (mi/InstanceOf :model/Database)]
  (let [driver (driver.u/database->driver database)]
    (when (driver/database-supports? driver :table-privileges database)
      (let [rows               (driver/current-user-table-privileges driver database)
            schema+table->id   (t2/select-fn->pk (fn [t] {:schema (:schema t), :table (:name t)}) :model/Table :db_id (:id database))
            rows-with-table-id (keep (fn [row]
                                       (when-let [table-id (get schema+table->id (select-keys row [:schema :table]))]
                                         (-> row
                                             (assoc :table_id table-id)
                                             (dissoc :schema :table))))
                                     rows)]
        (t2/with-transaction [_conn]
          (t2/delete! :model/TablePrivileges :table_id [:in {:select [:t.id]
                                                             :from   [[:metabase_table :t]]
                                                             :where  [:= :t.db_id (:id database)]}])
          {:total-table-privileges (t2/insert! :model/TablePrivileges rows-with-table-id)})))))
 
(ns metabase.sync.sync-metadata.sync-timezone
  (:require
   [java-time.api :as t]
   [metabase.driver :as driver]
   [metabase.driver.util :as driver.u]
   [metabase.lib.schema.expression.temporal
    :as lib.schema.expression.temporal]
   [metabase.sync.interface :as i]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)
(defn- validate-zone-id [driver zone-id]
  (when zone-id
    (when-not (some (fn [klass]
                      (instance? klass zone-id))
                    [String java.time.ZoneId java.time.ZoneOffset])
      (throw (ex-info (format (str "metabase.driver/db-default-timezone should return a String, java.time.ZoneId, or "
                                   "java.time.ZoneOffset, but the %s implementation returned ^%s %s")
                              (pr-str driver)
                              (.getCanonicalName (class zone-id))
                              (pr-str zone-id))
                      {:driver driver, :zone-id zone-id})))
    (when (string? zone-id)
      (try
        (t/zone-id zone-id)
        (catch Throwable e
          (throw (ex-info (trs "Invalid timezone {0}: {1}" (pr-str zone-id) (ex-message e))
                          {:zone-id zone-id}
                          e)))))
    zone-id))
(mu/defn sync-timezone! :- [:map [:timezone-id [:maybe ::lib.schema.expression.temporal/timezone-id]]]
  "Query `database` for its current time to determine its timezone. The results of this function are used by the sync
  process to update the timezone if it's different."
  [database :- i/DatabaseInstance]
  (let [driver  (driver.u/database->driver database)
        zone-id (driver/db-default-timezone driver database)]
    (log/infof "%s database %s default timezone is %s" driver (pr-str (:id database)) (pr-str zone-id))
    (validate-zone-id driver zone-id)
    (let [zone-id (some-> zone-id str)
          zone-id (if (= zone-id "Z") "UTC" zone-id)]
      (when-not (= zone-id (:timezone database))
        (t2/update! :model/Database (:id database) {:timezone zone-id}))
      {:timezone-id zone-id})))
 

Logic for updating Metabase Table models from metadata fetched from a physical DB.

(ns metabase.sync.sync-metadata.tables
  (:require
   [clojure.data :as data]
   [clojure.set :as set]
   [medley.core :as m]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.models.database :refer [Database]]
   [metabase.models.humanization :as humanization]
   [metabase.models.interface :as mi]
   [metabase.models.permissions :as perms]
   [metabase.models.permissions-group :as perms-group]
   [metabase.models.table :refer [Table]]
   [metabase.sync.fetch-metadata :as fetch-metadata]
   [metabase.sync.interface :as i]
   [metabase.sync.sync-metadata.metabase-metadata :as metabase-metadata]
   [metabase.sync.util :as sync-util]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

------------------------------------------------ "Crufty" Tables -------------------------------------------------

Crufty tables are ones we know are from frameworks like Rails or Django and thus automatically mark as :cruft

Regular expressions that match Tables that should automatically given the visibility-type of :cruft. This means they are automatically hidden to users (but can be unhidden in the admin panel). These Tables are known to not contain useful data, such as migration or web framework internal tables.

(def ^:private crufty-table-patterns
  #{;; Django
    #"^auth_group$"
    #"^auth_group_permissions$"
    #"^auth_permission$"
    #"^django_admin_log$"
    #"^django_content_type$"
    #"^django_migrations$"
    #"^django_session$"
    #"^django_site$"
    #"^south_migrationhistory$"
    #"^user_groups$"
    #"^user_user_permissions$"
    ;; Drupal
    #".*_cache$"
    #".*_revision$"
    #"^advagg_.*"
    #"^apachesolr_.*"
    #"^authmap$"
    #"^autoload_registry.*"
    #"^batch$"
    #"^blocked_ips$"
    #"^cache.*"
    #"^captcha_.*"
    #"^config$"
    #"^field_revision_.*"
    #"^flood$"
    #"^node_revision.*"
    #"^queue$"
    #"^rate_bot_.*"
    #"^registry.*"
    #"^router.*"
    #"^semaphore$"
    #"^sequences$"
    #"^sessions$"
    #"^watchdog$"
    ;; Rails / Active Record
    #"^schema_migrations$"
    #"^ar_internal_metadata$"
    ;; PostGIS
    #"^spatial_ref_sys$"
    ;; nginx
    #"^nginx_access_log$"
    ;; Liquibase
    #"^databasechangelog$"
    #"^databasechangeloglock$"
    ;; Lobos
    #"^lobos_migrations$"
    ;; MSSQL
    #"^syncobj_0x.*"})

Should we give newly created TABLE a visibility_type of :cruft?

(mu/defn ^:private is-crufty-table?
  [table :- i/DatabaseMetadataTable]
  (some #(re-find % (u/lower-case-en (:name table))) crufty-table-patterns))

---------------------------------------------------- Syncing -----------------------------------------------------

If there is a version in the db-metadata update the DB to have that in the DB model

(mu/defn ^:private update-database-metadata!
  [database    :- i/DatabaseInstance
   db-metadata :- i/DatabaseMetadata]
  (log/infof "Found new version for DB: %s" (:version db-metadata))
  (t2/update! Database (u/the-id database)
              {:details
               (assoc (:details database) :version (:version db-metadata))}))

Create a single new table in the database, or mark it as active if it already exists.

(defn create-or-reactivate-table!
  [database {schema :schema table-name :name :as table}]
  (let [;; if this is a crufty table, mark initial sync as complete since we'll skip the subsequent sync steps
        is-crufty?          (is-crufty-table? table)
        initial-sync-status (if is-crufty? "complete" "incomplete")
        visibility-type     (when is-crufty? :cruft)]
    (if-let [existing-id (t2/select-one-pk Table
                                           :db_id (u/the-id database)
                                           :schema schema
                                           :name table-name
                                           :active false)]
      ;; if the table already exists but is marked *inactive*, mark it as *active*
      (t2/update! Table existing-id
                  {:active              true
                   :visibility_type     visibility-type
                   :initial_sync_status initial-sync-status})
      ;; otherwise create a new Table
      (first (t2/insert-returning-instances! Table
                                             :db_id (u/the-id database)
                                             :schema schema
                                             :description (:description table)
                                             :database_require_filter (:database_require_filter table)
                                             :name table-name
                                             :display_name (humanization/name->human-readable-name table-name)
                                             :active true
                                             :visibility_type visibility-type
                                             :initial_sync_status initial-sync-status)))))

TODO - should we make this logic case-insensitive like it is for fields?

Create new-tables for database, or if they already exist, mark them as active.

(mu/defn ^:private create-or-reactivate-tables!
  [database :- i/DatabaseInstance
   new-tables :- [:set i/DatabaseMetadataTable]]
  (log/info "Found new tables:"
            (for [table new-tables]
              (sync-util/name-for-logging (mi/instance Table table))))
  (doseq [table new-tables]
    (create-or-reactivate-table! database table)))

Mark any old-tables belonging to database as inactive.

(mu/defn ^:private retire-tables!
  [database   :- i/DatabaseInstance
   old-tables :- [:set [:map
                        [:name ::lib.schema.common/non-blank-string]
                        [:schema [:maybe ::lib.schema.common/non-blank-string]]]]]
  (log/info "Marking tables as inactive:"
            (for [table old-tables]
              (sync-util/name-for-logging (mi/instance Table table))))
  (doseq [{schema :schema table-name :name :as _table} old-tables]
    (t2/update! Table {:db_id  (u/the-id database)
                       :schema schema
                       :name   table-name
                       :active true}
                {:active false})))

Update the table metadata if it has changed.

(mu/defn ^:private update-table-metadata-if-needed!
  [table-metadata :- i/DatabaseMetadataTable
   metabase-table :- (ms/InstanceOf :model/Table)]
  (log/infof "Updating table metadata for %s" (sync-util/name-for-logging metabase-table))
  (let [to-update-keys [:description :database_require_filter]
        old-table      (select-keys metabase-table to-update-keys)
        new-table      (select-keys (merge
                                     (zipmap to-update-keys (repeat nil))
                                     table-metadata)
                                    to-update-keys)
        [_ changes _]  (data/diff old-table new-table)
        changes        (cond-> changes
                         ;; we only update the description if the initial state is nil
                         ;; because don't want to override the user edited description if it exists
                         (some? (:description old-table))
                         (dissoc changes :description))]
    (doseq [[k v] changes]
      (log/infof "%s of %s changed from %s to %s"
                 k
                 (sync-util/name-for-logging metabase-table)
                 (get metabase-table k)
                 v))
    (when (seq changes)
      (t2/update! :model/Table (:id metabase-table) changes))))
(mu/defn ^:private update-tables-metadata-if-needed!
  [table-metadatas :- [:set i/DatabaseMetadataTable]
   metabase-tables :- [:set (ms/InstanceOf :model/Table)]]
  (let [name+schema->table-metadata (m/index-by (juxt :name :schema) table-metadatas)
        name+schema->metabase-table (m/index-by (juxt :name :schema) metabase-tables)]
    (doseq [name+schema (set/intersection (set (keys name+schema->table-metadata)) (set (keys name+schema->metabase-table)))]
      (update-table-metadata-if-needed! (name+schema->table-metadata name+schema) (name+schema->metabase-table name+schema)))))
(mu/defn ^:private table-set :- [:set i/DatabaseMetadataTable]
  "So there exist tables for the user and metabase metadata tables for internal usage by metabase.
  Get set of user tables only, excluding metabase metadata tables."
  [db-metadata :- i/DatabaseMetadata]
  (into #{}
        (remove metabase-metadata/is-metabase-metadata-table?)
        (:tables db-metadata)))
(mu/defn ^:private db->our-metadata :- [:set i/DatabaseMetadataTable]
  "Return information about what Tables we have for this DB in the Metabase application DB."
  [database :- i/DatabaseInstance]
  (set (t2/select [:model/Table :id :name :schema :description :database_require_filter]
                  :db_id  (u/the-id database)
                  :active true)))

Sync the Tables recorded in the Metabase application database with the ones obtained by calling database's driver's implementation of describe-database. Also syncs the database metadata taken from describe-database if there is any

(mu/defn sync-tables-and-database!
  ([database :- i/DatabaseInstance]
   (sync-tables-and-database! database (fetch-metadata/db-metadata database)))
  ([database :- i/DatabaseInstance db-metadata]
   ;; determine what's changed between what info we have and what's in the DB
   (let [db-tables               (table-set db-metadata)
         name+schema             #(select-keys % [:name :schema])
         name+schema->db-table   (m/index-by name+schema db-tables)
         our-metadata            (db->our-metadata database)
         keep-name+schema-set    (fn [metadata]
                                   (set (map name+schema metadata)))
         [new-tables old-tables] (data/diff
                                  (keep-name+schema-set (set (map name+schema db-tables)))
                                  (keep-name+schema-set (set (map name+schema our-metadata))))]
     ;; update database metadata from database
     (when (some? (:version db-metadata))
       (sync-util/with-error-handling (format "Error creating/reactivating tables for %s"
                                              (sync-util/name-for-logging database))
         (update-database-metadata! database db-metadata)))
     ;; create new tables as needed or mark them as active again
     (when (seq new-tables)
       (let [new-tables-info (set (map #(get name+schema->db-table (name+schema %)) new-tables))]
         (sync-util/with-error-handling (format "Error creating/reactivating tables for %s"
                                                (sync-util/name-for-logging database))
           (create-or-reactivate-tables! database new-tables-info))))
     ;; mark old tables as inactive
     (when (seq old-tables)
       (sync-util/with-error-handling (format "Error retiring tables for %s" (sync-util/name-for-logging database))
         (retire-tables! database old-tables)))
     (sync-util/with-error-handling (format "Error updating table metadata for %s" (sync-util/name-for-logging database))
       ;; we need to fetch the tables again because we might have retired tables in the previous steps
       (update-tables-metadata-if-needed! db-tables (db->our-metadata database)))
     ;; update native download perms for all groups if any tables were added or removed
     (when (or (seq new-tables) (seq old-tables))
       (sync-util/with-error-handling (format "Error updating native download perms for %s" (sync-util/name-for-logging database))
         (doseq [{id :id} (perms-group/non-admin-groups)]
           (perms/update-native-download-permissions! id (u/the-id database)))))
     {:updated-tables (+ (count new-tables) (count old-tables))
      :total-tables   (count our-metadata)})))
 

Utility functions and macros to abstract away some common patterns and operations across the sync processes, such as logging start/end messages.

(ns metabase.sync.util
  (:require
   [clojure.math.numeric-tower :as math]
   [clojure.string :as str]
   [java-time.api :as t]
   [medley.core :as m]
   [metabase.driver :as driver]
   [metabase.driver.util :as driver.u]
   [metabase.events :as events]
   [metabase.models.field :refer [Field]]
   [metabase.models.interface :as mi]
   [metabase.models.task-history :refer [TaskHistory]]
   [metabase.query-processor.interface :as qp.i]
   [metabase.sync.interface :as i]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.registry :as mr]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2])
  (:import
   (java.time.temporal Temporal)))
(set! *warn-on-reflection* true)
(derive ::event :metabase/event)
(def ^:private sync-event-topics
  #{:event/sync-begin
    :event/sync-end
    :event/analyze-begin
    :event/analyze-end
    :event/refingerprint-begin
    :event/refingerprint-end
    :event/cache-field-values-begin
    :event/cache-field-values-end
    :event/sync-metadata-begin
    :event/sync-metadata-end})
(doseq [topic sync-event-topics]
  (derive topic ::event))
(def ^:private Topic
  [:and
   events/Topic
   [:fn
    {:error/message "Sync event deriving from :metabase.sync.util/event"}
    #(isa? % ::event)]])

+----------------------------------------------------------------------------------------------------------------+ | SYNC OPERATION "MIDDLEWARE" | +----------------------------------------------------------------------------------------------------------------+

When using the sync-operation macro below the BODY of the macro will be executed in the context of several different functions below that do things like prevent duplicate operations from being ran simultaneously and taking care of things like event publishing, error handling, and logging.

These basically operate in a middleware pattern, where the various different steps take a function, and return a new function that will execute the original in whatever context or with whatever side effects appropriate for that step.

This looks something like {:sync #{1 2}, :cache #{2 3}} when populated. Key is a type of sync operation, e.g. :sync or :cache; vals are sets of DB IDs undergoing that operation.

TODO - as @salsakran mentioned it would be nice to do this via the DB so we could better support multi-instance setups in the future

(defonce ^:private operation->db-ids (atom {}))

Run f in a way that will prevent it from simultaneously being ran more for a single database more than once for a given operation. This prevents duplicate sync-like operations from taking place for a given DB, e.g. if a user hits the Sync button in the admin panel multiple times.

;; Only one sync-db! for database-id will be allowed at any given moment; duplicates will be ignored (with-duplicate-ops-prevented :sync database-id #(sync-db! database-id))

(defn with-duplicate-ops-prevented
  [operation database-or-id f]
  (fn []
    (when-not (contains? (@operation->db-ids operation) (u/the-id database-or-id))
      (try
        ;; mark this database as currently syncing so we can prevent duplicate sync attempts (#2337)
        (swap! operation->db-ids update operation #(conj (or % #{}) (u/the-id database-or-id)))
        (log/debug "Sync operations in flight:" (m/filter-vals seq @operation->db-ids))
        ;; do our work
        (f)
        ;; always take the ID out of the set when we are through
        (finally
          (swap! operation->db-ids update operation #(disj % (u/the-id database-or-id))))))))

Publish events related to beginning and ending a sync-like process, e.g. :sync-database or :cache-values, for a database-id. f is executed between the logging of the two events.

(mu/defn ^:private with-sync-events
  {:style/indent [:form]}
  ;; we can do everyone a favor and infer the name of the individual begin and sync events
  ([event-name-prefix database-or-id f]
   (letfn [(event-keyword [prefix suffix]
             (keyword (or (namespace event-name-prefix) "event")
                      (str (name prefix) suffix)))]
     (with-sync-events
      (event-keyword event-name-prefix "-begin")
      (event-keyword event-name-prefix "-end")
      database-or-id
      f)))
  ([begin-event-name :- Topic
    end-event-name   :- Topic
    database-or-id
    f]
   (fn []
     (let [start-time    (System/nanoTime)
           tracking-hash (str (random-uuid))]
       (events/publish-event! begin-event-name {:database_id (u/the-id database-or-id), :custom_id tracking-hash})
       (let [return        (f)
             total-time-ms (int (/ (- (System/nanoTime) start-time)
                                   1000000.0))]
         (events/publish-event! end-event-name {:database_id  (u/the-id database-or-id)
                                                :custom_id    tracking-hash
                                                :running_time total-time-ms})
         return)))))

Logs start/finish messages using log-fn, timing f

(defn- with-start-and-finish-logging*
  {:style/indent [:form]}
  [log-fn message f]
  (let [start-time (System/nanoTime)
        _          (log-fn (u/format-color 'magenta "STARTING: %s" message))
        result     (f)]
    (log-fn (u/format-color 'magenta "FINISHED: %s (%s)"
              message
              (u/format-nanoseconds (- (System/nanoTime) start-time))))
    result))

Log message about a process starting, then run f, and then log a message about it finishing. (The final message includes a summary of how long it took to run f.)

(defn- with-start-and-finish-logging
  {:style/indent [:form]}
  [message f]
  (fn []
    (with-start-and-finish-logging* #(log/info %) message f)))

Similar to with-start-and-finish-logging except invokesf` and returns its result and logs at the debug level

(defn with-start-and-finish-debug-logging
  {:style/indent [:form]}
  [message f]
  (with-start-and-finish-logging* #(log/info %) message f))

Disable all QP and DB logging when running BODY. (This should be done for all sync-like processes to avoid cluttering the logs.)

(defn- with-db-logging-disabled
  {:style/indent [:form]}
  [f]
  (fn []
    (binding [qp.i/*disable-qp-logging* true]
      (f))))

Pass the sync operation defined by body to the database's driver's implementation of sync-in-context. This method is used to do things like establish a connection or other driver-specific steps needed for sync operations.

(defn- sync-in-context
  [database f]
  (fn []
    (driver/sync-in-context (driver.u/database->driver database) database
      f)))

TODO: future, expand this to driver level, where the drivers themselves can add to the list of exception classes (like, driver-specific exceptions)

(doseq [klass [java.net.ConnectException
               java.net.NoRouteToHostException
               java.net.UnknownHostException
               com.mchange.v2.resourcepool.CannotAcquireResourceException
               javax.net.ssl.SSLHandshakeException]]
  (derive klass ::exception-class-not-to-retry))

Whether to log exceptions during a sync step and proceed with the rest of the sync process. This is the default behavior. You can disable this for debugging or test purposes.

(def ^:dynamic *log-exceptions-and-continue?*
  true)

Internal implementation of [[with-error-handling]]; use that instead of calling this directly.

(defn do-with-error-handling
  ([f]
   (do-with-error-handling "Error running sync step" f))
  ([message f]
   (try
     (f)
     (catch Throwable e
       (if *log-exceptions-and-continue?*
         (do
           (log/warn e message)
           e)
         (throw (ex-info (format "%s: %s" message (ex-message e)) {} e)))))))

Execute body in a way that catches and logs any Exceptions thrown, and returns nil if they do so. Pass a message to help provide information about what failed for the log message.

The exception classes deriving from :metabase.sync.util/exception-class-not-to-retry are a list of classes tested against exceptions thrown. If there is a match found, the sync is aborted as that error is not considered recoverable for this sync run.

(defmacro with-error-handling
  {:style/indent 1}
  [message & body]
  `(do-with-error-handling ~message (fn [] ~@body)))

Internal implementation of [[sync-operation]]; use that instead of calling this directly.

(mu/defn do-sync-operation
  [operation :- :keyword ; something like `:sync-metadata` or `:refingerprint`
   database  :- (ms/InstanceOf :model/Database)
   message   :- ms/NonBlankString
   f         :- fn?]
  ((with-duplicate-ops-prevented operation database
     (with-sync-events operation database
       (with-start-and-finish-logging message
         (with-db-logging-disabled
           (sync-in-context database
             (partial do-with-error-handling (format "Error in sync step %s" message) f))))))))

Perform the operations in body as a sync operation, which wraps the code in several special macros that do things like error handling, logging, duplicate operation prevention, and event publishing. Intended for use with the various top-level sync operations, such as sync-metadata or analyze.

(defmacro sync-operation
  {:style/indent 3}
  [operation database message & body]
  `(do-sync-operation ~operation ~database ~message (fn [] ~@body)))

+----------------------------------------------------------------------------------------------------------------+ | EMOJI PROGRESS METER | +----------------------------------------------------------------------------------------------------------------+

This is primarily provided because it makes sync more fun to look at. The functions below make it fairly simple to log a progress bar with a corresponding emoji when iterating over a sequence of objects during sync, e.g. syncing all the Tables in a given Database.

(def ^:private ^:const ^Integer emoji-meter-width 50)
(def ^:private progress-emoji
  ["😱"   ; face screaming in fear
   "😢"   ; crying face
   "😞"   ; disappointed face
   "😒"   ; unamused face
   "😕"   ; confused face
   "😐"   ; neutral face
   "😬"   ; grimacing face
   "😌"   ; relieved face
   "😏"   ; smirking face
   "😋"   ; face savouring delicious food
   "😊"   ; smiling face with smiling eyes
   "😍"   ; smiling face with heart shaped eyes
   "😎"]) ; smiling face with sunglasses
(defn- percent-done->emoji [percent-done]
  (progress-emoji (int (math/round (* percent-done (dec (count progress-emoji)))))))

Create a string that shows progress for something, e.g. a database sync process.

(emoji-progress-bar 10 40) -> "[****······································] 😒 25%

(defn emoji-progress-bar
  [completed total log-every-n]
  (let [percent-done (float (/ completed total))
        filleds      (int (* percent-done emoji-meter-width))
        blanks       (- emoji-meter-width filleds)]
    (when (or (zero? (mod completed log-every-n))
              (= completed total))
      (str "["
           (str/join (repeat filleds "*"))
           (str/join (repeat blanks "·"))
           (format "] %s  %3.0f%%" (u/emoji (percent-done->emoji percent-done)) (* percent-done 100.0))))))

Run BODY with access to a function that makes using our amazing emoji-progress-bar easy like Sunday morning. Calling the function will return the approprate string output for logging and automatically increment an internal counter as needed.

(with-emoji-progress-bar [progress-bar 10] (dotimes [i 10] (println (progress-bar))))

(defmacro with-emoji-progress-bar
  {:style/indent 1}
  [[emoji-progress-fn-binding total-count] & body]
  `(let [finished-count#            (atom 0)
         total-count#               ~total-count
         log-every-n#               (Math/ceil (/ total-count# 10))
         ~emoji-progress-fn-binding (fn [] (emoji-progress-bar (swap! finished-count# inc) total-count# log-every-n#))]
     ~@body))

+----------------------------------------------------------------------------------------------------------------+ | INITIAL SYNC STATUS | +----------------------------------------------------------------------------------------------------------------+

If this is the first sync of a database, we need to update the initial_sync_status field on individual tables when they have finished syncing, as well as the corresponding field on the database itself when the entire sync is complete (excluding analysis). This powers a UX that displays the progress of the initial sync to the admin who added the database, and enables individual tables when they become usable for queries.

Marks initial sync as complete for this table so that it becomes usable in the UI, if not already set

(defn set-initial-table-sync-complete!
  [table]
  (when (not= (:initial_sync_status table) "complete")
    (t2/update! :model/Table (u/the-id table) {:initial_sync_status "complete"})))

Marks initial sync as complete for this database so that this is reflected in the UI, if not already set

(defn set-initial-database-sync-complete!
  [database]
  (when (not= (:initial_sync_status database) "complete")
    (t2/update! :model/Database (u/the-id database) {:initial_sync_status "complete"})))

Marks initial sync as aborted for this database so that an error can be displayed on the UI

(defn set-initial-database-sync-aborted!
  [database]
  (when (not= (:initial_sync_status database) "complete")
    (t2/update! :model/Database (u/the-id database) {:initial_sync_status "aborted"})))

+----------------------------------------------------------------------------------------------------------------+ | OTHER SYNC UTILITY FUNCTIONS | +----------------------------------------------------------------------------------------------------------------+

Return all the Tables that should go through the sync processes for database-or-id.

(defn db->sync-tables
  [database-or-id]
  (t2/select :model/Table, :db_id (u/the-id database-or-id), :active true, :visibility_type nil))

Return an appropriate string for logging an object in sync logging messages. Should be something like

"postgres Database 'test-data'"

This function is used all over the sync code to make sure we have easy access to consistently formatted descriptions of various objects.

(defmulti name-for-logging
  {:arglists '([instance])}
  mi/model)
(defmethod name-for-logging :model/Database
  [{database-name :name, id :id, engine :engine,}]
  (format "%s Database %s ''%s''" (name engine) (str (or id "")) database-name))
(defmethod name-for-logging :model/Table [{schema :schema, id :id, table-name :name}]
  (format "Table %s ''%s''" (or (str id) "") (str (when (seq schema) (str schema ".")) table-name)))
(defmethod name-for-logging Field [{field-name :name, id :id}]
  (format "Field %s ''%s''" (or (str id) "") field-name))

this is used for result metadata stuff.

(defmethod name-for-logging :default [{field-name :name}]
  (format "Field ''%s''" field-name))
(mu/defn calculate-duration-str :- :string
  "Given two datetimes, caculate the time between them, return the result as a string"
  [begin-time :- (ms/InstanceOfClass Temporal)
   end-time   :- (ms/InstanceOfClass Temporal)]
  (u/format-nanoseconds (.toNanos (t/duration begin-time end-time))))

Metadata common to both sync steps and an entire sync/analyze operation run

(def ^:private TimedSyncMetadata
  [:map
   [:start-time (ms/InstanceOfClass Temporal)]
   [:end-time   (ms/InstanceOfClass Temporal)]])
(mr/def ::StepRunMetadata
  [:merge
   TimedSyncMetadata
   [:map
    [:log-summary-fn [:maybe [:=> [:cat :string] [:ref ::StepRunMetadata]]]]]])

Map with metadata about the step. Contains both generic information like start-time and end-time and step specific information

(def ^:private StepRunMetadata
  [:ref ::StepRunMetadata])
(mr/def ::StepNameWithMetadata
  [:tuple
   ;; step name
   :string
   ;; step metadata
   StepRunMetadata])

Pair with the step name and metadata about the completed step run

(def StepNameWithMetadata
  [:ref ::StepNameWithMetadata])

Timing and step information for the entire sync or analyze run

(def ^:private SyncOperationMetadata
  [:merge
   TimedSyncMetadata
   [:map
    [:steps [:maybe [:sequential StepNameWithMetadata]]]]])

A log summary function takes a StepRunMetadata and returns a string with a step-specific log message

(def ^:private LogSummaryFunction
  [:=> [:cat :string] StepRunMetadata])

Defines a step. :sync-fn runs the step, returns a map that contains step specific metadata. log-summary-fn takes that metadata and turns it into a string for logging

(def ^:private StepDefinition
  [:map
   [:sync-fn        [:=> [:cat StepRunMetadata] i/DatabaseInstance]]
   [:step-name      :string]
   [:log-summary-fn [:maybe LogSummaryFunction]]])

Creates and returns a step suitable for run-step-with-metadata. See StepDefinition for more info.

(defn create-sync-step
  ([step-name sync-fn]
   (create-sync-step step-name sync-fn nil))
  ([step-name sync-fn log-summary-fn]
   {:sync-fn        sync-fn
    :step-name      step-name
    :log-summary-fn (when log-summary-fn
                      (comp str log-summary-fn))}))
(mu/defn run-step-with-metadata :- StepNameWithMetadata
  "Runs `step` on `database` returning metadata from the run"
  [database :- i/DatabaseInstance
   {:keys [step-name sync-fn log-summary-fn] :as _step} :- StepDefinition]
  (let [start-time (t/zoned-date-time)
        results    (with-start-and-finish-debug-logging (format "step ''%s'' for %s"
                                                                step-name
                                                                (name-for-logging database))
                     (fn [& args]
                       (try
                         (apply sync-fn database args)
                         (catch Throwable e
                           (if *log-exceptions-and-continue?*
                             (do
                               (log/warn e (format "Error running step ''%s'' for %s" step-name (name-for-logging database)))
                               {:throwable e})
                             (throw (ex-info (format "Error in sync step %s: %s" step-name (ex-message e)) {} e)))))))
        end-time   (t/zoned-date-time)]
    [step-name (assoc results
                      :start-time start-time
                      :end-time end-time
                      :log-summary-fn log-summary-fn)]))

The logging logic from log-sync-summary. Separated for testing purposes as the log/debug macro won't invoke this function unless the logging level is at debug (or higher).

(mu/defn ^:private make-log-sync-summary-str
  [operation :- :string
   database :- i/DatabaseInstance
   {:keys [start-time end-time steps]} :- SyncOperationMetadata]
  (str
   (apply format
          (str "\n#################################################################\n"
               "# %s\n"
               "# %s\n"
               "# %s\n"
               "# %s\n")
          [(format "Completed %s on %s" operation (:name database))
           (format "Start: %s" (u.date/format start-time))
           (format "End: %s" (u.date/format end-time))
           (format "Duration: %s" (calculate-duration-str start-time end-time))])
   (apply str (for [[step-name {:keys [start-time end-time log-summary-fn] :as step-info}] steps]
                (apply format (str "# ---------------------------------------------------------------\n"
                                   "# %s\n"
                                   "# %s\n"
                                   "# %s\n"
                                   "# %s\n"
                                   (when log-summary-fn
                                       (format "# %s\n" (log-summary-fn step-info))))
                       [(format "Completed step ''%s''" step-name)
                        (format "Start: %s" (u.date/format start-time))
                        (format "End: %s" (u.date/format end-time))
                        (format "Duration: %s" (calculate-duration-str start-time end-time))])))
   "#################################################################\n"))

Log a sync/analyze summary message with info from each step

(mu/defn ^:private  log-sync-summary
  [operation :- :string
   database :- i/DatabaseInstance
   sync-metadata :- SyncOperationMetadata]
  ;; Note this needs to either stay nested in the `debug` macro call or be guarded by an log/enabled?
  ;; call. Constructing the log below requires some work, no need to incur that cost debug logging isn't enabled
  (log/debug (make-log-sync-summary-str operation database sync-metadata)))
(def ^:private SyncOperationOrStepRunMetadata
  [:multi
   {:dispatch
    #(contains? % :steps)}
   [true  SyncOperationMetadata]
   [false StepRunMetadata]])
(mu/defn ^:private create-task-history
  [task-name :- ms/NonBlankString
   database  :- i/DatabaseInstance
   {:keys [start-time end-time]} :- SyncOperationOrStepRunMetadata]
  {:task       task-name
   :db_id      (u/the-id database)
   :started_at start-time
   :ended_at   end-time
   :duration   (.toMillis (t/duration start-time end-time))})
(mu/defn ^:private store-sync-summary!
  [operation :- :string
   database  :- i/DatabaseInstance
   {:keys [steps] :as sync-md} :- SyncOperationMetadata]
  (try
    (->> (for [[step-name step-info] steps
               :let                  [task-details (dissoc step-info :start-time :end-time :log-summary-fn)]]
           (assoc (create-task-history step-name database step-info)
                  :task_details (when (seq task-details)
                                  task-details)))
         (cons (create-task-history operation database sync-md))
         ;; can't do `(t2/insert-returning-instances!)` with a seq because of this bug https://github.com/camsaul/toucan2/issues/130
         (map #(t2/insert-returning-pks! TaskHistory %))
         (map first)
         doall)
    (catch Throwable e
      (log/warn e  "Error saving task history"))))
(defn- do-not-retry-exception? [e]
  (or (isa? (class e) ::exception-class-not-to-retry)
      (some-> (ex-cause e) recur)))

Given the results of a sync step, returns truthy if a non-recoverable exception occurred

(defn abandon-sync?
  [step-results]
  (when-let [caught-exception (:throwable step-results)]
    (do-not-retry-exception? caught-exception)))

Run sync-steps and log a summary message

(mu/defn run-sync-operation
  [operation :- :string
   database :- i/DatabaseInstance
   sync-steps :- [:maybe [:sequential StepDefinition]]]
  (let [start-time    (t/zoned-date-time)
        step-metadata (loop [[step-defn & rest-defns] sync-steps
                             result                   []]
                        (let [[step-name r] (run-step-with-metadata database step-defn)
                              new-result    (conj result [step-name r])]
                          (cond (abandon-sync? r) new-result
                                (not (seq rest-defns)) new-result
                                :else (recur rest-defns new-result))))
        end-time      (t/zoned-date-time)
        sync-metadata {:start-time start-time
                       :end-time   end-time
                       :steps      step-metadata}]
    (store-sync-summary! operation database sync-metadata)
    (log-sync-summary operation database sync-metadata)
    sync-metadata))

Similar to a 2-arg call to map, but will add all numbers that result from the invocations of f. Used mainly for logging purposes, such as to count and log the number of Fields updated by a sync operation. See also sum-for, a for-style macro version.

(defn sum-numbers
  [f coll]
  (reduce + (for [item coll
                  :let [result (f item)]
                  :when (number? result)]
              result)))

Impl for sum-for macro; see its docstring;

(defn sum-for*
  [results]
  (reduce + (filter number? results)))

Basically the same as for, but sums the results of each iteration of body that returned a number. See also sum-numbers.

As an added bonus, unlike normal for, this wraps body in an implicit do, so you can have more than one form inside the loop. Nice

(defmacro sum-for
  {:style/indent 1}
  [[item-binding coll & more-for-bindings] & body]
  `(sum-for* (for [~item-binding ~coll
                   ~@more-for-bindings]
               (do ~@body))))
 

Background task scheduling via Quartzite. Individual tasks are defined in metabase.task.*.

Regarding Task Initialization:

The most appropriate way to initialize tasks in any metabase.task.* namespace is to implement the task-init function which accepts zero arguments. This function is dynamically resolved and called exactly once when the application goes through normal startup procedures. Inside this function you can do any work needed and add your task to the scheduler as usual via schedule-task!.

Quartz JavaDoc

Find the JavaDoc for Quartz here: http://www.quartz-scheduler.org/api/2.3.0/index.html

(ns metabase.task
  (:require
   [clojure.string :as str]
   [clojurewerkz.quartzite.scheduler :as qs]
   [environ.core :as env]
   [metabase.db :as mdb]
   [metabase.db.connection :as mdb.connection]
   [metabase.plugins.classloader :as classloader]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms])
  (:import
   (org.quartz CronTrigger JobDetail JobKey Scheduler Trigger TriggerKey)))
(set! *warn-on-reflection* true)

+----------------------------------------------------------------------------------------------------------------+ | SCHEDULER INSTANCE | +----------------------------------------------------------------------------------------------------------------+

Override the global Quartz scheduler by binding this var.

(defonce ^:dynamic 
  *quartz-scheduler*
  (atom nil))

Fetch the instance of our Quartz scheduler.

(defn- scheduler
  ^Scheduler []
  @*quartz-scheduler*)

+----------------------------------------------------------------------------------------------------------------+ | FINDING & LOADING TASKS | +----------------------------------------------------------------------------------------------------------------+

Initialize (i.e., schedule) Job(s) with a given name. All implementations of this method are called once and only once when the Quartz task scheduler is initialized. Task namespaces (metabase.task.*) should add new implementations of this method to schedule the jobs they define (i.e., with a call to schedule-task!.)

The dispatch value for this function can be any unique keyword, but by convention is a namespaced keyword version of the name of the Job being initialized; for sake of consistency with the Job name itself, the keyword should be left CamelCased.

(defmethod task/init! ::SendPulses [_] (task/schedule-task! my-job my-trigger))

(defmulti init!
  {:arglists '([job-name-string])}
  keyword)

Search Classpath for namespaces that start with metabase.tasks., then require them so initialization can happen.

(defn- find-and-load-task-namespaces!
  []
  (doseq [ns-symb u/metabase-namespace-symbols
          :when   (.startsWith (name ns-symb) "metabase.task.")]
    (try
      (log/debug "Loading tasks namespace:" (u/format-color 'blue ns-symb))
      (classloader/require ns-symb)
      (catch Throwable e
        (log/errorf e "Error loading tasks namespace %s" ns-symb)))))

Call all implementations of init!

(defn- init-tasks!
  []
  (doseq [[k f] (methods init!)]
    (try
      ;; don't bother logging namespace for now, maybe in the future if there's tasks of the same name in multiple
      ;; namespaces we can log it
      (log/infof "Initializing task %s" (u/format-color 'green (name k)) (u/emoji "📆"))
      (f k)
      (catch Throwable e
        (log/error e "Error initializing task {0}" k)))))

+----------------------------------------------------------------------------------------------------------------+ | Quartz Scheduler Connection Provider | +----------------------------------------------------------------------------------------------------------------+

Custom ConnectionProvider implementation that uses our application DB connection pool to provide connections.

(defrecord ^:private ConnectionProvider []
  org.quartz.utils.ConnectionProvider
  (initialize [_])
  (getConnection [_]
    ;; get a connection from our application DB connection pool. Quartz will close it (i.e., return it to the pool)
    ;; when it's done
    ;;
    ;; very important! Fetch a new connection from the connection pool rather than using currently bound Connection if
    ;; one already exists -- because Quartz will close this connection when done, we don't want to screw up the
    ;; calling block
    ;;
    ;; in a perfect world we could just check whether we're creating a new Connection or not, and if using an existing
    ;; Connection, wrap it in a delegating proxy wrapper that makes `.close()` a no-op but forwards all other methods.
    ;; Now that would be a useful macro!
    (.getConnection mdb.connection/*application-db*))
  (shutdown [_]))
(when-not *compile-files*
  (System/setProperty "org.quartz.dataSource.db.connectionProvider.class" (.getName ConnectionProvider)))

+----------------------------------------------------------------------------------------------------------------+ | Quartz Scheduler Class Load Helper | +----------------------------------------------------------------------------------------------------------------+

(defn- load-class ^Class [^String class-name]
  (Class/forName class-name true (classloader/the-classloader)))
(defrecord ^:private ClassLoadHelper []
  org.quartz.spi.ClassLoadHelper
  (initialize [_])
  (getClassLoader [_]
    (classloader/the-classloader))
  (loadClass [_ class-name]
    (load-class class-name))
  (loadClass [_ class-name _]
    (load-class class-name)))
(when-not *compile-files*
  (System/setProperty "org.quartz.scheduler.classLoadHelper.class" (.getName ClassLoadHelper)))

+----------------------------------------------------------------------------------------------------------------+ | STARTING/STOPPING SCHEDULER | +----------------------------------------------------------------------------------------------------------------+

Set the appropriate system properties needed so Quartz can connect to the JDBC backend. (Since we don't know our DB connection properties ahead of time, we'll need to set these at runtime rather than Setting them in the quartz.properties file.)

(defn- set-jdbc-backend-properties!
  []
  (when (= (mdb/db-type) :postgres)
    (System/setProperty "org.quartz.jobStore.driverDelegateClass" "org.quartz.impl.jdbcjobstore.PostgreSQLDelegate")))

Initialize our Quartzite scheduler which allows jobs to be submitted and triggers to scheduled. Puts scheduler in standby mode. Call [[start-scheduler!]] to begin running scheduled tasks.

(defn- init-scheduler!
  []
  (classloader/the-classloader)
  (when-not @*quartz-scheduler*
    (set-jdbc-backend-properties!)
    (let [new-scheduler (qs/initialize)]
      (when (compare-and-set! *quartz-scheduler* nil new-scheduler)
        (find-and-load-task-namespaces!)
        (qs/standby new-scheduler)
        (log/info "Task scheduler initialized into standby mode.")
        (init-tasks!)))))

this is a function mostly to facilitate testing.

(defn- disable-scheduler? []
  (some-> (env/env :mb-disable-scheduler) Boolean/parseBoolean))

Start the task scheduler. Tasks do not run before calling this function.

(defn start-scheduler!
  []
  (if (disable-scheduler?)
    (log/warn  "Metabase task scheduler disabled. Scheduled tasks will not be ran.")
    (do (init-scheduler!)
        (qs/start (scheduler))
        (log/info "Task scheduler started"))))

Stop our Quartzite scheduler and shutdown any running executions.

(defn stop-scheduler!
  []
  (let [[old-scheduler] (reset-vals! *quartz-scheduler* nil)]
    (when old-scheduler
      (qs/shutdown old-scheduler))))

+----------------------------------------------------------------------------------------------------------------+ | SCHEDULING/DELETING TASKS | +----------------------------------------------------------------------------------------------------------------+

(mu/defn ^:private reschedule-task!
  [job :- (ms/InstanceOfClass JobDetail) new-trigger :- (ms/InstanceOfClass Trigger)]
  (try
    (when-let [scheduler (scheduler)]
      (when-let [[^Trigger old-trigger] (seq (qs/get-triggers-of-job scheduler (.getKey ^JobDetail job)))]
        (log/debugf "Rescheduling job %s" (-> ^JobDetail job .getKey .getName))
        (.rescheduleJob scheduler (.getKey old-trigger) new-trigger)))
    (catch Throwable e
      (log/error e "Error rescheduling job"))))

Add a given job and trigger to our scheduler.

(mu/defn schedule-task!
  [job :- (ms/InstanceOfClass JobDetail) trigger :- (ms/InstanceOfClass Trigger)]
  (when-let [scheduler (scheduler)]
    (try
      (qs/schedule scheduler job trigger)
      (catch org.quartz.ObjectAlreadyExistsException _
        (log/debug "Job already exists:" (-> ^JobDetail job .getKey .getName))
        (reschedule-task! job trigger)))))

delete a task from the scheduler

(mu/defn delete-task!
  [job-key :- (ms/InstanceOfClass JobKey) trigger-key :- (ms/InstanceOfClass TriggerKey)]
  (when-let [scheduler (scheduler)]
    (qs/delete-trigger scheduler trigger-key)
    (qs/delete-job scheduler job-key)))

Add a job separately from a trigger, replace if the job is already there

(mu/defn add-job!
  [job :- (ms/InstanceOfClass JobDetail)]
  (when-let [scheduler (scheduler)]
    (qs/add-job scheduler job true)))

Add a trigger. Assumes the trigger is already associated to a job (i.e. trigger/for-job)

(mu/defn add-trigger!
  [trigger :- (ms/InstanceOfClass Trigger)]
  (when-let [scheduler (scheduler)]
    (qs/add-trigger scheduler trigger)))

Remove trigger-key from the scheduler

(mu/defn delete-trigger!
  [trigger-key :- (ms/InstanceOfClass TriggerKey)]
  (when-let [scheduler (scheduler)]
    (qs/delete-trigger scheduler trigger-key)))

+----------------------------------------------------------------------------------------------------------------+ | Scheduler Info | +----------------------------------------------------------------------------------------------------------------+

(defn- job-detail->info [^JobDetail job-detail]
  {:key                              (-> (.getKey job-detail) .getName)
   :class                            (-> (.getJobClass job-detail) .getCanonicalName)
   :description                      (.getDescription job-detail)
   :concurrent-execution-disallowed? (.isConcurrentExectionDisallowed job-detail)
   :durable?                         (.isDurable job-detail)
   :requests-recovery?               (.requestsRecovery job-detail)})
(defmulti ^:private trigger->info
  {:arglists '([trigger])}
  class)
(defmethod trigger->info Trigger
  [^Trigger trigger]
  {:description        (.getDescription trigger)
   :end-time           (.getEndTime trigger)
   :final-fire-time    (.getFinalFireTime trigger)
   :key                (-> (.getKey trigger) .getName)
   :state              (some->> (.getKey trigger) (.getTriggerState (scheduler)) str)
   :next-fire-time     (.getNextFireTime trigger)
   :previous-fire-time (.getPreviousFireTime trigger)
   :priority           (.getPriority trigger)
   :start-time         (.getStartTime trigger)
   :may-fire-again?    (.mayFireAgain trigger)
   :data               (.getJobDataMap trigger)})
(defmethod trigger->info CronTrigger
  [^CronTrigger trigger]
  (assoc
   ((get-method trigger->info Trigger) trigger)
   :schedule
   (.getCronExpression trigger)

   :misfire-instruction
   ;; not 100% sure why `case` doesn't work here...
   (condp = (.getMisfireInstruction trigger)
     CronTrigger/MISFIRE_INSTRUCTION_IGNORE_MISFIRE_POLICY "IGNORE_MISFIRE_POLICY"
     CronTrigger/MISFIRE_INSTRUCTION_SMART_POLICY          "SMART_POLICY"
     CronTrigger/MISFIRE_INSTRUCTION_FIRE_ONCE_NOW         "FIRE_ONCE_NOW"
     CronTrigger/MISFIRE_INSTRUCTION_DO_NOTHING            "DO_NOTHING"
     (format "UNKNOWN: %d" (.getMisfireInstruction trigger)))))
(defn- ->job-key ^JobKey [x]
  (cond
    (instance? JobKey x) x
    (string? x)          (JobKey. ^String x)))

Get info about a specific Job (job-key can be either a String or JobKey).

(task/job-info "metabase.task.sync-and-analyze.job")

(defn job-info
  [job-key]
  (when-let [scheduler (scheduler)]
    (let [job-key (->job-key job-key)]
      (try
        (assoc (job-detail->info (qs/get-job scheduler job-key))
               :triggers (for [trigger (sort-by #(-> ^Trigger % .getKey .getName)
                                                (qs/get-triggers-of-job scheduler job-key))]
                           (trigger->info trigger)))
        (catch ClassNotFoundException _
          (log/infof "Class not found for Quartz Job %s. This probably means that this job was removed or renamed." (.getName job-key)))
        (catch Throwable e
          (log/warnf e "Error fetching details for Quartz Job: %s" (.getName job-key)))))))
(defn- jobs-info []
  (->> (some-> (scheduler) (.getJobKeys nil))
       (sort-by #(.getName ^JobKey %))
       (map job-info)
       (filter some?)))

Return raw data about all the scheduler and scheduled tasks (i.e. Jobs and Triggers). Primarily for debugging purposes.

(defn scheduler-info
  []
  {:scheduler (some-> (scheduler) .getMetaData .getSummary str/split-lines)
   :jobs      (jobs-info)})
 
(ns metabase.task.email-remove-legacy-pulse
  (:require
   [clojurewerkz.quartzite.jobs :as jobs]
   [clojurewerkz.quartzite.triggers :as triggers]
   [metabase.email :as email]
   [metabase.pulse]
   [metabase.task :as task]
   [metabase.util.log :as log]
   [metabase.util.urls :as urls]
   [stencil.core :as stencil]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)
(defn- has-legacy-pulse? []
  (pos? (t2/count :model/Pulse :dashboard_id nil :alert_condition nil :archived false)))
(def ^:private template-path (str "metabase/email/warn_deprecate_pulse.mustache"))
(defn- email-remove-legacy-pulse []
  (when (and (email/email-configured?)
             (has-legacy-pulse?))
    (log/info "Sending email to admins about removal of legacy pulses")
    (let [legacy-pulse (->> (t2/select :model/Pulse :dashboard_id nil :alert_condition nil :archived false)
                            (map #(assoc % :url (urls/legacy-pulse-url (:id %)))))]
      (doseq [admin (t2/select :model/User :is_superuser true)]
        (email/send-message-or-throw!
         {:recipients   [(:email admin)]
          :message-type :html
          :subject      "[Metabase] Removal of legacy pulses in upcoming Metabase release"
          :message      (stencil/render-file template-path {:userName    (:common_name admin)
                                                            :pulses      legacy-pulse
                                                            :instanceURL (urls/site-url)})})))))

Send email to admins and warn about removal of Pulse in 49, This job will only run once.

(jobs/defjob 
  EmailRemoveLegacyPulse [_ctx]
  (email-remove-legacy-pulse))
(defmethod task/init! ::SendWarnPulseRemovalEmail [_job-name]
  (let [job     (jobs/build
                 (jobs/of-type EmailRemoveLegacyPulse)
                 (jobs/with-identity (jobs/key "metabase.task.email-remove-legacy-pulse.job"))
                 (jobs/store-durably))
        trigger (triggers/build
                 (triggers/with-identity (triggers/key "metabase.task.email-remove-legacy-pulse.trigger"))
                 (triggers/start-now))]
    (task/schedule-task! job trigger)))
 

Tasks which follow up with Metabase users.

(ns metabase.task.follow-up-emails
  (:require
   [clojurewerkz.quartzite.jobs :as jobs]
   [clojurewerkz.quartzite.schedule.cron :as cron]
   [clojurewerkz.quartzite.triggers :as triggers]
   [java-time.api :as t]
   [metabase.email :as email]
   [metabase.email.messages :as messages]
   [metabase.models.setting :as setting]
   [metabase.models.user :as user :refer [User]]
   [metabase.public-settings :as public-settings]
   [metabase.task :as task]
   [metabase.util.date-2 :as u.date]
   [metabase.util.log :as log]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

+----------------------------------------------------------------------------------------------------------------+ | send follow-up emails | +----------------------------------------------------------------------------------------------------------------+

Have we sent a follow up email to the instance admin?

(setting/defsetting ^:private follow-up-email-sent
  ;; No need to i18n this as it's not user facing
  :type       :boolean
  :default    false
  :visibility :internal
  :audit      :never)

Send an email to the instance admin following up on their experience with Metabase thus far.

(defn- send-follow-up-email!
  []
  ;; we need access to email AND the instance must be opted into anonymous tracking. Make sure email hasn't been sent yet
  (when (and (email/email-configured?)
             (public-settings/anon-tracking-enabled)
             (not (follow-up-email-sent)))
    ;; grab the oldest admins email address (likely the user who created this MB instance), that's who we'll send to
    ;; TODO - Does it make to send to this user instead of `(public-settings/admin-email)`?
    (when-let [admin (t2/select-one User :is_superuser true, :is_active true, {:order-by [:date_joined]})]
      (try
        (messages/send-follow-up-email! (:email admin))
        (catch Throwable e
          (log/error "Problem sending follow-up email:" e))
        (finally
          (follow-up-email-sent! true))))))

The date this Metabase instance was created. We use the :date_joined of the first User to determine this.

(defn- instance-creation-timestamp
  ^java.time.temporal.Temporal []
  (t2/select-one-fn :date_joined User, {:order-by [[:date_joined :asc]]}))

Sends out a general 2 week email follow up email

(jobs/defjob  FollowUpEmail [_]
  ;; if we've already sent the follow-up email then we are done
  (when-not (follow-up-email-sent)
    ;; figure out when we consider the instance created
    (when-let [instance-created (instance-creation-timestamp)]
      ;; we need to be 2+ weeks from creation to send the follow up
      (when (u.date/older-than? instance-created (t/weeks 2))
        (send-follow-up-email!)))))
(def ^:private follow-up-emails-job-key     "metabase.task.follow-up-emails.job")
(def ^:private follow-up-emails-trigger-key "metabase.task.follow-up-emails.trigger")
(defmethod task/init! ::SendFollowUpEmails [_]
  (let [job     (jobs/build
                 (jobs/of-type FollowUpEmail)
                 (jobs/with-identity (jobs/key follow-up-emails-job-key)))
        trigger (triggers/build
                 (triggers/with-identity (triggers/key follow-up-emails-trigger-key))
                 (triggers/start-now)
                 (triggers/with-schedule
                   ;; run once a day
                   (cron/cron-schedule "0 0 12 * * ? *")))]
    (task/schedule-task! job trigger)))
 
(ns metabase.task.index-values
  (:require
   [clojurewerkz.quartzite.conversion :as qc]
   [clojurewerkz.quartzite.jobs :as jobs]
   [clojurewerkz.quartzite.schedule.cron :as cron]
   [clojurewerkz.quartzite.triggers :as triggers]
   [metabase.driver :as driver]
   [metabase.models.card :refer [Card]]
   [metabase.models.model-index :as model-index :refer [ModelIndex]]
   [metabase.query-processor.timezone :as qp.timezone]
   [metabase.task :as task]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [toucan2.core :as t2])
  (:import
   (java.util TimeZone)
   (org.quartz ObjectAlreadyExistsException)))
(set! *warn-on-reflection* true)

States of a model index that are refreshable.

#_{:clj-kondo/ignore [:unused-private-var]}
(def ^:private refreshable-states
  #{"indexed" "initial" "error" "overflow"})

Whether to unindex the the model indexing job. Will deindex if the model or model_index do not exist, if the model is no longer a model, or if archived.

(defn- should-deindex?
  [model model-index]
  (or (nil? model) (nil? model-index)
      (not (:dataset model))
      (:archived model)))
(defn- model-index-trigger-key
  [model-index-id]
  (triggers/key
   (format "metabase.task.IndexValues.trigger.%d" model-index-id)))

Refresh the index on a model. Note, if the index should be removed (no longer a model, archived, etc, (see [[should-deindex?]])) will delete the indexing job.

(defn- refresh-index!
  [model-index-id]
  (let [model-index              (t2/select-one ModelIndex :id model-index-id)
        model                    (when model-index
                                   (t2/select-one Card :id (:model_id model-index)))]
    (if (should-deindex? model model-index)
      (u/ignore-exceptions
       (let [trigger-key (model-index-trigger-key model-index-id)]
         (task/delete-trigger! trigger-key)
         (t2/delete! ModelIndex model-index-id)))
      (model-index/add-values! model-index))))

Refresh model indexed columns

(jobs/defjob ^{org.quartz.DisallowConcurrentExecution true
               :doc }
  ModelIndexRefresh [job-context]
  (let [{:strs [model-index-id]} (qc/from-job-data job-context)]
    (refresh-index! model-index-id)))

Job key string for refresh job. Call (jobs/key refresh-model-index-key) if you need the org.quartz.JobKey instance.

(def ^:private refresh-model-index-key
  "metabase.task.IndexValues.job")
(def ^:private refresh-job
  (jobs/build
   (jobs/with-description "Indexed Value Refresh task")
   (jobs/of-type ModelIndexRefresh)
   (jobs/with-identity (jobs/key refresh-model-index-key))
   (jobs/store-durably)))
(defn- refresh-trigger ^org.quartz.CronTrigger [model-index]
  (triggers/build
   (triggers/with-description (format "Refresh index on model %d" (:model_id model-index)))
   (triggers/with-identity (model-index-trigger-key (:id model-index)))
   (triggers/using-job-data {"model-index-id" (u/the-id model-index)})
   (triggers/for-job (jobs/key refresh-model-index-key))
   (triggers/start-now)
   (triggers/with-schedule
     (cron/schedule
      (cron/cron-schedule (:schedule model-index))
      (cron/in-time-zone (TimeZone/getTimeZone (or (driver/report-timezone)
                                                   (qp.timezone/system-timezone-id)
                                                   "UTC")))
      (cron/with-misfire-handling-instruction-do-nothing)))))

Public API to start indexing a model.

(defn add-indexing-job
  [model-index]
  (let [trigger (refresh-trigger model-index)]
    (log/info
     (u/format-color :green (trs "Scheduling indexing for model: {0}" (:model_id model-index))))
    (try (task/add-trigger! trigger)
         (catch ObjectAlreadyExistsException _e
           (log/info (u/format-color :red (trs "Index already present for model: {0}"
                                                 (:model_id model-index)))))
         (catch Exception e
           (log/warn (trs "Error scheduling indexing for model: {0}"
                          (:model_id model-index))
                     e)))))

Public API to remove an indexing job on a model.

(defn remove-indexing-job
  [model-index]
  (let [trigger-key (model-index-trigger-key (:id model-index))]
    (task/delete-trigger! trigger-key)))
(defn- job-init!
  []
  (task/add-job! refresh-job))
(defmethod task/init! ::ModelIndexValues
  [_]
  (job-init!))
 
(ns metabase.task.persist-refresh
  (:require
   [clojure.string :as str]
   [clojurewerkz.quartzite.conversion :as qc]
   [clojurewerkz.quartzite.jobs :as jobs]
   [clojurewerkz.quartzite.schedule.cron :as cron]
   [clojurewerkz.quartzite.triggers :as triggers]
   [java-time.api :as t]
   [medley.core :as m]
   [metabase.db :as mdb]
   [metabase.driver :as driver]
   [metabase.driver.ddl.interface :as ddl.i]
   [metabase.driver.sql.query-processor :as sql.qp]
   [metabase.email.messages :as messages]
   [metabase.models.card :refer [Card]]
   [metabase.models.database :refer [Database]]
   [metabase.models.persisted-info
    :as persisted-info
    :refer [PersistedInfo]]
   [metabase.models.task-history :refer [TaskHistory]]
   [metabase.public-settings :as public-settings]
   [metabase.query-processor.middleware.limit :as limit]
   [metabase.query-processor.timezone :as qp.timezone]
   [metabase.task :as task]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [potemkin.types :as p]
   [toucan2.core :as t2])
  (:import
   (java.util TimeZone)
   (org.quartz ObjectAlreadyExistsException Trigger)))
(set! *warn-on-reflection* true)
(defn- job-context->job-type
  [job-context]
  (select-keys (qc/from-job-data job-context) ["db-id" "persisted-id" "type"]))

This protocol is just a wrapper of the ddl.interface multimethods to ease for testing. Rather than defing some multimethods on fake engine types, just work against this, and it will dispatch to the ddl.interface normally, or allow for easy to control custom behavior in tests.

(p/defprotocol+ Refresher
  (refresh! [this database definition dataset-query]
    "Refresh a persisted model. Returns a map with :state that is :success or :error. If :state is :error, includes a
    key :error with a string message. See [[metabase.driver.ddl.interface/refresh!]] for more information.")
  (unpersist! [this database persisted-info]))

Refresher implementation that dispatches to the multimethods in [[metabase.driver.ddl.interface]].

(def ^:private dispatching-refresher
  (reify Refresher
    (refresh! [_ database definition card]
      (binding [persisted-info/*allow-persisted-substitution* false]
        (let [query (limit/disable-max-results (:dataset_query card))]
          (ddl.i/refresh! (:engine database) database definition query))))
    (unpersist! [_ database persisted-info]
     (ddl.i/unpersist! (:engine database) database persisted-info))))
(defn- refresh-with-stats! [refresher database stats persisted-info]
  ;; Since this could be long running, double check state just before refreshing
  (when (contains? (persisted-info/refreshable-states) (t2/select-one-fn :state PersistedInfo :id (:id persisted-info)))
    (log/info (trs "Attempting to refresh persisted model {0}." (:card_id persisted-info)))
    (let [card (t2/select-one Card :id (:card_id persisted-info))
          definition (persisted-info/metadata->definition (:result_metadata card)
                                                          (:table_name persisted-info))
          _ (t2/update! PersistedInfo (u/the-id persisted-info)
                        {:definition definition,
                         :query_hash (persisted-info/query-hash (:dataset_query card))
                         :active false,
                         :refresh_begin :%now,
                         :refresh_end nil,
                         :state "refreshing"
                         :state_change_at :%now})
          {:keys [state error]} (try
                                  (refresh! refresher database definition card)
                                  (catch Exception e
                                    (log/info e (trs "Error refreshing persisting model with card-id {0}"
                                                     (:card_id persisted-info)))
                                    {:state :error :error (ex-message e)}))]
      (t2/update! PersistedInfo (u/the-id persisted-info)
                  {:active (= state :success),
                   :refresh_end :%now,
                   :state (if (= state :success) "persisted" "error")
                   :state_change_at :%now
                   :error (when (= state :error) error)})
      (if (= :success state)
        (update stats :success inc)
        (-> stats
            (update :error-details conj {:persisted-info-id (:id persisted-info)
                                         :error error})
            (update :error inc))))))

Create a task history entry with start, end, and duration. :task will be task-type, db-id is optional, and :task_details will be the result of f.

(defn- save-task-history!
  [task-type db-id f]
  (let [start-time   (t/zoned-date-time)
        task-details (f)
        end-time     (t/zoned-date-time)]
    (when (= task-type "persist-refresh")
      (when-let [error-details (seq (:error-details task-details))]
        (let [error-details-by-id (m/index-by :persisted-info-id error-details)
              persisted-infos (->> (t2/hydrate (t2/select PersistedInfo :id [:in (keys error-details-by-id)])
                                            [:card :collection] :database)
                                   (map #(assoc % :error (get-in error-details-by-id [(:id %) :error]))))]
          (messages/send-persistent-model-error-email!
            db-id
            persisted-infos
            (:trigger task-details)))))
    (t2/insert! TaskHistory {:task         task-type
                             :db_id        db-id
                             :started_at   start-time
                             :ended_at     end-time
                             :duration     (.toMillis (t/duration start-time end-time))
                             :task_details task-details})
    task-details))

Seam for tests to pass in specific deletables to drop.

(defn- prune-deletables!
  [refresher deletables]
  (when (seq deletables)
    (let [db-id->db    (m/index-by :id (t2/select Database :id [:in (map :database_id deletables)]))
          unpersist-fn (fn []
                         (reduce (fn [stats persisted-info]
                                   ;; Since this could be long running, double check state just before deleting
                                   (let [current-state (t2/select-one-fn :state PersistedInfo :id (:id persisted-info))
                                         card-info     (t2/select-one [Card :archived :dataset]
                                                                      :id (:card_id persisted-info))]
                                     (if (or (contains? (persisted-info/prunable-states) current-state)
                                             (:archived card-info)
                                             (not (:dataset card-info)))
                                       (let [database (-> persisted-info :database_id db-id->db)]
                                         (log/info (trs "Unpersisting model with card-id {0}" (:card_id persisted-info)))
                                         (try
                                           (unpersist! refresher database persisted-info)
                                           (when (= "deletable" current-state)
                                             (t2/delete! PersistedInfo :id (:id persisted-info)))
                                           (update stats :success inc)
                                           (catch Exception e
                                             (log/info e (trs "Error unpersisting model with card-id {0}" (:card_id persisted-info)))
                                             (update stats :error inc))))
                                       (update stats :skipped inc))))
                                 {:success 0, :error 0, :skipped 0}
                                 deletables))]
      (save-task-history! "unpersist-tables" nil unpersist-fn))))

Returns persisted info records that can be unpersisted. Will select records that have moved into a deletable state after a sufficient delay to ensure no queries are running against them and to allow changing mind. Also selects persisted info records pointing to cards that are no longer models and archived cards/models.

(defn- deletable-models
  []
  (t2/select PersistedInfo
             {:select    [:p.*]
              :from      [[:persisted_info :p]]
              :left-join [[:report_card :c] [:= :c.id :p.card_id]]
              :where     [:or
                          [:and
                           [:in :state (persisted-info/prunable-states)]
                           ;; Buffer deletions for an hour if the
                           ;; prune job happens soon after setting state.
                           ;; 1. so that people have a chance to change their mind.
                           ;; 2. if a query is running against the cache, it doesn't get ripped out.
                           [:< :state_change_at
                            (sql.qp/add-interval-honeysql-form (mdb/db-type) :%now -1 :hour)]]
                          [:= :c.dataset false]
                          [:= :c.archived true]]}))

Returns refreshable models for a database id. Must still be models and not archived.

(defn- refreshable-models
  [database-id]
  (t2/select PersistedInfo
             {:select    [:p.* :c.dataset :c.archived :c.name]
              :from      [[:persisted_info :p]]
              :left-join [[:report_card :c] [:= :c.id :p.card_id]]
              :where     [:and
                          [:= :p.database_id database-id]
                          [:in :p.state (persisted-info/refreshable-states)]
                          [:= :c.archived false]
                          [:= :c.dataset true]]}))

Prunes all deletable PersistInfos, should not be called from tests as it will orphan cache tables if refresher is replaced.

(defn- prune-all-deletable!
  [refresher]
  (let [deletables (deletable-models)]
    (prune-deletables! refresher deletables)))

Refresh tables backing the persisted models. Updates all persisted tables with that database id which are in a state of "persisted".

(defn- refresh-tables!
  [database-id refresher]
  (log/info (trs "Starting persisted model refresh task for Database {0}." database-id))
  (persisted-info/ready-unpersisted-models! database-id)
  (let [database  (t2/select-one Database :id database-id)
        persisted (refreshable-models database-id)
        thunk     (fn []
                    (reduce (partial refresh-with-stats! refresher database)
                            {:success 0, :error 0, :trigger "Scheduled"}
                            persisted))
        {:keys [error success]} (save-task-history! "persist-refresh" database-id thunk)]
    (log/info
      (trs "Finished persisted model refresh task for Database {0} with {1} successes and {2} errors." database-id success error))))

Refresh an individual model based on [[PersistedInfo]].

(defn- refresh-individual!
  [persisted-info-id refresher]
  (let [persisted-info (t2/select-one PersistedInfo :id persisted-info-id)
        database       (when persisted-info
                         (t2/select-one Database :id (:database_id persisted-info)))]
    (if (and persisted-info database)
      (do
        (save-task-history! "persist-refresh" (u/the-id database)
                            (partial refresh-with-stats!
                                     refresher
                                     database
                                     {:success 0 :error 0, :trigger "Manual"}
                                     persisted-info))
        (log/info (trs "Finished updated model-id {0} from persisted-info {1}."
                       (:card_id persisted-info)
                       (u/the-id persisted-info))))
      (log/info (trs "Unable to refresh model with card-id {0}" (:card_id persisted-info))))))

Refresh tables. Gets the database id from the job context and calls refresh-tables!'.

(defn- refresh-job-fn!
  [job-context]
  (let [{:strs [type db-id persisted-id] :as _payload} (job-context->job-type job-context)]
    (case type
      "database"   (refresh-tables!     db-id        dispatching-refresher)
      "individual" (refresh-individual! persisted-id dispatching-refresher)
      (log/info (trs "Unknown payload type {0}" type)))))
(defn- prune-job-fn!
  [_job-context]
  (prune-all-deletable! dispatching-refresher))

Refresh persisted tables job

(jobs/defjob ^{org.quartz.DisallowConcurrentExecution true
               :doc }
  PersistenceRefresh [job-context]
  (refresh-job-fn! job-context))

Remove deletable persisted tables

(jobs/defjob ^{org.quartz.DisallowConcurrentExecution true
               :doc }
  PersistencePrune [job-context]
  (prune-job-fn! job-context))

Job key string for refresh job. Call (jobs/key refresh-job-key) if you need the org.quartz.JobKey instance.

(def ^:private refresh-job-key
  "metabase.task.PersistenceRefresh.job")

Job key string for prune job. Call (jobs/key prune-job-key) if you need the org.quartz.JobKey instance.

(def ^:private prune-job-key
  "metabase.task.PersistencePrune.job")
(def ^:private refresh-job
  (jobs/build
   (jobs/with-description "Persisted Model refresh task")
   (jobs/of-type PersistenceRefresh)
   (jobs/with-identity (jobs/key refresh-job-key))
   (jobs/store-durably)))
(def ^:private prune-job
  (jobs/build
   (jobs/with-description "Persisted Model prune task")
   (jobs/of-type PersistencePrune)
   (jobs/with-identity (jobs/key prune-job-key))
   (jobs/store-durably)))
(def ^:private prune-scheduled-trigger-key
  (triggers/key "metabase.task.PersistencePrune.scheduled.trigger"))
(def ^:private prune-once-trigger-key
  (triggers/key "metabase.task.PersistencePrune.once.trigger"))
(defn- database-trigger-key [database]
  (triggers/key (format "metabase.task.PersistenceRefresh.database.trigger.%d" (u/the-id database))))
(defn- individual-trigger-key [persisted-info]
  (triggers/key (format "metabase.task.PersistenceRefresh.individual.trigger.%d"
                        (u/the-id persisted-info))))

Return a cron schedule that fires every hours hours.

(defn- cron-schedule
  [cron-spec]
  (cron/schedule
    (cron/cron-schedule cron-spec)
    (cron/in-time-zone (TimeZone/getTimeZone (or (driver/report-timezone)
                                                 (qp.timezone/system-timezone-id)
                                                 "UTC")))
    (cron/with-misfire-handling-instruction-do-nothing)))
(comment
  (let [[start-hour start-minute] (map parse-long (str/split "00:00" #":"))
        hours 1]

     (if (= 24 hours)
         (format "0 %d %d * * ? *" start-minute start-hour)
         (format "0 %d %d/%d * * ? *" start-minute start-hour hours))))
(def ^:private prune-scheduled-trigger
  (triggers/build
    (triggers/with-description "Prune deletable PersistInfo once per hour")
    (triggers/with-identity prune-scheduled-trigger-key)
    (triggers/for-job (jobs/key prune-job-key))
    (triggers/start-now)
    (triggers/with-schedule
      (cron-schedule "0 0 0/1 * * ? *"))))
(def ^:private prune-once-trigger
  (triggers/build
    (triggers/with-description "Prune deletable PersistInfo now")
    (triggers/with-identity prune-once-trigger-key)
    (triggers/for-job (jobs/key prune-job-key))
    (triggers/start-now)))
(defn- database-trigger ^org.quartz.CronTrigger [database cron-spec]
  (triggers/build
   (triggers/with-description (format "Refresh models for database %d" (u/the-id database)))
   (triggers/with-identity (database-trigger-key database))
   (triggers/using-job-data {"db-id" (u/the-id database)
                             "type"  "database"})
   (triggers/for-job (jobs/key refresh-job-key))
   (triggers/start-now)
   (triggers/with-schedule
     (cron-schedule cron-spec))))
(defn- individual-trigger [persisted-info]
  (triggers/build
   (triggers/with-description (format "Refresh model %d: persisted-info %d"
                                      (:card_id persisted-info)
                                      (u/the-id persisted-info)))
   (triggers/with-identity (individual-trigger-key persisted-info))
   (triggers/using-job-data {"persisted-id" (u/the-id persisted-info)
                             "type"         "individual"})
   (triggers/for-job (jobs/key refresh-job-key))
   (triggers/start-now)))

Schedule a database for persistence refreshing.

(defn schedule-persistence-for-database!
  [database cron-spec]
  (let [tggr (database-trigger database cron-spec)]
    (log/info
     (u/format-color 'green
                     "Scheduling persistence refreshes for database %d: trigger: %s"
                     (u/the-id database) (.. ^Trigger tggr getKey getName)))
    (persisted-info/ready-database! (u/the-id database))
    (try (task/add-trigger! tggr)
         (catch ObjectAlreadyExistsException _e
           (log/info
            (u/format-color 'green "Persistence already present for database %d: trigger: %s"
                            (u/the-id database)
                            (.. ^Trigger tggr getKey getName)))))))

Schedule a refresh of an individual [[PersistedInfo record]]. Done through quartz for locking purposes.

(defn schedule-refresh-for-individual!
  [persisted-info]
  (let [tggr (individual-trigger persisted-info)]
    (log/info
     (u/format-color 'green
                     "Scheduling refresh for model: %d"
                     (:card_id persisted-info)))
    (try (task/add-trigger! tggr)
         (catch ObjectAlreadyExistsException _e
           (log/info
            (u/format-color 'green "Persistence already present for model %d"
                            (:card_id persisted-info)
                            (.. ^Trigger tggr getKey getName)))))))

other errors?

Fetch all database-ids that have a refresh job scheduled.

(defn job-info-by-db-id
  []
  (some->> refresh-job-key
           task/job-info
           :triggers
           (m/index-by (comp #(get % "db-id") qc/from-job-data :data))))

Return a set of PersistedInfo ids of all jobs scheduled for individual refreshes.

TODO -- this is only used in [[metabase.api.card-test]] now

(defn job-info-for-individual-refresh
  []
  (some->> refresh-job-key
           task/job-info
           :triggers
           (map (comp qc/from-job-data :data))
           (filter (comp #{"individual"} #(get % "type")))
           (map #(get % "persisted-id"))
           set))

Stop refreshing tables for a given database. Should only be called when marking the database as not persisting. Tables will be left over and up to the caller to clean up.

(defn unschedule-persistence-for-database!
  [database]
  (task/delete-trigger! (database-trigger-key database)))

Unschedule all job triggers.

(defn- unschedule-all-refresh-triggers!
  [job-key]
  (let [trigger-keys (->> (task/job-info job-key)
                          :triggers
                          (map :key))]
    (doseq [tk trigger-keys]
      (task/delete-trigger! (triggers/key tk)))))

Reschedule refresh for all enabled databases. Removes all existing triggers, and schedules refresh for databases with :persist-models-enabled in the settings at interval [[public-settings/persisted-model-refresh-cron-schedule]].

(defn reschedule-refresh!
  []
  (let [dbs-with-persistence (filter (comp :persist-models-enabled :settings) (t2/select Database))
        cron-schedule        (public-settings/persisted-model-refresh-cron-schedule)]
    (unschedule-all-refresh-triggers! refresh-job-key)
    (doseq [db dbs-with-persistence]
      (schedule-persistence-for-database! db cron-schedule))))

Enable persisting - The prune job is scheduled anew. - Refresh jobs are added when persist is enabled on a db.

(defn enable-persisting!
  []
  (unschedule-all-refresh-triggers! prune-job-key)
  (task/add-trigger! prune-scheduled-trigger))

Disable persisting - All PersistedInfo are marked for deletion. - Refresh job triggers are removed. - Prune scheduled job trigger is removed. - The prune job is triggered to run immediately.

(defn disable-persisting!
  []
  (persisted-info/mark-for-pruning! {})
  (unschedule-all-refresh-triggers! refresh-job-key)
  (task/delete-trigger! prune-scheduled-trigger-key)
  ;; ensure we clean up marked for deletion
  (task/add-trigger! prune-once-trigger))
(defn- job-init!
  []
  (task/add-job! refresh-job))
(defmethod task/init! ::PersistRefresh
  [_]
  (job-init!)
  (reschedule-refresh!))
(defmethod task/init! ::PersistPrune
  [_]
  (task/add-job! prune-job)
  (when (public-settings/persisted-models-enabled)
    (enable-persisting!)))
 
(ns metabase.task.refresh-slack-channel-user-cache
  (:require
   [clojurewerkz.quartzite.jobs :as jobs]
   [clojurewerkz.quartzite.schedule.cron :as cron]
   [clojurewerkz.quartzite.schedule.simple :as simple]
   [clojurewerkz.quartzite.triggers :as triggers]
   [metabase.integrations.slack :as slack]
   [metabase.task :as task]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]))
(set! *warn-on-reflection* true)
(defn ^:private job []
  (if (slack/slack-configured?)
    (let [_        (log/info "Starting Slack user/channel startup cache refresh...")
          start-ms (System/currentTimeMillis)
          _        (slack/refresh-channels-and-usernames!)]
      (log/info (trs "Slack user/channel startup cache refreshed with {0} entries, took {1}ms."
                     (count (:channels (slack/slack-cached-channels-and-usernames)))
                     (- (System/currentTimeMillis) start-ms))))
    (log/info (trs "Slack is not configured, not refreshing slack user/channel cache."))))
(def ^:private job-key "metabase.task.refresh-channel-cache.job")
(def ^:private trigger-key "metabase.task.refresh-channel-cache.trigger")
(def ^:private startup-job-key "metabase.task.on-startup-refresh-channel-cache.job")
(def ^:private startup-trigger-key "metabase.task.on-startup-refresh-channel-cache.trigger")

General slack cache refresh job

(jobs/defjob  RefreshCache [_] (job))

Startup cache refresh, with cleanup on failure.

(jobs/defjob  RefreshCacheOnStartup [_]
  (try (job)
       (finally
         (task/delete-task! (jobs/key startup-job-key)
                            (triggers/key startup-trigger-key)))))
(defmethod task/init! ::RefreshSlackChannelsAndUsers
  [_]
  (let [job     (jobs/build
                 (jobs/of-type RefreshCache)
                 (jobs/with-identity (jobs/key job-key)))
        trigger (triggers/build
                 (triggers/with-identity (triggers/key trigger-key))
                 (triggers/with-schedule
                   (cron/schedule
                    (cron/cron-schedule
                     ;; run every 4 hours at a random minute:
                     (format "0 %d 0/4 1/1 * ? *" (rand-int 60)))
                    (cron/with-misfire-handling-instruction-do-nothing)))

                 (triggers/start-now))
        startup-job     (jobs/build
                         (jobs/of-type RefreshCacheOnStartup)
                         (jobs/with-identity (jobs/key startup-job-key)))
        startup-trigger (triggers/build
                         (triggers/with-identity (triggers/key startup-trigger-key))
                         (triggers/with-schedule
                           (simple/schedule (simple/with-interval-in-seconds 60)))
                         (triggers/start-now))]
    (task/schedule-task! job trigger)
    (task/schedule-task! startup-job startup-trigger)))
 

Contains a Metabase task which periodically sends anonymous usage information to the Metabase team.

(ns metabase.task.send-anonymous-stats
  (:require
   [clojurewerkz.quartzite.jobs :as jobs]
   [clojurewerkz.quartzite.schedule.cron :as cron]
   [clojurewerkz.quartzite.triggers :as triggers]
   [metabase.analytics.stats :as stats]
   [metabase.public-settings :as public-settings]
   [metabase.task :as task]
   [metabase.util.log :as log]))
(set! *warn-on-reflection* true)

If we can collect usage data, do so and send it home

(jobs/defjob  SendAnonymousUsageStats [_]
  (when (public-settings/anon-tracking-enabled)
    (log/debug "Sending anonymous usage stats.")
    (try
      ;; TODO: add in additional request params if anonymous tracking is enabled
      (stats/phone-home-stats!)
      (catch Throwable e
        (log/error e "Error sending anonymous usage stats")))))
(def ^:private job-key     "metabase.task.anonymous-stats.job")
(def ^:private trigger-key "metabase.task.anonymous-stats.trigger")
(defmethod task/init! ::SendAnonymousUsageStats
  [_]
  (let [job      (jobs/build
                  (jobs/of-type SendAnonymousUsageStats)
                  (jobs/with-identity (jobs/key job-key)))
        ;; run at a random hour/minute
        schedule (cron/cron-schedule
                  (format "0 %d %d * * ? *"
                          (rand-int 60)
                          (rand-int 24)))
        trigger  (triggers/build
                  (triggers/with-identity (triggers/key trigger-key))
                  (triggers/start-now)
                  (triggers/with-schedule schedule))]
    (task/schedule-task! job trigger)))
 

Tasks related to running Pulses.

(ns metabase.task.send-pulses
  (:require
   [clj-time.core :as time]
   [clj-time.predicates :as timepr]
   [clojurewerkz.quartzite.jobs :as jobs]
   [clojurewerkz.quartzite.schedule.cron :as cron]
   [clojurewerkz.quartzite.triggers :as triggers]
   [metabase.driver :as driver]
   [metabase.models :refer [PulseChannel]]
   [metabase.models.pulse :as pulse]
   [metabase.models.pulse-channel :as pulse-channel]
   [metabase.models.task-history :as task-history]
   [metabase.pulse]
   [metabase.task :as task]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

------------------------------------------------- PULSE SENDING --------------------------------------------------

(defn- log-pulse-exception [pulse-id exception]
  (log/errorf exception "Error sending Pulse %d" pulse-id))
(def ^:private Hour
  [:int {:min 0 :max 23}])
(def ^:private Weekday
  [:fn pulse-channel/day-of-week?])
(def ^:private MonthDay
  [:enum :first :last :mid :other])
(def ^:private MonthWeek
  [:enum :first :last :other])

Send any Pulses which are scheduled to run in the current day/hour. We use the current time and determine the hour of the day and day of the week according to the defined reporting timezone, or UTC. We then find all Pulses that are scheduled to run and send them. The on-error function is called if an exception is thrown when sending the pulse. Since this is a background process, the exception is only logged and not surfaced to the user. The on-error function makes it easier to test for when an error doesn't occur

(mu/defn ^:private send-pulses!
  ([hour weekday monthday monthweek]
   (send-pulses! hour weekday monthday monthweek log-pulse-exception))
  ([hour :- Hour, weekday :- Weekday, monthday :- MonthDay, monthweek :- MonthWeek, on-error]
   (log/info "Sending scheduled pulses...")
   (let [pulse-id->channels (group-by :pulse_id (pulse-channel/retrieve-scheduled-channels hour weekday monthday monthweek))]
     (doseq [[pulse-id channels] pulse-id->channels]
       (try
         (task-history/with-task-history {:task         "send-pulse"
                                          :task_details {:pulse-id pulse-id}}
           (log/debugf "Starting Pulse Execution: %d" pulse-id)
           (when-let [pulse (pulse/retrieve-notification pulse-id :archived false)]
             (metabase.pulse/send-pulse! pulse :channel-ids (map :id channels)))
           (log/debugf "Finished Pulse Execution: %d" pulse-id))
         (catch Throwable e
           (on-error pulse-id e)))))))
(defn- clear-pulse-channels!
  []
  (when-let [ids-to-delete (seq
                            (for [channel (t2/select [PulseChannel :id :details]
                                                     :id [:not-in {:select   [[:pulse_channel_id :id]]
                                                                   :from     :pulse_channel_recipient
                                                                   :group-by [:pulse_channel_id]
                                                                   :having   [:>= :%count.* [:raw 1]]}])]
                              (when (and (empty? (get-in channel [:details :emails]))
                                         (not (get-in channel [:details :channel])))
                                (:id channel))))]
    (t2/delete! PulseChannel :id [:in ids-to-delete])))

------------------------------------------------------ Task ------------------------------------------------------

(defn- monthday [dt]
  (cond
    (timepr/first-day-of-month? dt) :first
    (timepr/last-day-of-month? dt)  :last
    (= 15 (time/day dt))            :mid
    :else                           :other))
(defn- monthweek [dt]
  (let [curr-day-of-month  (time/day dt)
        last-of-month      (time/day (time/last-day-of-the-month dt))
        start-of-last-week (- last-of-month 7)]
    (cond
      (> 8 curr-day-of-month)                  :first
      (< start-of-last-week curr-day-of-month) :last
      :else                                    :other)))

Triggers the sending of all pulses which are scheduled to run in the current hour

(jobs/defjob  SendPulses [_]
  (try
    (task-history/with-task-history {:task "send-pulses"}
      ;; determine what time it is right now (hour-of-day & day-of-week) in reporting timezone
      (let [reporting-timezone (driver/report-timezone)
            now                (if (empty? reporting-timezone)
                                 (time/now)
                                 (time/to-time-zone (time/now) (time/time-zone-for-id reporting-timezone)))
            curr-hour          (time/hour now)
            ;; joda time produces values of 1-7 here (Mon -> Sun) and we subtract 1 from it to
            ;; make the values zero based to correspond to the indexes in pulse-channel/days-of-week
            curr-weekday       (->> (dec (time/day-of-week now))
                                    (get pulse-channel/days-of-week)
                                    :id)
            curr-monthday      (monthday now)
            curr-monthweek     (monthweek now)]
        (send-pulses! curr-hour curr-weekday curr-monthday curr-monthweek))
      (clear-pulse-channels!))
    (catch Throwable e
      (log/error e "SendPulses task failed"))))
(def ^:private send-pulses-job-key     "metabase.task.send-pulses.job")
(def ^:private send-pulses-trigger-key "metabase.task.send-pulses.trigger")
(defmethod task/init! ::SendPulses [_]
  (let [job     (jobs/build
                 (jobs/of-type SendPulses)
                 (jobs/with-identity (jobs/key send-pulses-job-key)))
        trigger (triggers/build
                 (triggers/with-identity (triggers/key send-pulses-trigger-key))
                 (triggers/start-now)
                 (triggers/with-schedule
                   (cron/schedule
                    ;; run at the top of every hour
                    (cron/cron-schedule "0 0 * * * ? *")
                    ;; If send-pulses! misfires, don't try to re-send all the misfired Pulses. Retry only the most
                    ;; recent misfire, discarding all others. This should hopefully cover cases where a misfire
                    ;; happens while the system is still running; if the system goes down for an extended period of
                    ;; time we don't want to re-send tons of (possibly duplicate) Pulses.
                    ;;
                    ;; See https://www.nurkiewicz.com/2012/04/quartz-scheduler-misfire-instructions.html
                    (cron/with-misfire-handling-instruction-fire-and-proceed))))]
    (task/schedule-task! job trigger)))
 

Scheduled tasks for syncing metadata/analyzing and caching FieldValues for connected Databases.

There always UpdateFieldValues and SyncAndAnalyzeDatabase jobs present. Databases add triggers to these jobs. And those triggers include a database id.

(ns metabase.task.sync-databases
  (:require
   [clojurewerkz.quartzite.conversion :as qc]
   [clojurewerkz.quartzite.jobs :as jobs]
   [clojurewerkz.quartzite.schedule.cron :as cron]
   [clojurewerkz.quartzite.triggers :as triggers]
   [java-time.api :as t]
   [malli.core :as mc]
   [metabase.config :as config]
   [metabase.db.query :as mdb.query]
   [metabase.driver.h2 :as h2]
   [metabase.driver.util :as driver.u]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.models.database :as database :refer [Database]]
   [metabase.models.interface :as mi]
   [metabase.models.permissions :as perms]
   [metabase.sync.analyze :as analyze]
   [metabase.sync.field-values :as field-values]
   [metabase.sync.schedules :as sync.schedules]
   [metabase.sync.sync-metadata :as sync-metadata]
   [metabase.task :as task]
   [metabase.util :as u]
   [metabase.util.cron :as u.cron]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.registry :as mr]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2])
  (:import
   (org.quartz
    CronTrigger
    JobDetail
    JobKey
    TriggerKey)))
(set! *warn-on-reflection* true)

+----------------------------------------------------------------------------------------------------------------+ | JOB LOGIC | +----------------------------------------------------------------------------------------------------------------+

(declare unschedule-tasks-for-db!)
(mu/defn ^:private job-context->database-id :- [:maybe ::lib.schema.id/database]
  "Get the Database ID referred to in `job-context`."
  [job-context]
  (u/the-id (get (qc/from-job-data job-context) "db-id")))

The DisallowConcurrentExecution on the two defrecords below attaches an annotation to the generated class that will constrain the job execution to only be one at a time. Other triggers wanting the job to run will misfire.

If the analyze-db! step is shorter than this number of minutes, then we may refingerprint fields.

(def ^:private analyze-duration-threshold-for-refingerprinting
  5)

Whether to refingerprint fields in the database. Looks at the runtime of the last analysis and if any fields were fingerprinted. If no fields were fingerprinted and the run was shorter than the threshold, it will re-fingerprint some fields.

(defn- should-refingerprint-fields?
  [{:keys [start-time end-time steps] :as _analyze-results}]
  (let [attempted (some->> steps
                           (filter (fn [[step-name _results]] (= step-name "fingerprint-fields")))
                           first
                           second
                           :fingerprints-attempted)]
    (and (number? attempted)
         (zero? attempted)
         start-time
         end-time
         (< (.toMinutes (t/duration start-time end-time)) analyze-duration-threshold-for-refingerprinting))))
(defn- sync-and-analyze-database*!
  [database-id]
  (log/infof "Starting sync task for Database %d." database-id)
  (when-let [database (or (t2/select-one Database :id database-id)
                          (do
                            (unschedule-tasks-for-db! (mi/instance Database {:id database-id}))
                            (log/warnf "Cannot sync Database %d: Database does not exist." database-id)))]
    (if-let [ex (try
                  ;; it's okay to allow testing H2 connections during sync. We only want to disallow you from testing them for the
                  ;; purposes of creating a new H2 database.
                  (binding [h2/*allow-testing-h2-connections* true]
                    (driver.u/can-connect-with-details? (:engine database) (:details database) :throw-exceptions))
                  nil
                  (catch Throwable e
                    e))]
      (log/warnf ex "Cannot sync Database %s: %s" (:name database) (ex-message ex))
      (do
        (sync-metadata/sync-db-metadata! database)
        ;; only run analysis if this is a "full sync" database
        (when (:is_full_sync database)
          (let [results (analyze/analyze-db! database)]
            (when (and (:refingerprint database) (should-refingerprint-fields? results))
              (analyze/refingerprint-db! database))))))))

The sync and analyze database job, as a function that can be used in a test

(defn- sync-and-analyze-database!
  [job-context]
  (when-let [database-id (job-context->database-id job-context)]
    (if (= perms/audit-db-id database-id)
      (do
        (log/warn "Cannot sync Database: It is the audit db.")
        (when-not config/is-prod?
          (throw (ex-info "Cannot sync Database: It is the audit db."
                          {:database-id database-id
                           :raw-job-context job-context
                           :job-context (pr-str job-context)}))))
      (sync-and-analyze-database*! database-id))))

Sync and analyze the database

(jobs/defjob ^{org.quartz.DisallowConcurrentExecution true
               :doc }
  SyncAndAnalyzeDatabase [job-context]
  (sync-and-analyze-database! job-context))

The update field values job, as a function that can be used in a test

(defn- update-field-values!
  [job-context]
  (when-let [database-id (job-context->database-id job-context)]
    (log/infof "Update Field values task triggered for Database %d." database-id)
    (when-let [database (or (t2/select-one Database :id database-id)
                            (do
                              (unschedule-tasks-for-db! (mi/instance Database {:id database-id}))
                              (log/warnf "Cannot update Field values for Database %d: Database does not exist." database-id)))]
      (if (:is_full_sync database)
        (field-values/update-field-values! database)
        (log/infof "Skipping update, automatic Field value updates are disabled for Database %d." database-id)))))

Update field values

(jobs/defjob ^{org.quartz.DisallowConcurrentExecution true
               :doc }
  UpdateFieldValues [job-context]
  (update-field-values! job-context))

+----------------------------------------------------------------------------------------------------------------+ | TASK INFO AND GETTER FUNCTIONS | +----------------------------------------------------------------------------------------------------------------+

(mr/def ::class
  [:fn {:error/message "a Class"} class?])

One-off schema for information about the various sync tasks we run for a DB.

(def ^:private TaskInfo
  [:map
   [:key                :keyword]
   [:db-schedule-column :keyword]
   [:job-class          ::class]])
(def ^:private sync-analyze-task-info
  {:key                :sync-and-analyze
   :db-schedule-column :metadata_sync_schedule
   :job-class          SyncAndAnalyzeDatabase})
(assert (mc/validate TaskInfo sync-analyze-task-info))
(def ^:private field-values-task-info
  {:key                :update-field-values
   :db-schedule-column :cache_field_values_schedule
   :job-class          UpdateFieldValues})
(assert (mc/validate TaskInfo field-values-task-info))

These getter functions are not strictly necessary but are provided primarily so we can get some extra validation by using them

(mu/defn ^:private job-key :- (ms/InstanceOfClass JobKey)
  "Return an appropriate string key for the job described by `task-info` for `database-or-id`."
  ^JobKey [task-info :- TaskInfo]
  (jobs/key (format "metabase.task.%s.job" (name (:key task-info)))))
(mu/defn ^:private trigger-key :- (ms/InstanceOfClass TriggerKey)
  "Return an appropriate string key for the trigger for `task-info` and `database-or-id`."
  ^TriggerKey [database  :- (ms/InstanceOf Database)
               task-info :- TaskInfo]
  (triggers/key (format "metabase.task.%s.trigger.%d" (name (:key task-info)) (u/the-id database))))
(mu/defn ^:private cron-schedule :- u.cron/CronScheduleString
  "Fetch the appropriate cron schedule string for `database` and `task-info`."
  [database  :- (ms/InstanceOf Database)
   task-info :- TaskInfo]
  (get database (:db-schedule-column task-info)))
(mu/defn ^:private job-class :- ::class
  "Get the Job class for `task-info`."
  [task-info :- TaskInfo]
  (:job-class task-info))
(mu/defn ^:private trigger-description :- :string
  "Return an appropriate description string for a job/trigger for Database described by `task-info`."
  [database  :- (ms/InstanceOf Database)
   task-info :- TaskInfo]
  (format "%s Database %d" (name (:key task-info)) (u/the-id database)))
(mu/defn ^:private job-description :- :string
  "Return an appropriate description string for a job"
  [task-info :- TaskInfo]
  (format "%s for all databases" (name (:key task-info))))

+----------------------------------------------------------------------------------------------------------------+ | DELETING TASKS FOR A DB | +----------------------------------------------------------------------------------------------------------------+

Cancel a single sync task for database-or-id and task-info.

(mu/defn ^:private delete-task!
  [database  :- (ms/InstanceOf Database)
   task-info :- TaskInfo]
  (let [trigger-key (trigger-key database task-info)]
    (log/debug (u/format-color 'red
                   (format "Unscheduling task for Database %d: trigger: %s" (u/the-id database) (.getName trigger-key))))
    (task/delete-trigger! trigger-key)))

Cancel all scheduled sync and FieldValues caching tasks for database-or-id.

(mu/defn unschedule-tasks-for-db!
  [database :- (ms/InstanceOf Database)]
  (doseq [task [sync-analyze-task-info field-values-task-info]]
    (delete-task! database task)))

+----------------------------------------------------------------------------------------------------------------+ | (RE)SCHEDULING TASKS FOR A DB | +----------------------------------------------------------------------------------------------------------------+

(mu/defn ^:private job :- (ms/InstanceOfClass JobDetail)
  "Build a durable Quartz Job for `task-info`. Durable in Quartz allows the job to exist even if there are no triggers
  for it."
  ^JobDetail [task-info :- TaskInfo]
  (jobs/build
   (jobs/with-description (job-description task-info))
   (jobs/of-type (job-class task-info))
   (jobs/with-identity (job-key task-info))
   (jobs/store-durably)))
(def ^:private sync-analyze-job (job sync-analyze-task-info))
(def ^:private field-values-job (job field-values-task-info))
(mu/defn ^:private trigger :- (ms/InstanceOfClass CronTrigger)
  "Build a Quartz Trigger for `database` and `task-info`."
  ^CronTrigger [database  :- (ms/InstanceOf Database)
                task-info :- TaskInfo]
  (triggers/build
   (triggers/with-description (trigger-description database task-info))
   (triggers/with-identity (trigger-key database task-info))
   (triggers/using-job-data {"db-id" (u/the-id database)})
   (triggers/for-job (job-key task-info))
   (triggers/start-now)
   (triggers/with-schedule
     (cron/schedule
      (cron/cron-schedule (cron-schedule database task-info))
      ;; if we miss a sync for one reason or another (such as system being down) do not try to run the sync again.
      ;; Just wait until the next sync cycle.
      ;;
      ;; See https://www.nurkiewicz.com/2012/04/quartz-scheduler-misfire-instructions.html for more info
      (cron/with-misfire-handling-instruction-do-nothing)))))

Schedule a new Quartz job for database and task-info if it doesn't already exist or is incorrect.

called [[from metabase.models.database/schedule-tasks!]] from the post-insert and the pre-update

(mu/defn check-and-schedule-tasks-for-db!
  [database :- (ms/InstanceOf Database)]
  (if (= perms/audit-db-id (:id database))
    (log/info (u/format-color :red "Not scheduling tasks for audit database"))
    (let [sync-job (task/job-info (job-key sync-analyze-task-info))
          fv-job   (task/job-info (job-key field-values-task-info))
          sync-trigger (trigger database sync-analyze-task-info)
          fv-trigger   (trigger database field-values-task-info)
          existing-sync-trigger (some (fn [trigger] (when (= (:key trigger) (.. sync-trigger getKey getName))
                                                      trigger))
                                      (:triggers sync-job))
          existing-fv-trigger   (some (fn [trigger] (when (= (:key trigger) (.. fv-trigger getKey getName))
                                                      trigger))
                                      (:triggers fv-job))
          jobs-to-create [{:existing-trigger  existing-sync-trigger
                           :existing-schedule (:metadata_sync_schedule database)
                           :ti                sync-analyze-task-info
                           :trigger           sync-trigger
                           :description       "sync/analyze"}
                          {:existing-trigger  existing-fv-trigger
                           :existing-schedule (:cache_field_values_schedule database)
                           :ti                field-values-task-info
                           :trigger           fv-trigger
                           :description       "field-values"}]]
      (doseq [{:keys [existing-trigger existing-schedule ti trigger description]} jobs-to-create
              :when (or (not existing-trigger)
                        (not= (:schedule existing-trigger) existing-schedule))]
        (delete-task! database ti)
        (log/info
         (u/format-color :green "Scheduling %s for database %d: trigger: %s"
                         description (:id database) (.. ^org.quartz.Trigger trigger getKey getName)))
        ;; now (re)schedule the task
        (task/add-trigger! trigger)))))

+----------------------------------------------------------------------------------------------------------------+ | TASK INITIALIZATION | +----------------------------------------------------------------------------------------------------------------+

Separated from task-init primarily as it's useful in testing. Adds the sync and field-values job that all of the triggers will use

(defn- job-init
  []
  (task/add-job! sync-analyze-job)
  (task/add-job! field-values-job))

Predicate returning if the user does not manually set sync schedules and leaves it to metabase.

(defn- metabase-controls-schedule?
  [database]
  (not (-> database :details :let-user-control-scheduling)))
(defn- randomize-db-schedules-if-needed
  []
  ;; todo: when we can use json operations on h2 we can check details in the query and drop the transducer
  (transduce (comp (map (partial mi/do-after-select Database))
                   (filter metabase-controls-schedule?))
             (fn
               ([] 0)
               ([counter]
                (log/info "Updated default schedules for %d databases" counter)
                counter)
               ([counter db]
                (try
                  (t2/update! Database (u/the-id db)
                    (sync.schedules/schedule-map->cron-strings
                     (sync.schedules/default-randomized-schedule)))
                  (inc counter)
                  (catch Exception e
                    (log/warnf e
                               "Error updating database %d for randomized schedules"
                               (u/the-id db))
                    counter))))
             (mdb.query/reducible-query
              {:select [:id :details]
               :from   [:metabase_database]
               :where  [:or
                        [:in
                         :metadata_sync_schedule
                         sync.schedules/default-metadata-sync-schedule-cron-strings]
                        [:in
                         :cache_field_values_schedule
                         sync.schedules/default-cache-field-values-schedule-cron-strings]]})))
(defmethod task/init! ::SyncDatabases
  [_]
  (job-init)
  (randomize-db-schedules-if-needed))
 
(ns metabase.task.task-history-cleanup
  (:require
   [clojurewerkz.quartzite.jobs :as jobs]
   [clojurewerkz.quartzite.schedule.cron :as cron]
   [clojurewerkz.quartzite.triggers :as triggers]
   [metabase.models.task-history :as task-history]
   [metabase.task :as task]
   [metabase.util.log :as log]))
(set! *warn-on-reflection* true)

Maximum number of TaskHistory rows.

(def ^:private history-rows-to-keep
  100000)

Delete older TaskHistory rows -- see docstring of task-history/cleanup-task-history! for more details.

(defn- task-history-cleanup!
  []
  (log/debug "Cleaning up task history")
  (task-history/with-task-history {:task "task-history-cleanup"}
    (let [deleted-rows? (task-history/cleanup-task-history! history-rows-to-keep)]
      (log/debug
       (if deleted-rows?
         "Task history cleanup successful, rows were deleted"
         "Task history cleanup successful, no rows were deleted")))))

Delete older TaskHistory rows -- see docstring of task-history/cleanup-task-history! for more details.

(jobs/defjob
  TaskHistoryCleanup [_]
  (task-history-cleanup!))
(def ^:private job-key     "metabase.task.task-history-cleanup.job")
(def ^:private trigger-key "metabase.task.task-history-cleanup.trigger")
(defmethod task/init! ::TaskHistoryCleanup [_]
  (let [job     (jobs/build
                 (jobs/of-type TaskHistoryCleanup)
                 (jobs/with-identity (jobs/key job-key)))
        trigger (triggers/build
                 (triggers/with-identity (triggers/key trigger-key))
                 (triggers/start-now)
                 (triggers/with-schedule
                   ;; run every day at midnight
                   (cron/cron-schedule "0 0 0 * * ? *")))]
      (task/schedule-task! job trigger)))
 

Tasks for truncating audit-related tables, particularly audit_log, view_log, and query_execution, based on a configured retention policy.

(ns metabase.task.truncate-audit-tables
  (:require
   [clojurewerkz.quartzite.jobs :as jobs]
   [clojurewerkz.quartzite.schedule.cron :as cron]
   [clojurewerkz.quartzite.triggers :as triggers]
   [java-time.api :as t]
   [metabase.config :as config]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.models.task-history :as task-history]
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings.premium-features
    :as premium-features
    :refer [defenterprise]]
   [metabase.task :as task]
   [metabase.util.i18n :as i18n :refer [deferred-tru]]
   [metabase.util.log :as log]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

Load EE implementation if available

(when config/ee-available?
  (classloader/require 'metabase-enterprise.task.truncate-audit-tables))

Minimum allowed value for audit-max-retention-days.

(def min-retention-days
  30)

Default value for audit-max-retention-days.

(def default-retention-days
  720)

Logs a warning that the value for audit-max-retention-days is below the allowed minimum and will be overriden.

(defn log-minimum-value-warning
  [env-var-value]
  (log/warnf "MB_AUDIT_MAX_RETENTION_DAYS is set to %d; using the minimum value of %d instead."
             env-var-value
             min-retention-days))
(defsetting audit-max-retention-days
  (deferred-tru "Number of days to retain data in audit-related tables. Minimum value is 30; set to 0 to retain data indefinitely.")
  :visibility :internal
  :setter     :none
  :audit      :never
  :getter     (fn []
                (let [env-var-value (setting/get-value-of-type :integer :audit-max-retention-days)]
                  (def env-var-value env-var-value)
                  (cond
                    (nil? env-var-value)
                    default-retention-days
                    ;; Treat 0 as an alias for infinity
                    (zero? env-var-value)
                    ##Inf
                    (< env-var-value min-retention-days)
                    (do
                      (log-minimum-value-warning env-var-value)
                      min-retention-days)
                    :else
                    env-var-value))))

Given a model, deletes all rows older than the configured threshold

(defn- truncate-table!
  [model time-column]
  (when-not (infinite? (audit-max-retention-days))
    (let [table-name (name (t2/table-name model))]
      (task-history/with-task-history {:task "task-history-cleanup"}
        (try
          (log/infof "Cleaning up %s table" table-name)
          (let [rows-deleted (t2/delete!
                              model
                              time-column
                              [:<= (t/minus (t/offset-date-time) (t/days (audit-max-retention-days)))])]
            (if (> rows-deleted 0)
              (log/infof "%s cleanup successful, %d rows were deleted" table-name rows-deleted)
              (log/infof "%s cleanup successful, no rows were deleted" table-name)))
          (catch Throwable e
            (log/errorf e "%s cleanup failed" table-name)))))))

List of models to truncate. OSS implementation only truncates query_execution table.

(defenterprise audit-models-to-truncate
  metabase-enterprise.task.truncate-audit-tables
  []
  [{:model :model/QueryExecution :timestamp-col :started_at}])
(defn- truncate-audit-tables!
  []
  (run!
   (fn [{:keys [model timestamp-col]}]
     (truncate-table! model timestamp-col))
   (audit-models-to-truncate)))

Triggers the removal of query_execution rows older than the configured threshold.

(jobs/defjob  TruncateAuditTables [_]
  (truncate-audit-tables!))
(def ^:private truncate-audit-tables-job-key "metabase.task.truncate-audit-tables.job")
(def ^:private truncate-audit-tables-trigger-key "metabase.task.truncate-audit-tables.trigger")
(def ^:private truncate-audit-tables-cron "0 0 */12 * * ? *") ;; Run every 12 hours

Run every 12 hours

(defmethod task/init! ::TruncateAuditTables [_]
  (let [job     (jobs/build
                 (jobs/of-type TruncateAuditTables)
                 (jobs/with-identity (jobs/key truncate-audit-tables-job-key)))
        trigger (triggers/build
                 (triggers/with-identity (triggers/key truncate-audit-tables-trigger-key))
                 (triggers/start-now)
                 (triggers/with-schedule
                   (cron/schedule
                    (cron/cron-schedule truncate-audit-tables-cron)
                    (cron/with-misfire-handling-instruction-do-nothing))))]
    (task/schedule-task! job trigger)))
 

Contains a Metabase task which periodically checks for the availability of new Metabase versions.

(ns metabase.task.upgrade-checks
  (:require
   [cheshire.core :as json]
   [clj-http.client :as http]
   [clojurewerkz.quartzite.jobs :as jobs]
   [clojurewerkz.quartzite.schedule.cron :as cron]
   [clojurewerkz.quartzite.triggers :as triggers]
   [java-time.api :as t]
   [metabase.config :as config]
   [metabase.public-settings :as public-settings]
   [metabase.task :as task]
   [metabase.util.log :as log]))
(set! *warn-on-reflection* true)
(defn- get-version-info []
  (let [version-info-url-key  (if config/ee-available? :mb-version-info-ee-url :mb-version-info-url)
        version-info-url      (config/config-str version-info-url-key)
        {:keys [status body]} (http/get version-info-url (merge
                                                          {:content-type "application/json"}
                                                          (when config/is-prod?
                                                            {:query-params {"instance" (public-settings/site-uuid-for-version-info-fetching)}})))]
    (when (not= status 200)
      (throw (Exception. (format "[%d]: %s" status body))))
    (json/parse-string body keyword)))

Simple job which looks up all databases and runs a sync on them

(jobs/defjob  CheckForNewVersions [_]
  (when (public-settings/check-for-updates)
    (log/debug "Checking for new Metabase version info.")
    (try
      ;; TODO: add in additional request params if anonymous tracking is enabled
      (public-settings/version-info-last-checked! (t/zoned-date-time))
      (when-let [version-info (get-version-info)]
        (public-settings/version-info! version-info))
      (catch Throwable e
        (log/error e "Error fetching version info; setting version-info value to nil")
        (public-settings/version-info! nil)))))
(def ^:private job-key     "metabase.task.upgrade-checks.job")
(def ^:private trigger-key "metabase.task.upgrade-checks.trigger")
(defmethod task/init! ::CheckForNewVersions [_]
  (let [job     (jobs/build
                 (jobs/of-type CheckForNewVersions)
                 (jobs/with-identity (jobs/key job-key)))
        trigger (triggers/build
                 (triggers/with-identity (triggers/key trigger-key))
                 (triggers/start-now)
                 (triggers/with-schedule
                   ;; run twice a day
                   (cron/cron-schedule "0 15 6,18 * * ? *")))]
    (task/schedule-task! job trigger)))
 
(ns metabase.transforms.core
  (:require
   [medley.core :as m]
   [metabase.domain-entities.core
    :as de
    :refer [Bindings DimensionBindings SourceEntity SourceName]]
   [metabase.domain-entities.specs
    :refer [domain-entity-specs DomainEntitySpec]]
   [metabase.driver :as driver]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.field :refer [Field]]
   [metabase.models.interface :as mi]
   [metabase.models.table :as table :refer [Table]]
   [metabase.query-processor :as qp]
   [metabase.transforms.materialize :as tf.materialize]
   [metabase.transforms.specs :refer [Step transform-specs TransformSpec]]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   #_{:clj-kondo/ignore [:deprecated-namespace]}
   [metabase.util.schema :as su]
   [schema.core :as s]
   [toucan2.core :as t2]))
(s/defn ^:private add-bindings :- Bindings
  [bindings :- Bindings, source :- SourceName, new-bindings :- (s/maybe DimensionBindings)]
  (reduce-kv (fn [bindings name definition]
               (->> definition
                    (de/resolve-dimension-clauses bindings source)
                    (assoc-in bindings [source :dimensions name])))
             bindings
             new-bindings))
(defn- mbql-reference->col-name
  [field-clause]
  (mbql.u/match-one field-clause
    [:field (field-name :guard string?) _]
    field-name
    [:field (id :guard integer?) _]
    (t2/select-one-fn :name Field :id id)))
(s/defn ^:private infer-resulting-dimensions :- DimensionBindings
  [bindings             :- Bindings
   {:keys [joins name]} :- Step
   query                :- (s/pred mbql.s/valid-query?)]
  (let [flattened-bindings (merge (apply merge (map (comp :dimensions bindings :source) joins))
                                  (get-in bindings [name :dimensions]))]
    (into {} (for [{:keys [name] :as col} (qp/query->expected-cols query)]
               [(if (flattened-bindings name)
                  name
                  ;; If the col is not one of our own we have to reconstruct to what it refers in
                  ;; our parlance
                  (or (some->> flattened-bindings
                               (m/find-first (comp #{name} mbql-reference->col-name))
                               key)
                      ;; If that doesn't work either, it's a duplicated col from a join
                      name))
                (de/mbql-reference col)]))))
(defn- maybe-add-fields
  [bindings {:keys [aggregation source]} query]
  (if-not aggregation
    (assoc query :fields (vals (get-in bindings [source :dimensions])))
    query))
(defn- maybe-add-expressions
  [bindings {:keys [expressions name]} query]
  (if expressions
    (-> query
        (assoc :expressions (->> expressions
                                 keys
                                 (select-keys (get-in bindings [name :dimensions]))))
        (update :fields concat (for [expression (keys expressions)]
                                 [:expression expression])))
    query))
(defn- maybe-add-aggregation
  [bindings {:keys [name aggregation]} query]
  (->> (for [agg (keys aggregation)]
         [:aggregation-options (get-in bindings [name :dimensions agg]) {:name agg}])
       not-empty
       (m/assoc-some query :aggregation)))
(defn- maybe-add-breakout
  [bindings {:keys [name breakout]} query]
  (m/assoc-some query :breakout (not-empty
                                 (for [breakout breakout]
                                   (de/resolve-dimension-clauses bindings name breakout)))))

Serialize entity into a form suitable as :source-table value.

(s/defn ^:private ->source-table-reference
  [entity :- SourceEntity]
  (if (mi/instance-of? Table entity)
    (u/the-id entity)
    (str "card__" (u/the-id entity))))
(defn- maybe-add-joins
  [bindings {context-source :source joins :joins} query]
  (m/assoc-some query :joins
    (not-empty
     (for [{:keys [source condition strategy]} joins]
       (-> {:condition    (de/resolve-dimension-clauses bindings context-source condition)
            :source-table (-> source bindings :entity ->source-table-reference)
            :alias        source
            :fields       :all}
           (m/assoc-some :strategy strategy))))))
(defn- maybe-add-filter
  [bindings {:keys [name filter]} query]
  (m/assoc-some query :filter (de/resolve-dimension-clauses bindings name filter)))
(defn- maybe-add-limit
  [_bindings {:keys [limit]} query]
  (m/assoc-some query :limit limit))
(s/defn ^:private transform-step! :- Bindings
  [bindings :- Bindings, {:keys [name source aggregation expressions] :as step} :- Step]
  (let [source-entity  (get-in bindings [source :entity])
        local-bindings (-> bindings
                           (add-bindings name (get-in bindings [source :dimensions]))
                           (add-bindings name expressions)
                           (add-bindings name aggregation))
        query          {:type     :query
                        :query    (->> {:source-table (->source-table-reference source-entity)}
                                       (maybe-add-fields local-bindings step)
                                       (maybe-add-expressions local-bindings step)
                                       (maybe-add-aggregation local-bindings step)
                                       (maybe-add-breakout local-bindings step)
                                       (maybe-add-joins local-bindings step)
                                       (maybe-add-filter local-bindings step)
                                       (maybe-add-limit local-bindings step))
                        :database ((some-fn :db_id :database_id) source-entity)}]
    (assoc bindings name {:entity     (tf.materialize/make-card-for-step! step query)
                          :dimensions (infer-resulting-dimensions local-bindings step query)})))
(def ^:private Tableset
  #_{:clj-kondo/ignore [:deprecated-var]}
  [(mi/InstanceOf:Schema Table)])
(s/defn ^:private find-tables-with-domain-entity :- Tableset
  [tableset :- Tableset, domain-entity-spec :- DomainEntitySpec]
  (filter #(-> % :domain_entity :type (isa? (:type domain-entity-spec))) tableset))
(s/defn ^:private tableset->bindings :- Bindings
  [tableset :- Tableset]
  (into {} (for [{{domain-entity-name :name dimensions :dimensions} :domain_entity :as table} tableset]
             [domain-entity-name
              {:dimensions (m/map-vals de/mbql-reference dimensions)
               :entity     table}])))
(s/defn ^:private apply-transform-to-tableset! :- Bindings
  [tableset :- Tableset, {:keys [steps _provides]} :- TransformSpec]
  (driver/with-driver (-> tableset first table/database :engine)
    (reduce transform-step! (tableset->bindings tableset) (vals steps))))
(s/defn ^:private resulting-entities :- [SourceEntity]
  [bindings :- Bindings, {:keys [provides]} :- TransformSpec]
  (map (comp :entity val) (select-keys bindings provides)))
(s/defn ^:private validate-results :- Bindings
  [bindings :- Bindings, {:keys [provides]} :- TransformSpec]
  (doseq [domain-entity-name provides]
    (assert (de/satisfies-requierments? (get-in bindings [domain-entity-name :entity])
                                        (@domain-entity-specs domain-entity-name))
      (str (tru "Resulting transforms do not conform to expectations.\nExpected: {0}"
                domain-entity-name))))
  bindings)
(s/defn ^:private tables-matching-requirements :- (s/maybe Tableset)
  [tableset :- Tableset, {:keys [requires]} :- TransformSpec]
  (let [matches (map (comp (partial find-tables-with-domain-entity tableset)
                           @domain-entity-specs)
                     requires)]
    (when (every? (comp #{1} count) matches)
      (map first matches))))
(s/defn ^:private tableset :- Tableset
  [db-id :- su/IntGreaterThanZero, schema :- (s/maybe s/Str)]
  (table/with-fields
    (de/with-domain-entity
      (t2/select 'Table :db_id db-id :schema schema))))

Apply transform defined by transform spec spec to schema schema in database db-id.

The algorithm is as follows: 1) Try to find a set of tables in the given schema that have required domain entities. 2) If found, use these tables and their fields as the initial bindings. 3) Go through the transform steps, materialize them as cards, and accure these and their result cols to the bindings. 4) Check that all output cards have the expected result shape. 5) Return the output cards.

(s/defn apply-transform!
  [db-id :- su/IntGreaterThanZero, schema :- (s/maybe s/Str), spec :- TransformSpec]
  (tf.materialize/fresh-collection-for-transform! spec)
  (some-> (tableset db-id schema)
          (tables-matching-requirements spec)
          (apply-transform-to-tableset! spec)
          (validate-results spec)
          (resulting-entities spec)))

Return a list of candidate transforms for a given table.

(defn candidates
  [table]
  (filter (comp (partial some (comp #{(u/the-id table)} u/the-id))
                (partial tables-matching-requirements (tableset (:db_id table) (:schema table))))
          @transform-specs))
 
(ns metabase.transforms.dashboard
  (:require
   [medley.core :as m]
   [metabase.api.common :as api]
   [metabase.automagic-dashboards.populate :as populate]
   [metabase.models.table :refer [Table]]
   [metabase.transforms.materialize :as tf.materialize]
   [metabase.transforms.specs :refer [transform-specs]]
   [metabase.util :as u]
   [toucan2.core :as t2]
   [toucan2.realize :as t2.realize]))
(def ^:private ^:const ^Long width 12)
(def ^:private ^:const ^Long total-width 18)
(def ^:private ^:const ^Long height 4)

Build a section of cards and format them according to what the automagic dashboards code expects.

(defn- cards->section
  [group cards]
  (mapcat (fn [{:keys [name description display] :as card}]
            (cond-> [(assoc card
                       :group         group
                       :width         width
                       :height        height
                       :card-score    100
                       :title         name
                       :visualization [display]
                       :position      0)]
              description (conj {:text       description
                                 :group      group
                                 :width      (- total-width width)
                                 :height     height
                                 :card-score 100
                                 :position   0})))
          cards))
(defn- card-for-source-table
  [table]
  {:pre [(map? table)]}
  {:creator_id             api/*current-user-id*
   :dataset_query          {:type     :query
                            :query    {:source-table (u/the-id table)}
                            :database (:db_id table)}
   :name                   (:display_name table)
   :collection_id          nil
   :visualization_settings {}
   :display                :table})
(defn- sources [steps]
  (when-let [table-ids (->> steps
                            (map (comp :source-table :query :dataset_query))
                            (filter number?)
                            not-empty)]
    (let [table-id->table (t2/select-pk->fn t2.realize/realize Table :id [:in (set table-ids)])]
      (mapv (fn [table-id]
              (let [table (get table-id->table table-id)]
                (card-for-source-table table)))
            table-ids))))

Create a (transient) dashboard for transform named transform-name.

(defn dashboard
  [transform-name]
  (let [transform-spec              (m/find-first (comp #{transform-name} :name) @transform-specs)
        {steps false provides true} (->> transform-name
                                         tf.materialize/get-collection
                                         (t2/select 'Card :collection_id)
                                         (group-by (comp some?
                                                         (-> transform-spec :provides set)
                                                         :name)))
        sources                     (sources steps)]
    (populate/create-dashboard {:cards       (concat (cards->section "sources" sources)
                                                     (cards->section "steps" steps)
                                                     (cards->section "provides" provides))
                                :title       (str transform-name " automatically generated transform")
                                :description (:description transform-spec)
                                :groups      {"sources"  {:title "Sources"}
                                              "steps"    {:title "Steps"}
                                              "provides" {:title "Resulting datasets"}}})))
 
(ns metabase.transforms.materialize
  (:require
   [metabase.api.common :as api]
   [metabase.models.card :as card :refer [Card]]
   [metabase.models.collection :as collection :refer [Collection]]
   [metabase.query-processor :as qp]
   [toucan2.core :as t2]))
(declare get-or-create-root-container-collection!)
(defn- root-container-location
  []
  (collection/children-location
   (t2/select-one [Collection :location :id]
     :id (get-or-create-root-container-collection!))))

Get collection named collection-name. If no location is given root collection for automatically generated transforms is assumed (see get-or-create-root-container-collection!).

(defn get-collection
  ([collection-name]
   (get-collection collection-name (root-container-location)))
  ([collection-name location]
   (t2/select-one-pk Collection
     :name     collection-name
     :location location)))
(defn- create-collection!
  ([collection-name description]
   (create-collection! collection-name description (root-container-location)))
  ([collection-name description location]
   (first (t2/insert-returning-pks! Collection
                                    {:name        collection-name
                                     :description description
                                     :location    location}))))

Get or create container collection for transforms in the root collection.

(defn- get-or-create-root-container-collection!
  []
  (let [location "/"
        name     "Automatically Generated Transforms"]
    (or (get-collection name location)
        (create-collection! name nil location))))

Create a new collection for all the artefacts belonging to transform, or reset it if it already exists.

(defn fresh-collection-for-transform!
  [{:keys [name description]}]
  (if-let [collection-id (get-collection name)]
    (t2/delete! Card :collection_id collection-id)
    (create-collection! name description)))

Make and save a card for a given transform step and query.

(defn make-card-for-step!
  [{:keys [name transform description]} query]
  (->> {:creator_id             api/*current-user-id*
        :dataset_query          query
        :description            description
        :name                   name
        :collection_id          (get-collection transform)
        :result_metadata        (qp/query->expected-cols query)
        :visualization_settings {}
        :display                :table}
       card/populate-query-fields
       (t2/insert-returning-instances! Card)
       first))
 
(ns metabase.transforms.specs
  (:require
   [medley.core :as m]
   [metabase.domain-entities.specs :refer [FieldType MBQL]]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.util :as u]
   #_{:clj-kondo/ignore [:deprecated-namespace]}
   [metabase.util.schema :as su]
   [metabase.util.yaml :as yaml]
   [schema.coerce :as sc]
   [schema.core :as s]))
(def ^:private Source s/Str)
(def ^:private Dimension s/Str)
(def ^:private Breakout [MBQL])
(def ^:private Aggregation {Dimension MBQL})
(def ^:private Expressions {Dimension MBQL})
(def ^:private Description s/Str)
(def ^:private Filter MBQL)
(def ^:private Limit su/IntGreaterThanZero)
(def ^:private JoinStrategy
  (apply s/enum mbql.s/join-strategies))
(def ^:private Joins [{(s/required-key :source)    Source
                       (s/required-key :condition) MBQL
                       (s/optional-key :strategy)  JoinStrategy}])
(def ^:private TransformName s/Str)

Transform step

(def Step
  {(s/required-key :source)      Source
   (s/required-key :name)        Source
   (s/required-key :transform)   TransformName
   (s/optional-key :aggregation) Aggregation
   (s/optional-key :breakout)    Breakout
   (s/optional-key :expressions) Expressions
   (s/optional-key :joins)       Joins
   (s/optional-key :description) Description
   (s/optional-key :limit)       Limit
   (s/optional-key :filter)      Filter})
(def ^:private Steps {Source Step})
(def ^:private DomainEntity s/Str)
(def ^:private Requires [DomainEntity])
(def ^:private Provides [DomainEntity])

Transform spec

(def TransformSpec
  {(s/required-key :name)        TransformName
   (s/required-key :requires)    Requires
   (s/required-key :provides)    Provides
   (s/required-key :steps)       Steps
   (s/optional-key :description) Description})
(defn- extract-dimensions
  [mbql]
  (mbql.u/match (mbql.normalize/normalize mbql) [:dimension dimension & _] dimension))
(def ^:private ^{:arglists '([m])} stringify-keys
  (partial m/map-keys name))
(defn- add-metadata-to-steps
  [spec]
  (update spec :steps (partial m/map-kv-vals (fn [step-name step]
                                               (assoc step
                                                 :name      step-name
                                                 :transform (:name spec))))))
(def ^:private transform-spec-parser
  (sc/coercer!
   TransformSpec
   {MBQL             mbql.normalize/normalize
    Steps            (fn [steps]
                       (->> steps
                            stringify-keys
                            (u/topological-sort (fn [{:keys [source joins]}]
                                                  (conj (map :source joins) source)))))
    Breakout         (fn [breakouts]
                       (for [breakout (u/one-or-many breakouts)]
                         (if (s/check MBQL breakout)
                           [:dimension breakout]
                           breakout)))
    FieldType        (partial keyword "type")
    [DomainEntity]   u/one-or-many
    JoinStrategy     keyword
    ;; Since `Aggregation` and `Expressions` are structurally the same, we can't use them directly
    {Dimension MBQL} (comp (partial u/topological-sort extract-dimensions)
                           stringify-keys)
    ;; Some map keys are names (ie. strings) while the rest are keywords, a distinction lost in YAML
    s/Str            name}))
(def ^:private transforms-dir "transforms/")

List of registered dataset transforms.

(def transform-specs
  (delay (yaml/load-dir transforms-dir (comp transform-spec-parser add-metadata-to-steps))))
 
(ns metabase.troubleshooting
  (:require
   [metabase.analytics.stats :as stats]
   [metabase.config :as config]
   [metabase.db :as mdb]
   [metabase.driver :as driver]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

System info we ask for for bug reports

(defn system-info
  []
  (into (sorted-map)
        (select-keys (System/getProperties) ["java.runtime.name"
                                             "java.runtime.version"
                                             "java.vendor"
                                             "java.vendor.url"
                                             "java.version"
                                             "java.vm.name"
                                             "java.vm.version"
                                             "os.name"
                                             "os.version"
                                             "user.language"
                                             "user.timezone"
                                             "file.encoding"])))

Make it easy for the user to tell us what they're using

(defn metabase-info
  []
  {:databases                    (->> (t2/select 'Database) (map :engine) distinct)
   :hosting-env                  (stats/environment-type)
   :application-database         (mdb/db-type)
   :application-database-details (t2/with-connection [^java.sql.Connection conn]
                                   (let [metadata (.getMetaData conn)]
                                     {:database    {:name    (.getDatabaseProductName metadata)
                                                    :version (.getDatabaseProductVersion metadata)}
                                      :jdbc-driver {:name    (.getDriverName metadata)
                                                    :version (.getDriverVersion metadata)}}))
   :run-mode                     (config/config-kw :mb-run-mode)
   :version                      config/mb-version-info
   :settings                     {:report-timezone (driver/report-timezone)}})
 
(ns metabase.types.coercion-hierarchies
  (:require
   [clojure.set :as set]))

these need to be defonce so we don't drop our hierarchies, but defonce doesn't support docstrings: https://clojure.atlassian.net/browse/CLJ-1148

Map of coercion-strategy -> #{allowed-base-type}.

(defonce ^:private
  strategy->allowed-base-types
  (atom {}))

Map of coercion strategy -> resulting effective-type

(defonce ^:private
  strategy->effective-type
  (atom {}))

Map of base-type -> #{strategy} which are not inheritable. Eg, binary fields are marked type/* and may be coerced to timestamps with :Coercion/YYYYMMDDHHMMSSBytes->Temporal but we don't want all children of type/* to be coerced as such.

(defonce ^:private
  non-descending-base-type->strategy
  (atom {}))

Get a map of strategies -> allowed-base-types. These must live outside of the hierarchy.

(defn non-descending-strategies
  []
  @non-descending-base-type->strategy)

Gets the effective type for strategy. Essentially a getter over the private strategy->effective-type.

(defn effective-type-for-strategy
  [strategy]
  (get @strategy->effective-type strategy))

Ensure x is a sequential collection. Copied from metabase.util as that namespace is not amenable to cljc.

(defn- one-or-many
  [x]
  (if ((some-fn sequential? set? nil?) x) x [x]))

Define the base-type-or-types allowed and the resulting effective-type of a coercion-strategy.

(defn define-types!
  [coercion-strategy base-type-or-types effective-type]
  (let [base-types (set (one-or-many base-type-or-types))]
    (swap! strategy->allowed-base-types assoc coercion-strategy base-types))
  (swap! strategy->effective-type assoc coercion-strategy effective-type))

Define coercion strategies that should not exist for all of the descendants of base-type-or-types.

(defn define-non-inheritable-type!
  [coercion-strategy base-type-or-types effective-type]
  (swap! non-descending-base-type->strategy
         (partial merge-with set/union)
         (zipmap (one-or-many base-type-or-types) (repeat #{coercion-strategy})))
  (swap! strategy->effective-type assoc coercion-strategy effective-type))
(defn- build-hierarchy [pairs]
  (reduce
   (fn [h [tag parent]]
     (derive h tag parent))
   #?(:clj @#'clojure.core/global-hierarchy
      :cljs @(#'clojure.core/get-global-hierarchy))
   pairs))

atom is nil => rebuild the hierarchy

(def ^:private base-type-hierarchy*
  (atom nil))

The global hierarchy, with coercion strategies added as ancestors of their allowed base type(s).

(defn base-type-hierarchy
  []
  (when-not @base-type-hierarchy*
    (locking base-type-hierarchy*
      (when-not @base-type-hierarchy*
        (reset! base-type-hierarchy* (build-hierarchy (for [[strategy base-types] @strategy->allowed-base-types
                                                            base-type             base-types]
                                                        [base-type strategy]))))))
  @base-type-hierarchy*)
(def ^:private effective-type-hierarchy*
  (atom nil))

The global hierarchy, with coercion strategies added as children of their resulting effective type.

(defn effective-type-hierarchy
  []
  (when-not @effective-type-hierarchy*
    (locking effective-type-hierarchy*
      (when-not @effective-type-hierarchy*
        (reset! effective-type-hierarchy* (build-hierarchy (seq @strategy->effective-type))))))
  @effective-type-hierarchy*)

rebuild coercion hierarchies if the global hierarchy changes

(add-watch
 #?(:clj #'clojure.core/global-hierarchy
    :cljs (#'clojure.core/get-global-hierarchy))
 ::rebuild-hierarchies
 (fn [_ _ old new]
   (when-not (= old new)
     (reset! base-type-hierarchy* nil)
     (reset! effective-type-hierarchy* nil))))

rebuild coercion hierarchies if the type map atoms change

(add-watch
 strategy->allowed-base-types
 ::rebuild-hierarchies
 (fn [_ _ old new]
   (when-not (= old new)
     (reset! base-type-hierarchy* nil))))
(add-watch
 strategy->effective-type
 ::rebuild-hierarchies
 (fn [_ _ old new]
   (when-not (= old new)
     (reset! effective-type-hierarchy* nil))))
 
(ns metabase.upload
  (:require
   [clj-bom.core :as bom]
   [clojure.data :as data]
   [clojure.data.csv :as csv]
   [clojure.string :as str]
   [flatland.ordered.map :as ordered-map]
   [flatland.ordered.set :as ordered-set]
   [java-time.api :as t]
   [medley.core :as m]
   [metabase.analytics.snowplow :as snowplow]
   [metabase.api.common :as api]
   [metabase.driver :as driver]
   [metabase.driver.sync :as driver.s]
   [metabase.driver.util :as driver.u]
   [metabase.mbql.util :as mbql.u]
   [metabase.models :refer [Database]]
   [metabase.models.card :as card]
   [metabase.models.collection :as collection]
   [metabase.models.humanization :as humanization]
   [metabase.models.interface :as mi]
   [metabase.models.permissions :as perms]
   [metabase.models.table :as table]
   [metabase.public-settings :as public-settings]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.sync :as sync]
   [metabase.sync.sync-metadata.fields :as sync-fields]
   [metabase.sync.sync-metadata.tables :as sync-tables]
   [metabase.upload.parsing :as upload-parsing]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2])
  (:import
   (java.io File)))
(set! *warn-on-reflection* true)

+------------------+ | Schema detection | +------------------+

Upload types form a DAG (directed acyclic graph) where each type can be coerced into any of its ancestors types. We parse each value in the CSV file to the most-specific possible type for each column. The most-specific possible type for a column is the lowest common ancestor of the types for each value in the column.

         text
          |
          |
     varchar-255┐
   /     / \    │
  /     /   \   └──────────┬
 /     /     \             │

boolean float datetime offset-datetime | │ │ │ │ │ | int date | / \ | / \ | / \ |/ \ boolean-or-int auto-incrementing-int-pk

boolean-or-int is a special type with two parents, where we parse it as a boolean if the whole column's values are of that type. additionally a column cannot have a boolean-or-int type, but a value can. if there is a column with a boolean-or-int value and an integer value, the column will be int if there is a column with a boolean-or-int value and a boolean value, the column will be boolean if there is a column with only boolean-or-int values, the column will be parsed as if it were boolean

(def ^:private type+parent-pairs
  ;; listed in depth-first order
  '([::boolean-or-int ::boolean]
    [::boolean-or-int ::int]
    [::auto-incrementing-int-pk ::int]
    [::int ::float]
    [::date ::datetime]
    [::boolean ::varchar-255]
    [::offset-datetime ::varchar-255]
    [::datetime ::varchar-255]
    [::float ::varchar-255]
    [::varchar-255 ::text]))

Returns the type of a column given the lowest common ancestor type of the values in the column.

(defn ^:private column-type
  [type]
  (case type
    ::boolean-or-int ::boolean
    type))
(def ^:private type->parents
  (reduce
   (fn [m [type parent]]
     (update m type conj parent))
   {}
   type+parent-pairs))

All value types including the root type, ::text

(def ^:private value-types
  (conj (keys type->parents) ::text))

All column types

(def ^:private column-types
  (map column-type value-types))
(defn- bfs-ancestors [type]
  (loop [visit   (list type)
         visited (ordered-set/ordered-set)]
    (if (empty? visit)
      visited
      (let [parents (mapcat type->parents visit)]
        (recur parents (into visited parents))))))

A map from each type to an ordered set of its ancestors, in breadth-first order

(def ^:private type->bfs-ancestors
  (into {} (for [type value-types]
             [type (bfs-ancestors type)])))

[[value->type]] helpers

Returns a regex that matches the argument, with or without surrounding parentheses.

(defn- with-parens
  [number-regex]
  (re-pattern (str "(" number-regex ")|(\\(" number-regex "\\))")))

Returns a regex that matches a positive or negative number, including currency symbols

(defn- with-currency
  [number-regex]
  ;; currency signs can be all over: $2, -$2, $-2, 2€
  (re-pattern (str upload-parsing/currency-regex "?\\s*-?"
                   upload-parsing/currency-regex "?"
                   number-regex
                   "\\s*" upload-parsing/currency-regex "?")))
(defn- int-regex [number-separators]
  (with-parens
    (with-currency
      (case number-separators
        ("." ".,") #"\d[\d,]*"
        ",." #"\d[\d.]*"
        ", " #"\d[\d \u00A0]*"
        ".’" #"\d[\d’]*"))))
(defn- float-regex [number-separators]
  (with-parens
    (with-currency
      (case number-separators
        ("." ".,") #"\d[\d,]*\.\d+"
        ",." #"\d[\d.]*\,[\d]+"
        ", " #"\d[\d \u00A0]*\,[\d.]+"
        ".’" #"\d[\d’]*\.[\d.]+"))))

Returns true if the given body does not throw an exception.

(defmacro does-not-throw?
  [body]
  `(try
     ~body
     true
     (catch Throwable e#
       false)))
(defn- date-string? [s]
  (does-not-throw? (upload-parsing/parse-local-date s)))
(defn- datetime-string? [s]
  (does-not-throw? (upload-parsing/parse-local-datetime s)))
(defn- offset-datetime-string? [s]
  (does-not-throw? (upload-parsing/parse-offset-datetime s)))
(defn- boolean-string? [s]
  (boolean (re-matches #"(?i)true|t|yes|y|1|false|f|no|n|0" s)))
(defn- boolean-or-int-string? [s]
  (boolean (#{"0" "1"} s)))

end [[value->type]] helpers

The most-specific possible type for a given value. Possibilities are:

  • ::boolean
  • ::int
  • ::float
  • ::varchar-255
  • ::date
  • ::datetime
  • ::offset-datetime
  • ::text (the catch-all type)

NB: There are currently the following gotchas: 1. ints/floats are assumed to use the separators and decimal points corresponding to the locale defined in the application settings 2. 0 and 1 are assumed to be booleans, not ints.

(defn- value->type
  [value {:keys [number-separators] :as _settings}]
  (let [trimmed (str/trim value)]
    (cond
      (str/blank? value)                                        nil
      (boolean-or-int-string? trimmed)                          ::boolean-or-int
      (boolean-string? trimmed)                                 ::boolean
      (offset-datetime-string? trimmed)                         ::offset-datetime
      (datetime-string? trimmed)                                ::datetime
      (date-string? trimmed)                                    ::date
      (re-matches (int-regex number-separators) trimmed)        ::int
      (re-matches (float-regex number-separators) trimmed)      ::float
      (<= (count trimmed) 255)                                  ::varchar-255
      :else                                                     ::text)))
(defn- row->value-types
  [row settings]
  (map #(value->type % settings) row))
(defn- lowest-common-member [[x & xs :as all-xs] ys]
  (cond
    (empty? all-xs)  (throw (IllegalArgumentException. (tru "Could not find a common type for {0} and {1}" all-xs ys)))
    (contains? ys x) x
    :else            (recur xs ys)))
(defn- lowest-common-ancestor [type-a type-b]
  (cond
    (nil? type-a) type-b
    (nil? type-b) type-a
    (= type-a type-b) type-a
    (contains? (type->bfs-ancestors type-a) type-b) type-b
    (contains? (type->bfs-ancestors type-b) type-a) type-a
    :else (lowest-common-member (type->bfs-ancestors type-a) (type->bfs-ancestors type-b))))

like map with two args except it continues to apply f until ALL of the colls are exhausted. if colls are of uneven length, nils are supplied.

(defn- map-with-nils
  [f c1 c2]
  (lazy-seq
   (let [s1 (seq c1) s2 (seq c2)]
     (when (or s1 s2)
       (cons (f (first s1) (first s2))
             (map-with-nils f (rest s1) (rest s2)))))))

compares types-a and types-b pairwise, finding the lowest-common-ancestor for each pair. types-a and types-b can be different lengths.

(defn- coalesce-types
  [types-a types-b]
  (map-with-nils lowest-common-ancestor types-a types-b))
(defn- normalize-column-name
  [raw-name]
  (if (str/blank? raw-name)
    "unnamed_column"
    (u/slugify (str/trim raw-name))))

The lower-case name of the auto-incrementing PK column. The actual name in the database could be in upper-case.

(def auto-pk-column-name
  "_mb_row_id")
(defn- table-id->auto-pk-column [table-id]
  (first (filter (fn [field]
                   (= (normalize-column-name (:name field)) auto-pk-column-name))
                 (t2/select :model/Field :table_id table-id :active true))))
(mu/defn column-types-from-rows :- [:sequential (into [:enum] column-types)]
  "Returns a sequence of types, given the unparsed rows in the CSV file"
  [settings column-count rows]
  (->> rows
       (map #(row->value-types % settings))
       (reduce coalesce-types (repeat column-count nil))
       (map (fn [type]
              ;; if there's no values in the column, assume it's a string
              (if (nil? type)
                ::text
                (column-type type))))))

Consumes the header and rows from a CSV file.

Returns a map with two keys: - :extant-columns: an ordered map of columns found in the CSV file, excluding columns that have the same normalized name as the generated columns. - :generated-columns: an ordered map of columns we are generating ourselves. Currently, this is just the auto-incrementing PK.

The value of extant-columns and generated-columns is an ordered map of normalized-column-name -> type for the given CSV file. Supported types include ::int, ::datetime, etc. A column that is completely blank is assumed to be of type ::text.

(defn- detect-schema
  [header rows]
  (let [normalized-header (->> header
                               (map normalize-column-name))
        unique-header     (->> normalized-header
                               mbql.u/uniquify-names
                               (map keyword))
        column-count      (count normalized-header)
        settings          (upload-parsing/get-settings)
        col-name+type-pairs (->> rows
                                 (column-types-from-rows settings column-count)
                                 (map vector unique-header))]
    {:extant-columns    (ordered-map/ordered-map col-name+type-pairs)
     :generated-columns (ordered-map/ordered-map (keyword auto-pk-column-name) ::auto-incrementing-int-pk)}))

+------------------+ | Parsing values | +------------------+

Append the current datetime to the given name to create a unique table name. The resulting name will be short enough for the given driver (truncating the supplised table-name if necessary).

(defn- unique-table-name
  [driver table-name]
  (let [time-format                 "_yyyyMMddHHmmss"
        acceptable-length           (min (count table-name)
                                         (- (driver/table-name-length-limit driver) (count time-format)))
        truncated-name-without-time (subs (u/slugify table-name) 0 acceptable-length)]
    (str truncated-name-without-time
         (t/format time-format (t/local-date-time)))))

Maximum number of values to use for detecting a column's type

(def ^:private max-sample-rows  1000)

Returns an improper subset of the rows no longer than [[max-sample-rows]]. Takes an evenly-distributed sample (not just the first n).

(defn- sample-rows
  [rows]
  (take max-sample-rows
        (take-nth (max 1
                       (long (/ (count rows)
                                max-sample-rows)))
                  rows)))
(defn- upload-type->col-specs
  [driver col->upload-type]
  (update-vals col->upload-type (partial driver/upload-type->database-type driver)))

The database being used for uploads (as per the uploads-database-id setting).

(defn current-database
  []
  (t2/select-one Database :id (public-settings/uploads-database-id)))

Returns a string that can be used as a table identifier in SQL, including a schema if provided.

(mu/defn ^:private table-identifier
  [{:keys [schema name] :as _table}
   :- [:map
       [:schema {:optional true} [:maybe :string]]
       [:name :string]]]
  (if (str/blank? schema)
    name
    (str schema "." name)))

Returns a lazy seq of parsed rows, given a sequence of upload types for each column. Replaces empty strings with nil.

(defn- parse-rows
  [col-upload-types rows]
  (let [settings (upload-parsing/get-settings)
        parsers  (map #(upload-parsing/upload-type->parser % settings) col-upload-types)]
    (for [row rows]
      (for [[value parser] (map-with-nils vector row parsers)]
        (when-not (str/blank? value)
          (parser value))))))

Removes the elements at the given indices from the collection. Indices is a set.

(defn- remove-indices
  [indices coll]
  (keep-indexed (fn [idx item]
                  (when-not (contains? indices idx)
                    item))
                coll))

Returns a lazy seq of the indices where the predicate is true.

(defn- indices-where
  [pred coll]
  (keep-indexed (fn [idx item]
                  (when (pred item)
                    idx))
                coll))

Returns the indices of columns that have the same normalized name as [[auto-pk-column-name]]

(defn- auto-pk-column-indices
  [header]
  (set (indices-where #(= auto-pk-column-name (normalize-column-name %)) header)))
(defn- without-auto-pk-columns
  [header-and-rows]
  (let [header (first header-and-rows)
        auto-pk-indices (auto-pk-column-indices header)]
    (cond->> header-and-rows
      auto-pk-indices
      (map (partial remove-indices auto-pk-indices)))))

Loads a table from a CSV file. If the table already exists, it will throw an error. Returns the file size, number of rows, and number of columns.

(defn- load-from-csv!
  [driver db-id table-name ^File csv-file]
  (with-open [reader (bom/bom-reader csv-file)]
    (let [[header & rows]         (without-auto-pk-columns (csv/read-csv reader))
          {:keys [extant-columns generated-columns]} (detect-schema header (sample-rows rows))
          cols->upload-type       (merge generated-columns extant-columns)
          col-to-create->col-spec (upload-type->col-specs driver cols->upload-type)
          csv-col-names           (keys extant-columns)
          col-upload-types        (vals extant-columns)
          parsed-rows             (vec (parse-rows col-upload-types rows))]
      (driver/create-table! driver db-id table-name col-to-create->col-spec)
      (try
        (driver/insert-into! driver db-id table-name csv-col-names parsed-rows)
        {:num-rows          (count rows)
         :num-columns       (count extant-columns)
         :generated-columns (count generated-columns)
         :size-mb           (/ (.length csv-file)
                               1048576.0)}
        (catch Throwable e
          (driver/drop-table! driver db-id table-name)
          (throw (ex-info (ex-message e) {:status-code 400})))))))

+------------------+ | Create upload +------------------+

For testing purposes, often we'd like to sync synchronously so that we can test the results immediately and avoid race conditions.

(def ^:dynamic *sync-synchronously?*
  false)
(defn- scan-and-sync-table!
  [database table]
  (sync-fields/sync-fields-for-table! database table)
  (if *sync-synchronously?*
    (sync/sync-table! table)
    (future
      (sync/sync-table! table))))

Returns an ExceptionInfo object if the user cannot upload to the given database for the subset of reasons common to all uploads entry points. Returns nil otherwise.

(defn- can-use-uploads-error
  [db]
  (let [driver (driver.u/database->driver db)]
    (cond
      (not (public-settings/uploads-enabled))
      (ex-info (tru "Uploads are not enabled.")
               {:status-code 422})
      (premium-features/sandboxed-user?)
      (ex-info (tru "Uploads are not permitted for sandboxed users.")
               {:status-code 403})
      (not (driver/database-supports? driver :uploads nil))
      (ex-info (tru "Uploads are not supported on {0} databases." (str/capitalize (name driver)))
               {:status-code 422}))))

Returns an ExceptionInfo object if the user cannot upload to the given database and schema. Returns nil otherwise.

(defn- can-create-upload-error
  [db schema-name]
  (or (can-use-uploads-error db)
      (cond
        (and (str/blank? schema-name)
             (driver/database-supports? (driver.u/database->driver db) :schemas db))
        (ex-info (tru "A schema has not been set.")
                 {:status-code 422})
        (not (perms/set-has-full-permissions? @api/*current-user-permissions-set*
                                              (perms/data-perms-path (u/the-id db) schema-name)))
        (ex-info (tru "You don''t have permissions to do that.")
                 {:status-code 403})
        (and (some? schema-name)
             (not (driver.s/include-schema? db schema-name)))
        (ex-info (tru "The schema {0} is not syncable." schema-name)
                 {:status-code 422}))))

Throws an error if the user cannot upload to the given database and schema.

(defn- check-can-create-upload
  [db schema-name]
  (when-let [error (can-create-upload-error db schema-name)]
    (throw error)))

Returns true if the user can upload to the given database and schema, and false otherwise.

(defn can-create-upload?
  [db schema-name]
  (nil? (can-create-upload-error db schema-name)))

+----------------------------------------- | public interface for creating CSV table +-----------------------------------------

Main entry point for CSV uploading.

What it does: - throws an error if the user cannot upload to the given database and schema (see [[can-create-upload-error]] for reasons) - throws an error if the user has write permissions to the given collection - detects the schema of the CSV file - inserts the data into a new table with a unique name, along with an extra auto-generated primary key column - syncs and scans the table - creates a model which wraps the table

Requires that current-user dynamic vars in [[metabase.api.common]] are bound as if by API middleware (this is needed for QP permissions checks). Returns the newly created model. May throw validation, permimissions, or DB errors.

Args: - collection-id: the ID of the collection to create the model in. nil means the root collection. - filename: the name of the file being uploaded. - file: the file being uploaded. - db-id: the ID of the database to upload to. - schema-name: the name of the schema to create the table in (optional). - table-prefix: the prefix to use for the table name (optional).

(mu/defn create-csv-upload!
  [{:keys [collection-id filename ^File file db-id schema-name table-prefix]}
   :- [:map
       [:collection-id [:maybe ms/PositiveInt]]
       [:filename :string]
       [:file (ms/InstanceOfClass File)]
       [:db-id ms/PositiveInt]
       [:schema-name {:optional true} [:maybe :string]]
       [:table-prefix {:optional true} [:maybe :string]]]]
  (let [database (or (t2/select-one Database :id db-id)
                     (throw (ex-info (tru "The uploads database does not exist.")
                                     {:status-code 422})))]
    (check-can-create-upload database schema-name)
    (collection/check-write-perms-for-collection collection-id)
    (try
      (let [start-time        (System/currentTimeMillis)
            driver            (driver.u/database->driver database)
            filename-prefix   (or (second (re-matches #"(.*)\.csv$" filename))
                                  filename)
            table-name        (->> (str table-prefix filename-prefix)
                                   (unique-table-name driver)
                                   (u/lower-case-en))
            schema+table-name (table-identifier {:schema schema-name :name table-name})
            stats             (load-from-csv! driver (:id database) schema+table-name file)
            ;; Sync immediately to create the Table and its Fields; the scan is settings-dependent and can be async
            table             (sync-tables/create-or-reactivate-table! database {:name table-name :schema (not-empty schema-name)})
            _set_is_upload    (t2/update! :model/Table (:id table) {:is_upload true})
            _sync             (scan-and-sync-table! database table)
            ;; Set the display_name of the auto-generated primary key column to the same as its name, so that if users
            ;; download results from the table as a CSV and reupload, we'll recognize it as the same column
            auto-pk-field     (table-id->auto-pk-column (:id table))
            _                 (t2/update! :model/Field (:id auto-pk-field) {:display_name (:name auto-pk-field)})
            card              (card/create-card!
                               {:collection_id          collection-id
                                :dataset                true
                                :database_id            (:id database)
                                :dataset_query          {:database (:id database)
                                                         :query    {:source-table (:id table)}
                                                         :type     :query}
                                :display                :table
                                :name                   (humanization/name->human-readable-name filename-prefix)
                                :visualization_settings {}}
                               @api/*current-user*)
            upload-seconds    (/ (- (System/currentTimeMillis) start-time)
                                 1000.0)]
        (snowplow/track-event! ::snowplow/csv-upload-successful
                               api/*current-user-id*
                               (merge
                                {:model-id       (:id card)
                                 :upload-seconds upload-seconds}
                                stats))
        card)
      (catch Throwable e
        (let [fail-stats (with-open [reader (bom/bom-reader file)]
                           (let [rows (csv/read-csv reader)]
                             {:size-mb     (/ (.length file) 1048576.0)
                              :num-columns (count (first rows))
                              :num-rows    (count (rest rows))}))]
          (snowplow/track-event! ::snowplow/csv-upload-failed api/*current-user-id* fail-stats))
        (throw e)))))

+----------------------------- | appending to uploaded table +-----------------------------

Returns the most specific upload type for the given base type.

(defn- base-type->upload-type
  [base-type]
  (condp #(isa? %2 %1) base-type
    :type/Float                  ::float
    :type/BigInteger             ::int
    :type/Integer                ::int
    :type/Boolean                ::boolean
    :type/DateTimeWithTZ         ::offset-datetime
    :type/DateTime               ::datetime
    :type/Date                   ::date
    :type/Text                   ::text))

Throws an exception if: - the CSV file contains duplicate column names - the schema of the CSV file does not match the schema of the table

(defn- check-schema
  [fields-by-normed-name header]
  ;; Assumes table-cols are unique when normalized
  (let [normalized-field-names (keys fields-by-normed-name)
        normalized-header (map normalize-column-name header)
        [extra missing _both] (data/diff (set normalized-header) (set normalized-field-names))]
    ;; check for duplicates
    (when (some #(< 1 %) (vals (frequencies normalized-header)))
      (throw (ex-info (tru "The CSV file contains duplicate column names.")
                      {:status-code 422})))
    (when (or extra missing)
      (let [format-columns (fn [cols]
                             (str/join ", " (map #(str "\"" % "\"") cols)))
            error-message (cond
                            (and extra missing)
                            (tru "The CSV file contains extra columns that are not in the table: {0}. The CSV file is missing columns that are in the table: {1}."
                                 (format-columns extra) (format-columns missing))
                            extra
                            (tru "The CSV file contains extra columns that are not in the table: {0}."
                                 (format-columns extra))
                            missing
                            (tru "The CSV file contains extra columns that are not in the table: {0}."
                                 (format-columns missing)))]
        (throw (ex-info error-message {:status-code 422}))))))
(defn- append-csv!*
  [database table file]
  (with-open [reader (bom/bom-reader file)]
    (let [[header & rows]    (without-auto-pk-columns (csv/read-csv reader))
          driver             (driver.u/database->driver database)
          normed-name->field (m/index-by (comp normalize-column-name :name)
                                         (t2/select :model/Field :table_id (:id table) :active true))
          normed-header      (map normalize-column-name header)
          create-auto-pk?    (not (contains? normed-name->field auto-pk-column-name))
          _                  (check-schema (dissoc normed-name->field auto-pk-column-name) header)
          col-upload-types   (map (comp base-type->upload-type :base_type normed-name->field) normed-header)
          parsed-rows        (parse-rows col-upload-types rows)]
      (try
        (driver/insert-into! driver (:id database) (table-identifier table) normed-header parsed-rows)
        (catch Throwable e
          (throw (ex-info (ex-message e) {:status-code 422}))))
      (when create-auto-pk?
        (driver/add-columns! driver
                             (:id database)
                             (table-identifier table)
                             {(keyword auto-pk-column-name) (driver/upload-type->database-type driver ::auto-incrementing-int-pk)}))
      (scan-and-sync-table! database table)
      (when create-auto-pk?
        (let [auto-pk-field (table-id->auto-pk-column (:id table))]
          (t2/update! :model/Field (:id auto-pk-field) {:display_name (:name auto-pk-field)})))
      {:row-count (count parsed-rows)})))

Returns an ExceptionInfo object if the user cannot upload to the given database and schema. Returns nil otherwise.

(defn- can-append-error
  [db table]
  (or (can-use-uploads-error db)
      (cond
        (not (:is_upload table))
        (ex-info (tru "The table must be an uploaded table.")
                 {:status-code 422})
        (not (mi/can-read? table))
        (ex-info (tru "You don''t have permissions to do that.")
                 {:status-code 403}))))

Throws an error if the user cannot upload to the given database and schema.

(defn- check-can-append
  [db table]
  (when-let [error (can-append-error db table)]
    (throw error)))

Returns true if the user can upload to the given database and table, and false otherwise.

This will be used in merge 2 of milestone 1 to populate a property on the table for the FE.

(defn can-upload-to-table?
  [db table]
  (nil? (can-append-error db table)))

+-------------------------------------------------- | public interface for appending to uploaded table +--------------------------------------------------

Main entry point for appending to uploaded tables with a CSV file.

(mu/defn append-csv!
  [{:keys [^File file table-id]}
   :- [:map
       [:table-id ms/PositiveInt]
       [:file (ms/InstanceOfClass File)]]]
  (let [table    (api/check-404 (t2/select-one :model/Table :id table-id))
        database (table/database table)]
    (check-can-append database table)
    (append-csv!* database table file)))
 
(ns metabase.upload.parsing
  (:require
   [clojure.string :as str]
   [java-time.api :as t]
   [metabase.public-settings :as public-settings]
   [metabase.util.i18n :refer [tru]])
  (:import
   (java.time LocalDate)
   (java.time.format DateTimeFormatter DateTimeFormatterBuilder ResolverStyle)
   (java.text NumberFormat)
   (java.util Locale)))
(set! *warn-on-reflection* true)

Supported currency signs

(def currency-regex  #"[$€£¥₹₪₩₿¢\s]")

Settings that determine how the CSV is parsed.

Includes: - number-separators: Decimal delimiter defaults to . and group delimiter defaults to ,. Stored/returned as a string.

(defn get-settings
  []
  {:number-separators (get-in (public-settings/custom-formatting) [:type/Number :number_separators] ".,")})

Parses a boolean value (true/t/yes/y/1 and false/f/no/n/0). Case-insensitive.

(defn- parse-bool
  [s]
  (cond
    (re-matches #"(?i)true|t|yes|y|1" s) true
    (re-matches #"(?i)false|f|no|n|0" s) false
    :else                                (throw (IllegalArgumentException.
                                                 (tru "''{0}'' is not a recognizable boolean" s)))))

patterns used to generate the local date formatter. Excludes ISOLOCALDATE (uuuu-MM-dd) because there's already a built-in DateTimeFormatter for that: [[DateTimeFormatter/ISOLOCALDATE]]

(def local-date-patterns
  ;; uuuu is like yyyy but is required for strict parsing and also supports negative years for BC dates
  ;; see https://stackoverflow.com/questions/41103603/issue-with-datetimeparseexception-when-using-strict-resolver-style
  ;; uuuu is faster than using yyyy and setting a default era
  ["MMM dd uuuu"        ; Jan 30 2000
   "MMM dd, uuuu"       ; Jan 30, 2000
   "dd MMM uuuu"        ; 30 Jan 2000
   "dd MMM, uuuu"       ; 30 Jan, 2000
   "MMMM d uuuu"        ; January 30 2000
   "MMMM d, uuuu"       ; January 30, 2000
   "d MMMM uuuu"        ; 30 January 2000
   "d MMMM, uuuu"       ; 30 January, 2000
   "EEEE, MMMM d uuuu"  ; Sunday, January 30 2000
   "EEEE, MMMM d, uuuu" ; Sunday, January 30, 2000
   ])

DateTimeFormatter that runs through a set of patterns to parse a variety of local date formats.

(def local-date-formatter
  (let [builder (-> (DateTimeFormatterBuilder.)
                    (.parseCaseInsensitive))]
    (doseq [pattern local-date-patterns]
      (.appendOptional builder (DateTimeFormatter/ofPattern pattern)))
    (-> builder
        (.appendOptional DateTimeFormatter/ISO_LOCAL_DATE)
        (.toFormatter)
        (.withResolverStyle ResolverStyle/STRICT))))

Parses a local date string.

Supported formats: - yyyy-MM-dd - MMM dd yyyy - MMM dd, yyyy - dd MMM yyyy - dd MMM, yyyy - MMMM d yyyy - MMMM d, yyyy - d MMMM yyyy - d MMMM, yyyy

(defn parse-local-date
  [s]
  (try
    (LocalDate/parse s local-date-formatter)
    (catch Exception _
      (throw (IllegalArgumentException.
              (tru "''{0}'' is not a recognizable date" s))))))

Parses a string representing a local datetime into a LocalDateTime.

Supported formats: - yyyy-MM-dd'T'HH:mm - yyyy-MM-dd'T'HH:mm:ss - yyyy-MM-dd'T'HH:mm:ss.SSS (and any other number of S's) - the above formats, with a space instead of a 'T'

Parsing is case-insensitive.

(defn parse-local-datetime
  [s]
  (-> s (str/replace \space \T) t/local-date-time))

Parses a string s as a LocalDateTime. Supports all the formats for [[parse-local-date]] and [[parse-datetime]].

(defn- parse-as-datetime
  [s]
  (try
    (t/local-date-time (parse-local-date s) (t/local-time "00:00:00"))
    (catch Exception _
      (try
        (parse-local-datetime s)
        (catch Exception _
          (throw (IllegalArgumentException.
                  (tru "''{0}'' is not a recognizable datetime" s))))))))

Parses a string representing an offset datetime into an OffsetDateTime.

The format consists of: 1) The a date and time, with the formats: - yyyy-MM-dd'T'HH:mm - yyyy-MM-dd'T'HH:mm:ss - yyyy-MM-dd'T'HH:mm:ss.SSS (and any other number of S's) - the above formats, with a space instead of a 'T' 2) An offset, with the formats: - Z (for UTC) - +HH or -HH - +HH:mm or -HH:mm - +HH:mm:ss or -HH:mm:ss

Parsing is case-insensitive.

(defn parse-offset-datetime
  [s]
  (try
    (-> s (str/replace \space \T) t/offset-date-time)
    (catch Exception _
      (throw (IllegalArgumentException. (tru "''{0}'' is not a recognizable zoned datetime" s))))))

Remove any recognized currency signs from the string (c.f. [[currency-regex]]).

(defn- remove-currency-signs
  [s]
  (str/replace s currency-regex ""))
(let [us (NumberFormat/getInstance (Locale. "en" "US"))
      de (NumberFormat/getInstance (Locale. "de" "DE"))
      fr (NumberFormat/getInstance (Locale. "fr" "FR"))
      ch (NumberFormat/getInstance (Locale. "de" "CH"))]
  (defn- parse-plain-number [number-separators s]
    (let [has-parens?       (re-matches #"\(.*\)" s)
          deparenthesized-s (str/replace s #"[()]" )
          parsed-number     (case number-separators
                              ("." ".,") (. us parse deparenthesized-s)
                              ",."       (. de parse deparenthesized-s)
                              ", "       (. fr parse (str/replace deparenthesized-s \space \u00A0)) ; \u00A0 is a non-breaking space
                              ".’"       (. ch parse deparenthesized-s))]
      (if has-parens?
        (- parsed-number)
        parsed-number))))

Parse an integer or float

(defn- parse-number
  [number-separators s]
  (try
    (->> s
         (str/trim)
         (remove-currency-signs)
         (parse-plain-number number-separators))
    (catch Exception _
      (throw (IllegalArgumentException. (tru "''{0}'' is not a recognizable number" s))))))

Parses a string representing a number as a java.math.BigInteger, rounding down if necessary.

(defn- parse-as-biginteger
  [number-separators s]
  (biginteger (parse-number number-separators s)))

Returns a function for the given metabase.upload column type that will parse a string value (from a CSV) into a value suitable for insertion.

(defmulti upload-type->parser
  {:arglists '([upload-type settings])}
  (fn [upload-type _]
    upload-type))
(defmethod upload-type->parser :metabase.upload/varchar-255
  [_ _]
  identity)
(defmethod upload-type->parser :metabase.upload/text
  [_ _]
  identity)
(defmethod upload-type->parser :metabase.upload/int
  [_ {:keys [number-separators]}]
  (partial parse-as-biginteger number-separators))
(defmethod upload-type->parser :metabase.upload/float
  [_ {:keys [number-separators]}]
  (partial parse-number number-separators))
(defmethod upload-type->parser :metabase.upload/auto-incrementing-int-pk
  [_ {:keys [number-separators]}]
  (partial parse-as-biginteger number-separators))
(defmethod upload-type->parser :metabase.upload/boolean
  [_ _]
  (comp
   parse-bool
   str/trim))
(defmethod upload-type->parser :metabase.upload/date
  [_ _]
  (comp
   parse-local-date
   str/trim))
(defmethod upload-type->parser :metabase.upload/datetime
  [_ _]
  (comp
   parse-as-datetime
   str/trim))
(defmethod upload-type->parser :metabase.upload/offset-datetime
  [_ _]
  (comp
   parse-offset-datetime
   str/trim))
 
(ns metabase.util.connection
  (:require [metabase.util :as u]
            [toucan2.core :as t2])
  (:import
   (java.sql Connection)))
(set! *warn-on-reflection* true)

Returns a map of all column names to their respective type names for the given table-name in the provided application-db.

(defn app-db-column-types
  [app-db table-name']
  (let [table-name (cond-> table-name'
                     (= (:db-type app-db) :h2) u/upper-case-en)]
    (t2/with-connection [^Connection conn]
      (with-open [rset (.getColumns (.getMetaData conn) nil nil table-name nil)]
        (into {}
              (iteration
               (fn [_]
                 (when (.next rset)
                   [(.getString rset "COLUMN_NAME") (.getString rset "TYPE_NAME")]))))))))
 

Utility functions for converting frontend schedule dictionaries to cron strings and vice versa. See http://www.quartz-scheduler.org/documentation/quartz-2.x/tutorials/crontrigger.html#format for details on cron format.

(ns metabase.util.cron
  (:require
   [clojure.string :as str]
   [metabase.util.i18n :as i18n]
   [metabase.util.malli :as mu]
   [metabase.util.malli.registry :as mr]
   [metabase.util.malli.schema :as ms])
  (:import
   (net.redhogs.cronparser CronExpressionDescriptor)
   (org.quartz CronExpression)))
(set! *warn-on-reflection* true)
(mr/def ::CronScheduleString
  (mu/with-api-error-message
   [:and
    ms/NonBlankString
    [:fn
     {:error/message "Invalid cron schedule string."}
     (fn [^String s]
       (try
         (CronExpression/validateExpression s)
         true
         (catch Throwable _
           false)))]]
   (i18n/deferred-tru "value must be a valid Quartz cron schedule string.")))

Malli Schema for a valid cron schedule string.

(def CronScheduleString
  [:ref ::CronScheduleString])
(mr/def ::CronHour
  [:int {:min 0, :max 23}])
(mr/def ::CronMinute
  [:int {:min 0, :max 59}])
(mr/def ::ScheduleMap
  (mu/with-api-error-message
   [:map
    {:error/message "Expanded schedule map"}
    [:schedule_type                    [:enum "hourly" "daily" "weekly" "monthly"]]
    [:schedule_day    {:optional true} [:maybe [:enum "sun" "mon" "tue" "wed" "thu" "fri" "sat"]]]
    [:schedule_frame  {:optional true} [:maybe [:enum "first" "mid" "last"]]]
    [:schedule_hour   {:optional true} [:maybe ::CronHour]]
    [:schedule_minute {:optional true} [:maybe ::CronMinute]]]
   (i18n/deferred-tru "value must be a valid schedule map. See schema in metabase.util.cron for details.")))

Schema for a frontend-parsable schedule map. Used for Pulses and DB scheduling.

(def ScheduleMap
  [:ref ::ScheduleMap])

+----------------------------------------------------------------------------------------------------------------+ | SCHEDULE MAP -> CRON STRING | +----------------------------------------------------------------------------------------------------------------+

(mu/defn ^:private cron-string :- CronScheduleString
  "Build a cron string from key-value pair parts."
  [{:keys [seconds minutes hours day-of-month month day-of-week year]}]
  (str/join " " [(or seconds      "0")
                 (or minutes      "0")
                 (or hours        "*")
                 (or day-of-month "*")
                 (or month        "*")
                 (or day-of-week  "?")
                 (or year         "*")]))
(def ^:private day-of-week->cron
  {"sun"  1
   "mon"  2
   "tue"  3
   "wed"  4
   "thu"  5
   "fri"  6
   "sat"  7})
(defn- frame->cron [frame day-of-week]
  (if day-of-week
    ;; specific days of week like Mon or Fri
    (assoc {:day-of-month "?"}
      :day-of-week (case frame
                     "first" (str (day-of-week->cron day-of-week) "#1")
                     "last"  (str (day-of-week->cron day-of-week) "L")))
    ;; specific CALENDAR DAYS like 1st or 15th
    (assoc {:day-of-week "?"}
      :day-of-month (case frame
                      "first" "1"
                      "mid"   "15"
                      "last"  "L"))))
(mu/defn schedule-map->cron-string :- CronScheduleString
  "Convert the frontend schedule map into a cron string."
  [{day-of-week :schedule_day, hour :schedule_hour, minute :schedule_minute,
    frame :schedule_frame,  schedule-type :schedule_type} :- ScheduleMap]
  (cron-string (case (keyword schedule-type)
                 :hourly  {:minutes minute}
                 :daily   {:hours (or hour 0)}
                 :weekly  {:hours       hour
                           :day-of-week (day-of-week->cron day-of-week)
                           :day-of-month "?"}
                 :monthly (assoc (frame->cron frame day-of-week)
                            :hours hour))))

+----------------------------------------------------------------------------------------------------------------+ | CRON STRING -> SCHEDULE MAP | +----------------------------------------------------------------------------------------------------------------+

(defn- cron->day-of-week [day-of-week]
  (when-let [[_ day-of-week] (re-matches #"(^\d).*$" day-of-week)]
    (case day-of-week
      "1" "sun"
      "2" "mon"
      "3" "tue"
      "4" "wed"
      "5" "thu"
      "6" "fri"
      "7" "sat")))
(defn- cron-day-of-week+day-of-month->frame [day-of-week day-of-month]
  (cond
    (re-matches #"^\d#1$" day-of-week) "first"
    (re-matches #"^\dL$"  day-of-week) "last"
    (= day-of-month "1")               "first"
    (= day-of-month "15")              "mid"
    (= day-of-month "L")               "last"
    :else                              nil))
(defn- cron->digit [digit]
  (when (and digit
             (not= digit "*"))
    (Integer/parseInt digit)))
(defn- cron->schedule-type [hours day-of-month day-of-week]
  (cond
    (and day-of-month
         (not= day-of-month "*")
         (or (= day-of-week "?")
             (re-matches #"^\d#1$" day-of-week)
             (re-matches #"^\dL$"  day-of-week))) "monthly"
    (and day-of-week
         (not= day-of-week "?"))                  "weekly"
    (and hours
         (not= hours "*"))                        "daily"
    :else                                         "hourly"))
(mu/defn ^{:style/indent 0} cron-string->schedule-map :- ScheduleMap
  "Convert a normal `cron-string` into the expanded ScheduleMap format used by the frontend."
  [cron-string :- CronScheduleString]
  (let [[_ mins hours day-of-month _ day-of-week _] (str/split cron-string #"\s+")]
    {:schedule_minute (cron->digit mins)
     :schedule_day    (cron->day-of-week day-of-week)
     :schedule_frame  (cron-day-of-week+day-of-month->frame day-of-week day-of-month)
     :schedule_hour   (cron->digit hours)
     :schedule_type   (cron->schedule-type hours day-of-month day-of-week)}))
(mu/defn describe-cron-string :- ms/NonBlankString
  "Return a human-readable description of a cron expression, localized for the current User."
  [^String cron-string :- CronScheduleString]
  (CronExpressionDescriptor/getDescription cron-string (i18n/user-locale)))
 

Replacement for metabase.util.date that consistently uses java.time instead of a mix of java.util.Date, java.sql.*, and Joda-Time.

(ns metabase.util.date-2
  (:refer-clojure :exclude [format range])
  (:require
   [clojure.string :as str]
   [java-time.api :as t]
   [java-time.core :as t.core]
   [metabase.util.date-2.common :as u.date.common]
   [metabase.util.date-2.parse :as u.date.parse]
   [metabase.util.i18n :as i18n :refer [tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [potemkin.types :as p.types])
  (:import
   (java.time DayOfWeek Duration Instant LocalDate LocalDateTime LocalTime OffsetDateTime OffsetTime Period ZonedDateTime)
   (java.time.format DateTimeFormatter DateTimeFormatterBuilder FormatStyle TextStyle)
   (java.time.temporal Temporal TemporalAdjuster WeekFields)
   (org.threeten.extra PeriodDuration)))
(set! *warn-on-reflection* true)
(def ^:private TemporalInstance
  [:fn
   {:error/message "Instance of a java.time.temporal.Temporal"}
   (partial instance? Temporal)])

Converts a temporal type without timezone info to one with zone info (i.e., a ZonedDateTime).

(defn- add-zone-to-local
  [t timezone-id]
  (condp instance? t
    LocalDateTime (t/zoned-date-time t (t/zone-id timezone-id))
    LocalDate     (t/zoned-date-time t (t/local-time 0) (t/zone-id timezone-id))
    ;; don't attempt to convert local times to offset times because we have no idea what the offset
    ;; actually should be, since we don't know the date. Since it's not an exact instant in time we're
    ;; not using it to make ranges in MBQL filter clauses anyway
    ;;
    ;; TIMEZONE FIXME - not sure we even want to be adding zone-id info for the timestamps above either
    #_LocalTime   #_ (t/offset-time t (t/zone-id timezone-id))
    t))

With one arg, parse a temporal literal into a corresponding java.time class, such as LocalDate or OffsetDateTime. With a second arg, literals that do not explicitly specify a timezone are interpreted as being in timezone-id.

(defn parse
  ([s]
   (u.date.parse/parse s))
  ([s default-timezone-id]
   (let [result (parse s)]
     (if-not default-timezone-id
       result
       (let [result-with-timezone (add-zone-to-local result default-timezone-id)]
         (when-not (= result result-with-timezone)
           (log/tracef "Applying default timezone %s to temporal literal without timezone '%s' -> %s"
                       default-timezone-id s (pr-str result-with-timezone)))
         result-with-timezone)))))
(defn- temporal->iso-8601-formatter [t]
  (condp instance? t
    Instant        :iso-offset-date-time
    LocalDate      :iso-local-date
    LocalTime      :iso-local-time
    LocalDateTime  :iso-local-date-time
    OffsetTime     :iso-offset-time
    OffsetDateTime :iso-offset-date-time
    ZonedDateTime  :iso-offset-date-time))

Format temporal value t, by default as an ISO-8601 date/time/datetime string. By default t is formatted in a way that's appropriate for its type, e.g. a LocalDate is formatted as year-month-day. You can optionally pass formatter to format a different way. formatter can be:

  1. A keyword name of a predefined formatter. Eval

    (keys java-time.format/predefined-formatters)

    for a list of predefined formatters.

    1. An instance of java.time.format.DateTimeFormatter. You can use utils in metabase.util.date-2.parse.builder to help create one of these formatters.

    2. A format String e.g. YYYY-MM-dd

(defn format
  (^String [t]
   (when t
     (format (temporal->iso-8601-formatter t) t)))
  (^String [formatter t]
   (format formatter t nil))
  (^String [formatter t locale]
   (cond
     (t/instant? t)
     (recur formatter (t/zoned-date-time t (t/zone-id "UTC")) locale)
     locale
     (recur (.withLocale (t/formatter formatter) (i18n/locale locale)) t nil)
     :else
     (t/format formatter t))))

Format temporal value t, as an RFC3339 datetime string.

(defn format-rfc3339
  [t]
  (cond
    (instance? Instant t)
    (recur (t/zoned-date-time t (t/zone-id "UTC")))
    ;; the rfc3339 format requires a timezone component so convert any local datetime/date to zoned
    (instance? LocalDateTime t)
    (recur (t/zoned-date-time t (t/zone-id)))
    (instance? LocalDate t)
    (recur (t/zoned-date-time t (t/local-time 0) (t/zone-id)))
    :else
    (t/format "yyyy-MM-dd'T'hh:mm:ss.SSXXX" t)))

Format a temporal value t as a SQL-style literal string (for most SQL databases). This is the same as ISO-8601 but uses a space rather than of a T to separate the date and time components.

(defn format-sql
  ^String [t]
  ;; replace the `T` with a space. Easy!
  (str/replace-first (format t) #"(\d{2})T(\d{2})" "$1 $2"))
(def ^:private ^{:arglists '(^java.time.format.DateTimeFormatter [klass])} class->human-readable-formatter
  {LocalDate      (DateTimeFormatter/ofLocalizedDate FormatStyle/LONG)
   LocalTime      (DateTimeFormatter/ofLocalizedTime FormatStyle/MEDIUM)
   LocalDateTime  (let [builder (doto (DateTimeFormatterBuilder.)
                                  (.appendLocalized FormatStyle/LONG FormatStyle/MEDIUM))]
                    (.toFormatter builder))
   OffsetTime     (let [builder (doto (DateTimeFormatterBuilder.)
                                  (.append (DateTimeFormatter/ofLocalizedTime FormatStyle/MEDIUM))
                                  (.appendLiteral " (")
                                  (.appendLocalizedOffset TextStyle/FULL)
                                  (.appendLiteral ")"))]
                    (.toFormatter builder))
   OffsetDateTime (let [builder (doto (DateTimeFormatterBuilder.)
                                  (.appendLocalized FormatStyle/LONG FormatStyle/MEDIUM)
                                  (.appendLiteral " (")
                                  (.appendLocalizedOffset TextStyle/FULL)
                                  (.appendLiteral ")"))]
                    (.toFormatter builder))
   ZonedDateTime  (let [builder (doto (DateTimeFormatterBuilder.)
                                  (.appendLocalized FormatStyle/LONG FormatStyle/MEDIUM)
                                  (.appendLiteral " (")
                                  (.appendZoneText TextStyle/FULL)
                                  (.appendLiteral ")"))]
                    (.toFormatter builder))})

Format a temporal value t in a human-friendly way for locale (by default, the current User's locale).

(format-human-readable #t "2021-04-02T14:42:09.524392-07:00[US/Pacific]" "es-MX") ;; -> "2 de abril de 2021 02:42:09 PM PDT"

(defn format-human-readable
  ([t]
   (format-human-readable t (i18n/user-locale)))
  ([t locale]
   (when t
     (if-let [formatter (some (fn [[klass formatter]]
                                (when (instance? klass t)
                                  formatter))
                              class->human-readable-formatter)]
       (format formatter t locale)
       (throw (ex-info (tru "Don''t know how to format a {0} as a human-readable date/time"
                            (some-> t class .getCanonicalName))
                       {:t t}))))))

A list of units that can be added to a temporal value.

(def add-units
  #{:millisecond :second :minute :hour :day :week :month :quarter :year})
(mu/defn add :- TemporalInstance
  "Return a temporal value relative to temporal value `t` by adding (or subtracting) a number of units. Returned value
  will be of same class as `t`.
    (add (t/zoned-date-time \"2019-11-05T15:44-08:00[US/Pacific]\") :month 2)
    ->
    (t/zoned-date-time \"2020-01-05T15:44-08:00[US/Pacific]\")"
  ([unit amount]
   (add (t/zoned-date-time) unit amount))
  ([t      :- TemporalInstance
    unit   :- (into [:enum] add-units)
    amount :- [:maybe :int]]
   (if (zero? amount)
     t
     (t/plus t (case unit
                 :millisecond (t/millis amount)
                 :second      (t/seconds amount)
                 :minute      (t/minutes amount)
                 :hour        (t/hours amount)
                 :day         (t/days amount)
                 :week        (t/days (* amount 7))
                 :month       (t/months amount)
                 :quarter     (t/months (* amount 3))
                 :year        (t/years amount))))))

Units which return a (numerical, periodic) component of a date

TIMEZONE FIXME - we should add :millisecond-of-second (or :fraction-of-second?) . Not sure where we'd use these, but we should have them for consistency

(def extract-units
  #{:second-of-minute
    :minute-of-hour
    :hour-of-day
    :day-of-week
    :day-of-month
    :day-of-year
    :week-of-year
    :month-of-year
    :quarter-of-year
    ;; TODO - in this namespace `:year` is something you can both extract and truncate to. In MBQL `:year` is a truncation
    ;; operation. Maybe we should rename this unit to clear up the potential confusion (?)
    :year})
(defn- start-of-week []
  (keyword ((requiring-resolve 'metabase.public-settings/start-of-week))))
(def ^:private ^{:arglists '(^java.time.DayOfWeek [k])} day-of-week*
  (let [m (u.date.common/static-instances DayOfWeek)]
    (fn [k]
      (or (get m k)
          (throw (ex-info (tru "Invalid day of week: {0}" (pr-str k))
                          {:k k, :allowed (keys m)}))))))

Create a new instance of a WeekFields, which is used for localized day-of-week, week-of-month, and week-of-year.

(week-fields :monday) ; -> #object[java.time.temporal.WeekFields "WeekFields[MONDAY,1]"]

(defn- week-fields
  (^WeekFields [first-day-of-week]
   ;; TODO -- ISO weeks only consider a week to be in a year if it has 4+ days in that year... `:week-of-year`
   ;; extraction is liable to be off for people who expect that definition of "week of year". We should probably make
   ;; this a Setting. See #15039 for more information
   (week-fields first-day-of-week 1))
  (^WeekFields [first-day-of-week ^Integer minimum-number-of-days-in-first-week]
   (WeekFields/of (day-of-week* first-day-of-week) minimum-number-of-days-in-first-week)))
(mu/defn extract :- :int
  "Extract a field such as `:minute-of-hour` from a temporal value `t`.
    (extract (t/zoned-date-time \"2019-11-05T15:44-08:00[US/Pacific]\") :day-of-month)
    ;; -> 5
  Values are returned as numbers (currently, always and integers, but this may change if we add support for
  `:fraction-of-second` in the future.)"
  ([unit]
   (extract (t/zoned-date-time) unit))
  ([t    :- TemporalInstance
    unit :- (into [:enum] extract-units)]
   (t/as t (case unit
             :second-of-minute :second-of-minute
             :minute-of-hour   :minute-of-hour
             :hour-of-day      :hour-of-day
             :day-of-week      (.dayOfWeek (week-fields (start-of-week)))
             :day-of-month     :day-of-month
             :day-of-year      :day-of-year
             :week-of-year     (.weekOfYear (week-fields (start-of-week)))
             :month-of-year    :month-of-year
             :quarter-of-year  :quarter-of-year
             :year             :year))))

Get the custom TemporalAdjuster named by k.

;; adjust 2019-12-10T17:26 to the second week of the year (t/adjust #t "2019-12-10T17:26" (u.date/adjuster :week-of-year 2)) ;; -> #t "2019-01-06T17:26"

(defmulti ^TemporalAdjuster adjuster
  {:arglists '([k & args])}
  (fn [k & _] (keyword k)))
(defmethod adjuster :default
  [k]
  (throw (Exception. (tru "No temporal adjuster named {0}" k))))
(defmethod adjuster :first-day-of-week
  [_]
  (reify TemporalAdjuster
    (adjustInto [_ t]
      (t/adjust t :previous-or-same-day-of-week (start-of-week)))))
(defmethod adjuster :first-day-of-quarter
  [_]
  (reify TemporalAdjuster
    (adjustInto [_ t]
      (.with t (.atDay (t/year-quarter t) 1)))))
(defmethod adjuster :first-week-of-year
  [_]
  (reify TemporalAdjuster
    (adjustInto [_ t]
      (-> t
          (t/adjust :first-day-of-year)
          (t/adjust (adjuster :first-day-of-week))))))
(defmethod adjuster :week-of-year
  [_ week-of-year]
  (reify TemporalAdjuster
    (adjustInto [_ t]
      (-> t
          (t/adjust (adjuster :first-week-of-year))
          (t/plus (t/weeks (dec week-of-year)))))))

if you attempt to truncate a LocalDate to :day or anything smaller we can go ahead and return it as is

(extend-protocol t.core/Truncatable
  LocalDate
  (truncate-to [t unit]
    (case unit
      :millis  t
      :seconds t
      :minutes t
      :hours   t
      :days    t)))

See https://github.com/dm3/clojure.java-time/issues/95. We need to update the java-time/truncate-to copy of the actual underlying method since extend-protocol mutates the var

(alter-var-root #'t/truncate-to (constantly t.core/truncate-to))

Valid date trucation units

(def truncate-units
  #{:millisecond :second :minute :hour :day :week :month :quarter :year})
(mu/defn truncate :- TemporalInstance
  "Truncate a temporal value `t` to the beginning of `unit`, e.g. `:hour` or `:day`. Not all truncation units are
  supported on all subclasses of `Temporal` — for example, you can't truncate a `LocalTime` to `:month`, for obvious
  reasons."
  ([unit]
   (truncate (t/zoned-date-time) unit))
  ([^Temporal t :- TemporalInstance
    unit        :- (into [:enum] truncate-units)]
   (case unit
     :default     t
     :millisecond (t/truncate-to t :millis)
     :second      (t/truncate-to t :seconds)
     :minute      (t/truncate-to t :minutes)
     :hour        (t/truncate-to t :hours)
     :day         (t/truncate-to t :days)
     :week        (-> (.with t (adjuster :first-day-of-week))    (t/truncate-to :days))
     :month       (-> (t/adjust t :first-day-of-month)           (t/truncate-to :days))
     :quarter     (-> (.with t (adjuster :first-day-of-quarter)) (t/truncate-to :days))
     :year        (-> (t/adjust t :first-day-of-year)            (t/truncate-to :days)))))
(mu/defn bucket :- [:or number? TemporalInstance]
  "Perform a truncation or extraction unit on temporal value `t`. (These two operations are collectively known as
  'date bucketing' in Metabase code and MBQL, e.g. for date/time columns in MBQL `:breakout` (SQL `GROUP BY`)).
  You can combine this function with `group-by` to do some date/time bucketing in Clojure-land:
    (group-by #(bucket % :quarter-of-year) (map t/local-date [\"2019-01-01\" \"2019-01-02\" \"2019-01-04\"]))
    ;; -> {1 [(t/local-date \"2019-01-01\") (t/local-date \"2019-01-02\")], 2 [(t/local-date \"2019-01-04\")]}"
  ([unit]
   (bucket (t/zoned-date-time) unit))
  ([t    :- TemporalInstance
    unit :- (into [:enum] cat [extract-units truncate-units])]
   (cond
     (= unit :default)     t
     (extract-units unit)  (extract t unit)
     (truncate-units unit) (truncate t unit)
     :else                 (throw (Exception. (tru "Invalid unit: {0}" unit))))))
(mu/defn range :- [:map
                   [:start TemporalInstance]
                   [:end   TemporalInstance]]
  "Get a start (by default, inclusive) and end (by default, exclusive) pair of instants for a `unit` span of time
  containing `t`. e.g.
    (range (t/zoned-date-time \"2019-11-01T15:29:00Z[UTC]\") :week)
    ->
    {:start (t/zoned-date-time \"2019-10-27T00:00Z[UTC]\")
     :end   (t/zoned-date-time \"2019-11-03T00:00Z[UTC]\")}"
  ([unit]
   (range (t/zoned-date-time) unit))
  ([t unit]
   (range t unit nil))
  ([t    :- TemporalInstance
    unit :- (into [:enum] add-units)
    {:keys [start end resolution]
     :or   {start      :inclusive
            end        :exclusive
            resolution :millisecond}}]
   (let [t (truncate t unit)]
     {:start (case start
               :inclusive t
               :exclusive (add t resolution -1))
      :end   (case end
               :inclusive (add (add t unit 1) resolution -1)
               :exclusive (add t unit 1))})))

Generate an range that of instants that when bucketed by unit would be =, <, <=, >, or >= to the value of an instant t bucketed by unit. (comparison-type is one of :=, :<, :<=, :>, or :>=.) By default, the start of the resulting range is inclusive, and the end exclusive; this can be tweaked by passing options.

;; Generate range off instants that have the same MONTH as Nov 18th (comparison-range (t/local-date "2019-11-18") :month := {:resolution :day}) ;; -> {:start (t/local-date "2019-11-01"), :end (t/local-date "2019-12-01")}

(defn comparison-range
  ([unit comparison-type]
   (comparison-range (t/zoned-date-time) unit comparison-type))
  ([t unit comparison-type]
   (comparison-range t unit comparison-type nil))
  ([t unit comparison-type {:keys [start end resolution]
                            :or   {start      :inclusive
                                   end        :exclusive
                                   resolution :millisecond}
                            :as   options}]
   (case comparison-type
     :<  {:end (case end
                 :inclusive (add (truncate t unit) resolution -1)
                 :exclusive (truncate t unit))}
     :<= {:end (let [t (add (truncate t unit) unit 1)]
                 (case end
                   :inclusive (add t resolution -1)
                   :exclusive t))}
     :>  {:start (let [t (add (truncate t unit) unit 1)]
                   (case start
                     :inclusive t
                     :exclusive (add t resolution -1)))}
     :>= {:start (let [t (truncate t unit)]
                   (case start
                     :inclusive t
                     :exclusive (add t resolution -1)))}
     :=  (range t unit options))))

Return the Duration between two temporal values x and y.

Moving the type hints to the arg lists makes clj-kondo happy, but breaks eastwood (and maybe causes reflection warnings) at the call sites.

#_{:clj-kondo/ignore [:non-arg-vec-return-type-hint]}
(defn ^PeriodDuration period-duration
  {:arglists '([s] [period] [duration] [period duration] [start end])}
  ([x]
   (when x
     (condp instance? x
       PeriodDuration x
       CharSequence   (PeriodDuration/parse x)
       Period         (PeriodDuration/of ^Period x)
       Duration       (PeriodDuration/of ^Duration x))))
  ([x y]
   (cond
     (and (instance? Period x) (instance? Duration y))
     (PeriodDuration/of x y)
     (instance? Instant x)
     (period-duration (t/offset-date-time x (t/zone-offset 0)) y)
     (instance? Instant y)
     (period-duration x (t/offset-date-time y (t/zone-offset 0)))
     :else
     (PeriodDuration/between x y))))

With two args: Compare two periods/durations. Returns a negative value if d1 is shorter than d2, zero if they are equal, or positive if d1 is longer than d2.

(u.date/compare-period-durations "P1Y" "P11M") ; -> 1 (i.e., 1 year is longer than 11 months)

You can combine this with period-duration to compare the duration between two temporal values against another duration:

(u.date/compare-period-durations (u.date/period-duration #t "2019-01-01" #t "2019-07-01") "P11M") ; -> -1

Note that this calculation is inexact, since it calclates relative to a fixed point in time, but should be sufficient for most if not all use cases.

(defn compare-period-durations
  [d1 d2]
  (when (and d1 d2)
    (let [t (t/offset-date-time "1970-01-01T00:00Z")]
      (compare (.addTo (period-duration d1) t)
               (.addTo (period-duration d2) t)))))

True if period/duration d1 is longer than period/duration d2.

(defn greater-than-period-duration?
  [d1 d2]
  (pos? (compare-period-durations d1 d2)))

Return a temporal value representing now of the same class as t, e.g. for comparison purposes.

(defn- now-of-same-class
  ^Temporal [t]
  (when t
    (condp instance? t
      Instant        (t/instant)
      LocalDate      (t/local-date)
      LocalTime      (t/local-time)
      LocalDateTime  (t/local-date-time)
      OffsetTime     (t/offset-time)
      OffsetDateTime (t/offset-date-time)
      ZonedDateTime  (t/zoned-date-time))))

True if temporal value t happened before some period/duration ago, compared to now. Prefer this over using t/before? to compare times to now because it is incredibly fussy about the classes of arguments it is passed.

;; did t happen more than 2 months ago? (older-than? t (t/months 2))

(defn older-than?
  [t duration]
  (greater-than-period-duration?
   (period-duration t (now-of-same-class t))
   duration))

Protocol for converting a temporal value to an equivalent one in a given timezone.

(p.types/defprotocol+ WithTimeZoneSameInstant
  (^{:style/indent 0} with-time-zone-same-instant [t ^java.time.ZoneId zone-id]
    "Convert a temporal value to an equivalent one in a given timezone. For local temporal values, this simply
    converts it to the corresponding offset/zoned type; for offset/zoned types, this applies an appropriate timezone
    shift."))
(extend-protocol WithTimeZoneSameInstant
  ;; convert to a OffsetTime with no offset (UTC); the OffsetTime method impl will apply the zone shift.
  LocalTime
  (with-time-zone-same-instant [t zone-id]
    (t/offset-time t (u.date.common/standard-offset zone-id)))

  OffsetTime
  (with-time-zone-same-instant [t ^java.time.ZoneId zone-id]
    (t/with-offset-same-instant t (u.date.common/standard-offset zone-id)))

  LocalDate
  (with-time-zone-same-instant [t zone-id]
    (t/offset-date-time t (t/local-time 0) zone-id))

  LocalDate
  (with-time-zone-same-instant [t zone-id]
    (t/offset-date-time t (t/local-time 0) zone-id))

  LocalDateTime
  (with-time-zone-same-instant [t zone-id]
    (t/offset-date-time t zone-id))

  ;; instants are always normalized to UTC, so don't make any changes here. If you want to format in a different zone,
  ;; convert to an OffsetDateTime or ZonedDateTime first.
  Instant
  (with-time-zone-same-instant [t _]
    t)

  OffsetDateTime
  (with-time-zone-same-instant [t ^java.time.ZoneId zone-id]
    ;; calculate the zone offset applicable for the date in question
    (if (or (= t OffsetDateTime/MAX)
            (= t OffsetDateTime/MIN))
      t
      (let [rules  (.getRules zone-id)
            offset (.getOffset rules (t/instant t))]
        (t/with-offset-same-instant t offset))))

  ZonedDateTime
  (with-time-zone-same-instant [t zone-id]
    (t/with-zone-same-instant t zone-id)))

+----------------------------------------------------------------------------------------------------------------+ | Etc | +----------------------------------------------------------------------------------------------------------------+

Mainly for REPL usage. Have various temporal types print as a java-time function call you can use

(doseq [[klass _f-symb] {Instant        't/instant
                         LocalDate      't/local-date
                         LocalDateTime  't/local-date-time
                         LocalTime      't/local-time
                         OffsetDateTime 't/offset-date-time
                         OffsetTime     't/offset-time
                         ZonedDateTime  't/zoned-date-time}]
  (defmethod print-method klass
    [t writer]
    ((get-method print-dup klass) t writer))

  (defmethod print-dup klass
    [t ^java.io.Writer writer]
    (.write writer (clojure.core/format "#t \"%s\"" (str t)))))
(defmethod print-method PeriodDuration
  [d writer]
  ((get-method print-dup PeriodDuration) d writer))
(defmethod print-dup PeriodDuration
  [d ^java.io.Writer writer]
  (.write writer (clojure.core/format "(metabase.util.date-2/period-duration %s)" (pr-str (str d)))))
(defmethod print-method Period
  [d writer]
  (print-method (list 't/period (str d)) writer))
(defmethod print-method Duration
  [d writer]
  (print-method (list 't/duration (str d)) writer))
 
(ns metabase.util.date-2.common
  (:require
   [clojure.string :as str]
   [java-time.api :as t]
   [metabase.util :as u])
  (:import
   (java.time ZoneId ZoneOffset)
   (java.time.temporal ChronoField IsoFields TemporalField WeekFields)))
(set! *warn-on-reflection* true)

TODO - not sure this belongs here, it seems to be a bit more general than just date-2.

Utility function to get the static members of a class. Returns map of lisp-case keyword names of members -> value.

(defn static-instances
  ([^Class klass]
   (static-instances klass klass))
  ([^Class klass ^Class target-class]
   (into {} (for [^java.lang.reflect.Field f (.getFields klass)
                  :when                      (.isAssignableFrom target-class (.getType f))]
              [(keyword (u/lower-case-en (str/replace (.getName f) #"_" "-")))
               (.get f nil)]))))

Map of lisp-style-name -> TemporalField for all the various TemporalFields we use in day-to-day parsing and other temporal operations.

(def ^TemporalField temporal-field
  (merge
   ;; honestly I have no idea why there's both IsoFields/WEEK_OF_WEEK_BASED_YEAR and (.weekOfWeekBasedYear
   ;; WeekFields/ISO)
   (into {} (for [[k v] (static-instances IsoFields TemporalField)]
              [(keyword "iso" (name k)) v]))
   (static-instances ChronoField)
   {:week-fields/iso-week-based-year         (.weekBasedYear WeekFields/ISO)
    :week-fields/iso-week-of-month           (.weekOfMonth WeekFields/ISO)
    :week-fields/iso-week-of-week-based-year (.weekOfWeekBasedYear WeekFields/ISO)
    :week-fields/iso-week-of-year            (.weekOfYear WeekFields/ISO)}
   {:week-fields/week-based-year         (.weekBasedYear WeekFields/SUNDAY_START)
    :week-fields/week-of-month           (.weekOfMonth WeekFields/SUNDAY_START)
    :week-fields/week-of-week-based-year (.weekOfWeekBasedYear WeekFields/SUNDAY_START)
    :week-fields/week-of-year            (.weekOfYear WeekFields/SUNDAY_START)}))

Standard (non-DST) offset for a time zone, for cases when we don't have date information. Gets the offset for the given zone-id at January 1 of the current year (since that is the best we can do in this situation).

We don't know what zone offset to shift this to, since the offset for a zone-id can vary depending on the date part of a temporal value (e.g. DST vs non-DST). So just adjust to the non-DST "standard" offset for the zone in question.

(defn standard-offset
  ^ZoneOffset [^ZoneId zone-id]
  (.. zone-id getRules (getStandardOffset (t/instant (t/offset-date-time (-> (t/zoned-date-time) t/year t/value) 1 1)))))
 
(ns metabase.util.date-2.parse
  (:require
   [clojure.string :as str]
   [java-time.api :as t]
   [metabase.util.date-2.common :as u.date.common]
   [metabase.util.date-2.parse.builder :as b]
   [metabase.util.i18n :refer [tru]]
   [schema.core :as s])
  (:import
   (java.time LocalDateTime OffsetDateTime OffsetTime ZonedDateTime ZoneOffset)
   (java.time.format DateTimeFormatter)
   (java.time.temporal Temporal TemporalAccessor TemporalField TemporalQueries)))
(set! *warn-on-reflection* true)
(def ^:private ^{:arglists '([temporal-accessor query])} query
  (let [queries {:local-date  (TemporalQueries/localDate)
                 :local-time  (TemporalQueries/localTime)
                 :zone-offset (TemporalQueries/offset)
                 :zone-id     (TemporalQueries/zoneId)}]
    (fn [^TemporalAccessor temporal-accessor query]
      (.query temporal-accessor (queries query)))))
(defn- normalize [s]
  (-> s
      ;; HACK - haven't figured out how to get the parser builder to allow HHmm offsets (i.e., no colons) yet, so add
      ;; one in there if needed. TODO - what about HH:mm:ss offsets? Will we ever see those?
      (str/replace #"([+-][0-2]\d)([0-5]\d)$" "$1:$2")
      (str/replace #"([0-2]\d:[0-5]\d(?::[0-5]\d(?:\.\d{1,9})?)?[+-][0-2]\d$)" "$1:00")))

Returns a map of supported temporal field lisp-style name -> value, e.g.

(parse-special-case (.parse (b/formatter (b/value :year 4) (b/value :iso/week-of-year 2)) "201901")) ;; -> {:year 2019, :iso-week-of-year 1}

(defn all-supported-fields
  [^TemporalAccessor temporal-accessor]
  (into {} (for [[k ^TemporalField field] u.date.common/temporal-field
                 :when                    (.isSupported temporal-accessor field)]
             [k (.getLong temporal-accessor field)])))
(s/defn parse-with-formatter :- (s/maybe Temporal)
  "Parse a String with a DateTimeFormatter, returning an appropriate instance of an `java.time` temporal class."
  [formattr s :- (s/maybe s/Str)]
  {:pre [((some-fn string? nil?) s)]}
  (when-not (str/blank? s)
    (let [formattr          (t/formatter formattr)
          s                 (normalize s)
          temporal-accessor (.parse formattr s)
          local-date        (query temporal-accessor :local-date)
          local-time        (query temporal-accessor :local-time)
          zone-offset       (query temporal-accessor :zone-offset)
          zone-id           (or (query temporal-accessor :zone-id)
                                (when (= zone-offset ZoneOffset/UTC)
                                  (t/zone-id "UTC")))
          literal-type      [(cond
                               zone-id     :zone
                               zone-offset :offset
                               :else       :local)
                             (cond
                               (and local-date local-time) :datetime
                               local-date                  :date
                               local-time                  :time)]]
      (case literal-type
        [:zone   :datetime] (ZonedDateTime/of  local-date local-time zone-id)
        [:offset :datetime] (OffsetDateTime/of local-date local-time zone-offset)
        [:local  :datetime] (LocalDateTime/of  local-date local-time)
        [:zone   :date]     (ZonedDateTime/of  local-date (t/local-time 0) zone-id)
        [:offset :date]     (OffsetDateTime/of local-date (t/local-time 0) zone-offset)
        [:local  :date]     local-date
        [:zone   :time]     (OffsetTime/of local-time (or zone-offset (u.date.common/standard-offset zone-id)))
        [:offset :time]     (OffsetTime/of local-time zone-offset)
        [:local  :time]     local-time
        (throw (ex-info (tru "Don''t know how to parse {0} using format {1}" (pr-str s) (pr-str formattr))
                 {:s                s
                  :formatter        formattr
                  :supported-fields (all-supported-fields temporal-accessor)}))))))
(def ^:private ^DateTimeFormatter date-formatter*
  (b/formatter
   (b/value :year 4 10 :exceeds-pad)
   (b/optional
    "-"
    (b/value :month-of-year 2)
    (b/optional
     "-"
     (b/value :day-of-month 2)))
   (b/default-value :month-of-year 1)
   (b/default-value :day-of-month 1)))
(def ^:private ^DateTimeFormatter time-formatter*
  (b/formatter
   (b/value :hour-of-day 2)
   (b/optional
    ":"
    (b/value :minute-of-hour 2)
    (b/optional
     ":"
     (b/value :second-of-minute 2)
     (b/optional
      (b/fraction :nano-of-second 0 9, :decimal-point? true))))
   (b/default-value :minute-of-hour 0)
   (b/default-value :second-of-minute 0)
   (b/default-value :nano-of-second 0)))
(def ^:private ^DateTimeFormatter offset-formatter*
  (b/formatter
   (b/optional " ")
   (b/optional
    (b/zone-offset))
   (b/optional
    (b/zone-id))))
(def ^:private ^DateTimeFormatter formatter
  (b/formatter
   (b/case-insensitive
    (b/optional
     date-formatter*)
    (b/optional "T")
    (b/optional " ")
    (b/optional
     time-formatter*)
    (b/optional
     offset-formatter*))))

Parse a string into a java.time object.

(defn parse
  [^String s]
  (parse-with-formatter formatter s))
 

Utility functions for programatically building a DateTimeFormatter. Easier to understand than chaining a hundred Java calls and trying to keep the structure straight.

The basic idea here is you pass a number of sections to formatter to build a DateTimeFormatter — see metabase.util.date-2.parse for examples. Most of these sections are simple wrappers around corresponding DateTimeFormatterBuilder -- see https://docs.oracle.com/javase/8/docs/api/java/time/format/DateTimeFormatterBuilder.html for documenation.

TODO - this is a prime library candidate.

(ns metabase.util.date-2.parse.builder
  (:require
   [metabase.util.date-2.common :as u.date.common])
  (:import
   (java.time.format DateTimeFormatter DateTimeFormatterBuilder SignStyle)
   (java.time.temporal TemporalField)))
(set! *warn-on-reflection* true)
(defprotocol ^:private Section
  (^:private apply-section [this builder]))
(extend-protocol Section
  String
  (apply-section [s builder]
    (.appendLiteral ^DateTimeFormatterBuilder builder s))

  clojure.lang.Fn
  (apply-section [f builder]
    (f builder))

  clojure.lang.Sequential
  (apply-section [sections builder]
    (doseq [section sections]
      (apply-section section builder)))

  DateTimeFormatter
  (apply-section [formatter builder]
    (.append ^DateTimeFormatterBuilder builder formatter)))

Make wrapped sections optional.

(defn optional
  [& sections]
  (reify Section
    (apply-section [_ builder]
      (.optionalStart ^DateTimeFormatterBuilder builder)
      (apply-section sections builder)
      (.optionalEnd ^DateTimeFormatterBuilder builder))))
(defn- set-option [^DateTimeFormatterBuilder builder option]
  (case option
    :strict           (.parseStrict builder)
    :lenient          (.parseLenient builder)
    :case-sensitive   (.parseCaseSensitive builder)
    :case-insensitive (.parseCaseInsensitive builder)))
(def ^:private ^:dynamic *options*
  {:strictness       :strict
   :case-sensitivity :case-sensitive})
(defn- do-with-option [builder k new-value thunk]
  (let [old-value (get *options* k)]
    (if (= old-value new-value)
      (thunk)
      (binding [*options* (assoc *options* k new-value)]
        (set-option builder new-value)
        (thunk)
        (set-option builder old-value)))))
(defn- with-option-section [k v sections]
  (reify Section
    (apply-section [_ builder]
      (do-with-option builder k v (fn [] (apply-section sections builder))))))

Use strict parsing for wrapped sections.

(defn strict
  [& sections]
  (with-option-section :strictness :strict sections))

Use lenient parsing for wrapped sections.

(defn lenient
  [& sections]
  (with-option-section :strictness :lenient sections))

Make wrapped sections case-sensitive.

(defn case-sensitive
  [& sections]
  (with-option-section :case-sensitivity :case-sensitive sections))

Make wrapped sections case-insensitive.

(defn case-insensitive
  [& sections]
  (with-option-section :case-sensitivity :case-insensitive sections))
(def ^:private ^SignStyle sign-style
  (u.date.common/static-instances SignStyle))
(defn- temporal-field ^TemporalField [x]
  (let [field (if (keyword? x)
                (u.date.common/temporal-field x)
                x)]
    (assert (instance? TemporalField field)
      (format "Invalid TemporalField: %s" (pr-str field)))
    field))

Define a section for a specific field such as :hour-of-day or :minute-of-hour. Refer to metabase.util.date-2.common/temporal-field for all possible temporal fields names.

(defn value
  ([temporal-field-name]
   (fn [^DateTimeFormatterBuilder builder]
     (.appendValue builder (temporal-field temporal-field-name))))
  ([temporal-field-name width]
   (fn [^DateTimeFormatterBuilder builder]
     (.appendValue builder (temporal-field temporal-field-name) width)))
  ([temporal-field-name min-val max-val sign-style-name]
   (fn [^DateTimeFormatterBuilder builder]
     (.appendValue builder (temporal-field temporal-field-name) min-val max-val (sign-style sign-style-name)))))

Define a section that sets a default value for a field like :minute-of-hour.

(defn default-value
  [temporal-field-name default-value]
  (fn [^DateTimeFormatterBuilder builder]
    (.parseDefaulting builder (temporal-field temporal-field-name) default-value)))

Define a section for a fractional value, e.g. milliseconds or nanoseconds.

(defn fraction
  [temporal-field-name _min-val-width _max-val-width & {:keys [decimal-point?]}]
  (fn [^DateTimeFormatterBuilder builder]
    (.appendFraction builder (temporal-field temporal-field-name) 0 9 (boolean decimal-point?))))

Define a section for a timezone offset. e.g. -08:00.

(defn zone-offset
  []
  (lenient
   (fn [^DateTimeFormatterBuilder builder]
     (.appendOffsetId builder))))

An a section for a timezone ID wrapped in square brackets, e.g. [America/Los_Angeles].

(defn zone-id
  []
  (strict
   (case-sensitive
    (optional "[")
    (fn [^DateTimeFormatterBuilder builder]
      (.appendZoneRegionId builder))
    (optional "]"))))

Return a new DateTimeFormatter from sections. See examples in metabase.util.date-2.parse for more details.

(formatter (case-insensitive (value :hour-of-day 2) (optional ":" (value :minute-of-hour 2) (optional ":" (value :second-of-minute)))))

->

#object[java.time.format.DateTimeFormatter "ParseCaseSensitive(false)Value(HourOfDay,2)[':'Value(MinuteOfHour,2)[':'Value(SecondOfMinute)]]"]

(defn formatter
  ^DateTimeFormatter [& sections]
  (let [builder (DateTimeFormatterBuilder.)]
    (apply-section sections builder)
    (.toFormatter builder)))
 

Utility functions for public links and embedding.

(ns metabase.util.embed
  (:require
   [buddy.core.codecs :as codecs]
   [buddy.sign.jwt :as jwt]
   [cheshire.core :as json]
   [clojure.string :as str]
   [hiccup.core :refer [html]]
   [metabase.models.setting :as setting]
   [metabase.public-settings :as public-settings]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru trs tru]]
   [ring.util.codec :as codec]))
(set! *warn-on-reflection* true)

--------------------------------------------- PUBLIC LINKS UTIL FNS ----------------------------------------------

Return an oEmbed URL for the relative-path.

(oembed-url "/x") -> "http://localhost:3000/api/public/oembed?url=x&format=json"

(defn- oembed-url
  ^String [^String relative-url]
  (str (public-settings/site-url)
       "/api/public/oembed"
       ;; NOTE: some oEmbed consumers require `url` be the first param???
       "?url=" (codec/url-encode (str (public-settings/site-url) relative-url))
       "&format=json"))

Returns a <link> tag for oEmbed support.

(defn- oembed-link
  ^String [^String url]
  (html [:link {:rel   "alternate"
                :type  "application/json+oembed"
                :href  (oembed-url url)
                :title "Metabase"}]))

A <meta> tag for Embed.ly support.

(def ^:private ^:const ^String embedly-meta
  (html [:meta {:name "generator", :content "Metabase"}]))

Returns the <meta>/<link> tags for an embeddable public page.

(defn head
  ^String [^String url]
  (str embedly-meta (oembed-link url)))

Return an <iframe> HTML fragment to embed a public page.

(defn iframe
  ^String [^String url, width height]
  (html [:iframe {:src         url
                  :width       width
                  :height      height
                  :frameborder 0}]))

----------------------------------------------- EMBEDDING UTIL FNS -----------------------------------------------

(setting/defsetting embedding-secret-key
  (deferred-tru "Secret key used to sign JSON Web Tokens for requests to `/api/embed` endpoints.")
  :visibility :admin
  :audit :no-value
  :setter (fn [new-value]
            (when (seq new-value)
              (assert (u/hexadecimal-string? new-value)
                (tru "Invalid embedding-secret-key! Secret key must be a hexadecimal-encoded 256-bit key (i.e., a 64-character string).")))
            (setting/set-value-of-type! :string :embedding-secret-key new-value)))

Parse a JWT message and return the header portion.

(defn- jwt-header
  [^String message]
  (let [[header] (str/split message #"\.")]
    (json/parse-string (codecs/bytes->str (codec/base64-decode header)) keyword)))

Check that the JWT alg isn't none. none is valid per the standard, but for obvious reasons we want to make sure our keys are signed. Unfortunately, I don't think there's an easy way to do this with the JWT library we use, so manually parse the token and check the alg.

(defn- check-valid-alg
  [^String message]
  (let [{:keys [alg]} (jwt-header message)]
    (when-not alg
      (throw (Exception. (trs "JWT is missing `alg`."))))
    (when (= alg "none")
      (throw (Exception. (trs "JWT `alg` cannot be `none`."))))))

Parse a "signed" (base-64 encoded) JWT and return a Clojure representation. Check that the signature is valid (i.e., check that it was signed with embedding-secret-key) and it's otherwise a valid JWT (e.g., not expired), or throw an Exception.

(defn unsign
  [^String message]
  (when (seq message)
    (try
      (check-valid-alg message)
      (jwt/unsign message
                  (or (embedding-secret-key)
                      (throw (ex-info (tru "The embedding secret key has not been set.") {:status-code 400})))
                  ;; The library will reject tokens with a created at timestamp in the future, so to account for clock
                  ;; skew tell the library to allow for 60 seconds of leeway
                  {:leeway 60})
      ;; if `jwt/unsign` throws an Exception rethrow it in a format that's friendlier to our API
      (catch Throwable e
        (throw (ex-info (.getMessage e) {:status-code 400}))))))

Find keyseq in the unsigned-token (a JWT token decoded by unsign) or throw a 400.

(defn get-in-unsigned-token-or-throw
  [unsigned-token keyseq]
  (or (get-in unsigned-token keyseq)
      (throw (ex-info (tru "Token is missing value for keypath {0}" keyseq) {:status-code 400}))))
 

Utility functions for encrypting and decrypting strings using AES256 CBC + HMAC SHA512 and the MB_ENCRYPTION_SECRET_KEY env var.

(ns metabase.util.encryption
  (:require
   [buddy.core.codecs :as codecs]
   [buddy.core.crypto :as crypto]
   [buddy.core.kdf :as kdf]
   [buddy.core.nonce :as nonce]
   [clojure.string :as str]
   [environ.core :as env]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [ring.util.codec :as codec]))
(set! *warn-on-reflection* true)

Generate a 64-byte byte array hash of secret-key using 100,000 iterations of PBKDF2+SHA512.

(defn secret-key->hash
  ^bytes [^String secret-key]
  (kdf/get-bytes (kdf/engine {:alg        :pbkdf2+sha512
                              :key        secret-key
                              :iterations 100000}) ; 100,000 iterations takes about ~160ms on my laptop
                 64))

Check the minimum length of the key and hash it for internal usage.

(defn validate-and-hash-secret-key
  [^String secret-key]
  (when-let [secret-key secret-key]
    (when (seq secret-key)
      (assert (>= (count secret-key) 16)
              (str (trs "MB_ENCRYPTION_SECRET_KEY must be at least 16 characters.")))
      (secret-key->hash secret-key))))

apperently if you're not tagging in an arglist, ^bytes will set the :tag metadata to clojure.core/bytes (ick) so you have to do ^{:tag 'bytes} instead

(defonce ^:private ^{:tag 'bytes} default-secret-key
  (validate-and-hash-secret-key (env/env :mb-encryption-secret-key)))

log a nice message letting people know whether DB details encryption is enabled

(when-not *compile-files*
  (log/info
   (if default-secret-key
     (trs "Saved credentials encryption is ENABLED for this Metabase instance.")
     (trs "Saved credentials encryption is DISABLED for this Metabase instance."))
   (u/emoji (if default-secret-key "🔐" "🔓"))
   "\n"
   (trs "For more information, see")
   "https://metabase.com/docs/latest/operations-guide/encrypting-database-details-at-rest.html"))

Encrypt bytes b using a secret-key (a 64-byte byte array), by default is the hashed value of MB_ENCRYPTION_SECRET_KEY.

(defn encrypt-bytes
  {:added "0.41.0"}
  (^String [^bytes b]
   (encrypt-bytes default-secret-key b))
  (^String [^String secret-key, ^bytes b]
   (let [initialization-vector (nonce/random-bytes 16)]
     (->> (crypto/encrypt b
            secret-key
            initialization-vector
            {:algorithm :aes256-cbc-hmac-sha512})
       (concat initialization-vector)
       byte-array))))

Encrypt string s as hex bytes using a secret-key (a 64-byte byte array), which by default is the hashed value of MB_ENCRYPTION_SECRET_KEY.

(defn encrypt
  (^String [^String s]
   (encrypt default-secret-key s))
  (^String [^String secret-key, ^String s]
   (->> (codecs/to-bytes s)
        (encrypt-bytes secret-key)
        codec/base64-encode)))

Decrypt bytes b using a secret-key (a 64-byte byte array), which by default is the hashed value of MB_ENCRYPTION_SECRET_KEY.

(defn decrypt-bytes
  {:added "0.41.0"}
  (^String [^bytes b]
   (decrypt-bytes default-secret-key b))
  (^String [secret-key, ^bytes b]
   (let [[initialization-vector message] (split-at 16 b)]
     (crypto/decrypt (byte-array message)
                     secret-key
                     (byte-array initialization-vector)
                     {:algorithm :aes256-cbc-hmac-sha512}))))

Decrypt string s using a secret-key (a 64-byte byte array), by default the hashed value of MB_ENCRYPTION_SECRET_KEY.

(defn decrypt
  (^String [^String s]
   (decrypt default-secret-key s))
  (^String [secret-key, ^String s]
   (codecs/bytes->str (decrypt-bytes secret-key (codec/base64-decode s)))))

If MB_ENCRYPTION_SECRET_KEY is set, return an encrypted version of s; otherwise return s as-is.

(defn maybe-encrypt
  (^String [^String s]
   (maybe-encrypt default-secret-key s))
  (^String [secret-key, ^String s]
   (if secret-key
     (when (seq s)
       (encrypt secret-key s))
     s)))

If MB_ENCRYPTION_SECRET_KEY is set, return an encrypted version of the given bytes b; otherwise return b as-is.

(defn maybe-encrypt-bytes
  {:added "0.41.0"}
  (^bytes [^bytes b]
   (maybe-encrypt-bytes default-secret-key b))
  (^bytes [secret-key, ^bytes b]
   (if secret-key
     (when (seq b)
       (encrypt-bytes secret-key b))
     b)))
(def ^:private ^:const aes256-tag-length 32)
(def ^:private ^:const aes256-block-size 16)

Returns true if it's likely that b is an encrypted byte array. To compute this, we need the number of bytes in the input, subtract the bytes used by the cipher type tag (aes256-tag-length) and what is left should be divisible by the cipher's block size (aes256-block-size). If it's not divisible by that number it is either not encrypted or it has been corrupted as it must always have a multiple of the block size or it won't decrypt.

(defn possibly-encrypted-bytes?
  [^bytes b]
  (if (nil? b)
    false
    (u/ignore-exceptions
      (when-let [byte-length (alength b)]
        (zero? (mod (- byte-length aes256-tag-length)
                 aes256-block-size))))))

Returns true if it's likely that s is an encrypted string. Specifically we need s to be a non-blank, base64 encoded string of the correct length. See docstring for possibly-encrypted-bytes? for an explanation of correct length.

(defn possibly-encrypted-string?
  [^String s]
  (u/ignore-exceptions
    (when-let [b (and (not (str/blank? s))
                      (u/base64-string? s)
                      (codec/base64-decode s))]
      (possibly-encrypted-bytes? b))))

If MB_ENCRYPTION_SECRET_KEY is set and v is encrypted, decrypt v; otherwise return s as-is. Attempts to check whether v is an encrypted String, in which case the decrypted String is returned, or whether v is encrypted bytes, in which case the decrypted bytes are returned.

(defn maybe-decrypt
  {:arglists '([secret-key? s])}
  [& args]
  ;; secret-key as an argument so that tests can pass it directly without using `with-redefs` to run in parallel
  (let [[secret-key v]     (if (and (bytes? (first args)) (string? (second args)))
                             args
                             (cons default-secret-key args))
        log-error-fn (fn [kind ^Throwable e]
                       (log/warnf e
                                  "Cannot decrypt encrypted %s. Have you changed or forgot to set MB_ENCRYPTION_SECRET_KEY?"
                                  kind))]
    (cond (nil? secret-key)
          v
          (possibly-encrypted-string? v)
          (try
            (decrypt secret-key v)
            (catch Throwable e
              ;; if we can't decrypt `v`, but it *is* probably encrypted, log a warning
              (log-error-fn "String" e)
              v))
          (possibly-encrypted-bytes? v)
          (try
            (decrypt-bytes secret-key v)
            (catch Throwable e
              ;; if we can't decrypt `v`, but it *is* probably encrypted, log a warning
              (log-error-fn "bytes" e)
              v))
          :else
          v)))
 

Low-level file-related functions for implementing Metabase plugin functionality. These use the java.nio.file library rather than the usual java.io stuff because it abstracts better across different filesystems (such as files in a normal directory vs files inside a JAR.)

As much as possible, this namespace aims to abstract away the nio.file library and expose a set of high-level file-manipulation functions for the sorts of operations the plugin system needs to perform.

(ns metabase.util.files
  (:require
   [babashka.fs :as fs]
   [clojure.java.io :as io]
   [clojure.string :as str]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log])
  (:import
   (java.io FileNotFoundException)
   (java.net URL)
   (java.nio.file CopyOption Files FileSystem FileSystemAlreadyExistsException FileSystems
                  LinkOption OpenOption Path Paths StandardCopyOption)
   (java.nio.file.attribute FileAttribute)
   (java.util Collections)
   (java.util.zip ZipInputStream)))
(set! *warn-on-reflection* true)

--------------------------------------------------- Path Utils ---------------------------------------------------

(defn- get-path-in-filesystem ^Path [^FileSystem filesystem ^String path-component & more-components]
  (.getPath filesystem path-component (u/varargs String more-components)))

Get a Path for a file or directory in the default (i.e., system) filesystem named by string path component(s).

(get-path "/Users/cam/metabase/metabase/plugins") ;; -> #object[sun.nio.fs.UnixPath 0x4d378139 "/Users/cam/metabase/metabase/plugins"]

(defn get-path
  ^Path [& path-components]
  (apply get-path-in-filesystem (FileSystems/getDefault) path-components))

Appends string components to the end of a Path, returning a new Path.

(defn append-to-path
  ^Path [^Path path & components]
  (loop [^Path path path, [^String component & more] components]
    (let [path (.resolve path component)]
      (if-not (seq more)
        path
        (recur path more)))))

----------------------------------------------- Other Basic Utils ------------------------------------------------

Does file at path actually exist?

(defn exists?
  [^Path path]
  (Files/exists path (u/varargs LinkOption)))

True if path refers to a regular file (as opposed to something like directory).

(defn regular-file?
  [^Path path]
  (Files/isRegularFile path (u/varargs LinkOption)))

True if we can read the file at path.

(defn readable?
  [^Path path]
  (Files/isReadable path))

----------------------------------------------- Working with Dirs ------------------------------------------------

Self-explanatory. Create a directory with path if it does not already exist.

(defn create-dir-if-not-exists!
  [^Path path]
  (when-let [parent (fs/parent path)]
    (create-dir-if-not-exists! parent))
  (when-not (exists? path)
    (Files/createDirectory path (u/varargs FileAttribute))))

Get a sequence of all files in path, presumably a directory or an archive of some sort (like a JAR).

(defn files-seq
  [^Path path]
  (iterator-seq (.iterator (Files/list path))))

------------------------------------------------- Copying Stuff --------------------------------------------------

(defn- last-modified-timestamp ^java.time.Instant [^Path path]
  (when (exists? path)
    (.toInstant (Files/getLastModifiedTime path (u/varargs LinkOption)))))

Copy a file from source -> dest.

(defn copy-file!
  [^Path source ^Path dest]
  (when (or (not (exists? dest))
            (not= (last-modified-timestamp source) (last-modified-timestamp dest)))
    (log/info (trs "Extract file {0} -> {1}" source dest))
    (Files/copy source dest (u/varargs CopyOption [StandardCopyOption/REPLACE_EXISTING
                                                   StandardCopyOption/COPY_ATTRIBUTES]))))

Copy all files in source-dir to dest-dir. Overwrites existing files if last modified timestamp is not the same as that of the source file — see #11699 for more context.

(defn copy-files!
  [^Path source-dir, ^Path dest-dir]
  (doseq [^Path source (files-seq source-dir)
          :let         [target (append-to-path dest-dir (str (.getFileName source)))]]
    (try
      (copy-file! source target)
      (catch Throwable e
        (log/error e (trs "Failed to copy file"))))))

------------------------------------------ Opening filesystems for URLs ------------------------------------------

(defn- url-inside-jar? [^URL url]
  (when url
    (str/includes? (.getFile url) ".jar!/")))
(defn- jar-file-system-from-url ^FileSystem [^URL url]
  (let [uri (.toURI url)]
    (try
      (FileSystems/newFileSystem uri Collections/EMPTY_MAP)
      (catch FileSystemAlreadyExistsException _
        (log/info "File system at" uri "already exists")
        (FileSystems/getFileSystem uri)))))

Impl for with-open-path-to-resource.

(defn do-with-open-path-to-resource
  [^String resource f]
  (let [url (io/resource resource)]
    (when-not url
      (throw (FileNotFoundException. (trs "Resource does not exist."))))
    (if (url-inside-jar? url)
      (with-open [fs (jar-file-system-from-url url)]
        (f (get-path-in-filesystem fs "/" resource)))
      (f (get-path (.toString (Paths/get (.toURI url))))))))

Execute body with a Path to a resource file or directory (i.e. a file in the project resources/ directory, or inside the uberjar), cleaning up when finished.

Throws a FileNotFoundException if the resource does not exist; be sure to check with io/resource or similar before calling this.

(with-open-path-to-resouce [path "modules"] ...)

(defmacro with-open-path-to-resource
  [[path-binding resource-filename-str] & body]
  `(do-with-open-path-to-resource
    ~resource-filename-str
    (fn [~(vary-meta path-binding assoc :tag java.nio.file.Path)]
      ~@body)))

+----------------------------------------------------------------------------------------------------------------+ | JAR FILE CONTENTS | +----------------------------------------------------------------------------------------------------------------+

True is a file exists in an archive.

(defn file-exists-in-archive?
  [^Path archive-path & path-components]
  (with-open [fs (FileSystems/newFileSystem archive-path (ClassLoader/getSystemClassLoader))]
    (let [file-path (apply get-path-in-filesystem fs path-components)]
      (exists? file-path))))

Read the entire contents of a file from a archive (such as a JAR).

(defn slurp-file-from-archive
  [^Path archive-path & path-components]
  (with-open [fs (FileSystems/newFileSystem archive-path (ClassLoader/getSystemClassLoader))]
    (let [file-path (apply get-path-in-filesystem fs path-components)]
      (when (exists? file-path)
        (with-open [is (Files/newInputStream file-path (u/varargs OpenOption))]
          (slurp is))))))

Decompress a zip archive from input to output.

(defn unzip-file
  [zip-file mod-fn]
  (with-open [stream (-> zip-file io/input-stream ZipInputStream.)]
    (loop [entry (.getNextEntry stream)]
      (when entry
        (let [out-path (mod-fn (.getName entry))
              out-file (io/file out-path)]
          (if (.isDirectory entry)
            (when-not (.exists out-file) (.mkdirs out-file))
            (let [parent-dir (fs/parent out-path)]
              (when-not (fs/exists? (str parent-dir)) (fs/create-dirs parent-dir))
              (io/copy stream out-file)))
          (recur (.getNextEntry stream)))))))

Returns a java.nio.file.Path

(defn relative-path
  [path]
  (fs/relativize (fs/absolutize ".") path))
 

font loading functionality.

(ns metabase.util.fonts
  (:require
   [clojure.string :as str]
   [metabase.util :as u]
   [metabase.util.files :as u.files]
   [metabase.util.log :as log]))

Use a font's directory to derive a Display Name by changing underscores to spaces.

(defn- normalize-font-dirname
  [dirname]
  (str/replace dirname #"_" " "))
(defn- contains-font-file?
  [path]
  ;; todo: expand this to allow other font formats?
  (boolean (some #(str/includes? % ".woff") (u.files/files-seq path))))
(defn- available-fonts*
  []
  (u.files/with-open-path-to-resource [font-path "frontend_client/app/fonts"]
    (let [font-path-str (str font-path "/")]
      (log/info (str "Reading available fonts from " font-path))
      (->> font-path
           u.files/files-seq
           (filter contains-font-file?)
           (map #(str/replace (str %) font-path-str ))
           (map normalize-font-dirname)
           (sort-by u/lower-case-en)))))

Return an alphabetically sorted list of available fonts, as Strings.

(def ^{:arglists '([])} available-fonts
  (let [fonts (delay (available-fonts*))]
    (fn [] @fonts)))

True if a font's 'Display String', font, is a valid font available on this system.

(defn available-font?
  [font]
  (boolean
   ((set (available-fonts)) font)))
 

Honey SQL 2 utilities and extra registered functions/operators.

(ns ^{:added  "0.46.0"} metabase.util.honey-sql-2
  (:refer-clojure
   :exclude
   [+ - / * abs mod inc dec cast concat format second])
  (:require
   [clojure.string :as str]
   [honey.sql :as sql]
   [honey.sql.protocols :as sql.protocols]
   [metabase.util :as u]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [potemkin.types :as p.types])
  (:import
   (java.util Locale)))
(set! *warn-on-reflection* true)

`[:inline ] should emit something wrapped in parens. Because otherwise the result could be something unintended. e.g.

[:/ 4 (/ 1 3)] => 4 / 1 / 3

is a different result than

[:/ 4 (/ 1 3)] => 4 / (1 / 3)

See #28354

(extend-protocol sql.protocols/InlineValue
  clojure.lang.Ratio
  (sqlize [this]
    (let [numerator   (.numerator ^clojure.lang.Ratio this)
          denominator (.denominator ^clojure.lang.Ratio this)]
      (clojure.core/format "(%d.0 / %d.0)" numerator denominator))))

Use this function when you need to upper-case an identifier or table name. Similar to clojure.string/upper-case but always converts the string to upper-case characters in the English locale. Using clojure.string/upper-case for table names, like we are using below in the :h2 honeysql.format function can cause issues when the user has changed the locale to a language that has different upper-case characters. Turkish is one example, where i gets converted to İ. This causes the SETTING table to become the SETTİNG table, which doesn't exist.

(defn- english-upper-case
  [^CharSequence s]
  (-> s str (.toUpperCase Locale/ENGLISH)))
(sql/register-dialect!
 :h2
 (update (sql/get-dialect :ansi) :quote (fn [quote]
                                          (comp english-upper-case quote))))

this is mostly a convenience for tests, disables quoting completely.

(sql/register-dialect!
 ::unquoted-dialect
 (assoc (sql/get-dialect :ansi) :quote identity))

(sql/format-expr [::extract :a :b]) => "extract(a from b)"

register the ::extract function with HoneySQL

(defn- format-extract
  [_tag [unit expr]]
  (let [[sql & args] (sql/format-expr expr {:nested true})]
    (into [(clojure.core/format "extract(%s from %s)" (name unit) sql)]
          args)))
(sql/register-fn! ::extract #'format-extract)

Create a Honey SQL form that will compile to SQL like

extract(unit FROM expr)

(defn extract
  [unit expr]
  ;; make sure no one tries to be sneaky and pass some sort of malicious unit in.
  {:pre [(some-fn keyword? string?) (re-matches #"^[a-zA-Z0-9]+$" (name unit))]}
  [::extract unit expr])

(sql/format-expr [::h2x/distinct-count :x]) => count(distinct x)

register the function ::distinct-count with HoneySQL

(defn- format-distinct-count
  [_tag [expr]]
  (let [[sql & args] (sql/format-expr expr)]
    (into [(str "count(distinct " sql ")")]
          args)))
(sql/register-fn! ::distinct-count #'format-distinct-count)

(hsql/format (sql/call :percentile-cont :a 0.9)) => "percentile_cont(0.9) within group (order by a)"

register the function percentile with HoneySQL

(defn- format-percentile-cont
  [_tag [expr p]]
  (let [p                      (if (number? p)
                                 [:inline p]
                                 p)
        [expr-sql & expr-args] (sql/format-expr expr)
        [p-sql & p-args]       (sql/format-expr p)]
    (into [(clojure.core/format "PERCENTILE_CONT(%s) within group (order by %s)" p-sql expr-sql)]
          cat
          [expr-args
           p-args])))
(sql/register-fn! ::percentile-cont #'format-percentile-cont)

Malli schema for valid [[identifier]] types.

(def IdentifierType
  [:enum
   :database
   :schema
   :constraint
   :index
   ;; Suppose we have a query like:
   ;; SELECT my_field f FROM my_table t
   ;; then:
   :table       ; is `my_table`
   :table-alias ; is `t`
   :field       ; is `my_field`
   :field-alias ; is `f`
   ;; for [[quoted-cast]]
   :type-name])

Whether x is a valid ::identifier.

(defn identifier?
  [x]
  (and (vector? x)
       (= (first x) ::identifier)))

Malli schema for an [[identifier]].

(def Identifier
  [:tuple
   [:= ::identifier]
   IdentifierType
   [:sequential {:min 1} :string]])
(defn- format-identifier [_tag [_identifier-type components :as _args]]
  ;; don't error if the identifier has something 'suspicious' like a semicolon in it -- it's ok because we're quoting
  ;; everything
  (binding [sql/*allow-suspicious-entities* true]
    [(str/join \. (map (fn [component]
                         ;; `:aliased` `true` => don't split dots in the middle of components
                         (sql/format-entity component {:aliased true}))
                       components))]))
(sql/register-fn! ::identifier #'format-identifier)

Define an identifier of type with components. Prefer this to using keywords for identifiers, as those do not properly handle identifiers with slashes in them.

identifier-type represents the type of identifier in question, which is important context for some drivers, such as BigQuery (which needs to qualify Tables identifiers with their dataset name.)

This function automatically unnests any Identifiers passed as arguments, removes nils, and converts all args to strings.

(mu/defn identifier
  [identifier-type :- IdentifierType
   & components    :- [:* {:min 1} [:maybe [:or :keyword ms/NonBlankString [:fn identifier?]]]]]
  [::identifier
   identifier-type
   (vec (for [component components
              component (if (identifier? component)
                          (last component)
                          [component])
              :when     (some? component)]
          (u/qualified-name component)))])
(mu/defn identifier->components :- [:sequential string?]
  "Given an identifer return its components
  (identifier->components (identifier :field :metabase :user :email))
  => (\"metabase\" \"user\" \"email\"))
  "
  [identifier :- [:fn identifier?]]
  (last identifier))

Single-quoted string literal

(defn- escape-and-quote-literal [s]
  (as-> s s
    (str/replace s #"(?<![\\'])'(?![\\'])"  "''")
    (str \' s \')))
(defn- format-literal [_tag [s]]
  [(escape-and-quote-literal s)])
(sql/register-fn! ::literal #'format-literal)

Wrap keyword or string s in single quotes and a HoneySQL raw form.

We'll try to escape single quotes in the literal, unless they're already escaped (either as '' or as \, but this won't handle wacky cases like three single quotes in a row.

DON'T USE LITERAL FOR THINGS THAT MIGHT BE WACKY (USER INPUT). Only use it for things that are hardcoded.

(defn literal
  "Wrap keyword or string `s` in single quotes and a HoneySQL `raw` form.
  We'll try to escape single quotes in the literal, unless they're already escaped (either as `''` or as `\\`, but
  this won't handle wacky cases like three single quotes in a row.
  DON'T USE `LITERAL` FOR THINGS THAT MIGHT BE WACKY (USER INPUT). Only use it for things that are hardcoded."
  [s]
  [::literal (u/qualified-name s)])
(defn- format-at-time-zone [_tag [expr zone]]
  (let [[expr-sql & expr-args] (sql/format-expr expr {:nested true})
        [zone-sql & zone-args] (sql/format-expr (literal zone))]
    (into [(clojure.core/format "(%s AT TIME ZONE %s)"
                                expr-sql
                                zone-sql)]
          cat
          [expr-args zone-args])))
(sql/register-fn! ::at-time-zone #'format-at-time-zone)

Create a Honey SQL form that returns expr at time zone. Does not add type info! Add appropriate DB type info yourself to the result.

(defn at-time-zone
  [expr zone]
  [::at-time-zone expr zone])

Protocol for a HoneySQL form that has type information such as :database-type. See #15115 for background.

(p.types/defprotocol+ TypedHoneySQL
  (type-info [honeysql-form]
    "Return type information associated with `honeysql-form`, if any (i.e., if it is a `TypedHoneySQLForm`); otherwise
    returns `nil`.")
  (with-type-info [honeysql-form new-type-info]
    "Add type information to a `honeysql-form`. Wraps `honeysql-form` and returns a `TypedHoneySQLForm`.")
  (unwrap-typed-honeysql-form [honeysql-form]
    "If `honeysql-form` is a `TypedHoneySQLForm`, unwrap it and return the original form without type information.
    Otherwise, returns form as-is."))
(defn- format-typed [_tag [expr _type-info]]
  (sql/format-expr expr {:nested true}))
(sql/register-fn! ::typed #'format-typed)
(def ^:private NormalizedTypeInfo
  [:map
   [:database-type
    {:optional true}
    [:and
     ms/NonBlankString
     [:fn
      {:error/message "lowercased string"}
      (fn [s]
        (= s (u/lower-case-en s)))]]]])
(mu/defn ^:private normalize-type-info :- NormalizedTypeInfo
  "Normalize the values in the `type-info` for a `TypedHoneySQLForm` for easy comparisons (e.g., normalize
  `:database-type` to a lower-case string)."
  [type-info]
  (cond-> type-info
    (:database-type type-info)
    (update :database-type (comp u/lower-case-en name))))
(defn- typed? [x]
  (and (vector? x)
       (= (first x) ::typed)))
(extend-protocol TypedHoneySQL
  Object
  (type-info [_]
    nil)
  (with-type-info [this new-info]
    [::typed this (normalize-type-info new-info)])
  (unwrap-typed-honeysql-form [this]
    this)

  nil
  (type-info [_]
    nil)
  (with-type-info [_ new-info]
    [::typed nil (normalize-type-info new-info)])
  (unwrap-typed-honeysql-form [_]
    nil)

  clojure.lang.IPersistentVector
  (type-info [this]
    (when (typed? this)
      (last this)))

  (with-type-info [this new-info]
    [::typed
     (if (typed? this)
       (clojure.core/second this)
       this)
     (normalize-type-info new-info)])

  (unwrap-typed-honeysql-form [this]
    (if (typed? this)
      (clojure.core/second this)
      this)))

For a given type-info, returns the database-type.

(defn type-info->db-type
  [type-info]
  {:added "0.39.0"}
  (:database-type type-info))

Returns the database-type from the type-info of honeysql-form if present. Otherwise, returns nil.

(defn database-type
  [honeysql-form]
  (some-> honeysql-form type-info type-info->db-type))

Is honeysql-form a typed form with db-type? Where db-type could be a string or a regex.

(is-of-type? expr "datetime") ; -> true (is-of-type? expr #"int*") ; -> true

(defn is-of-type?
  [honeysql-form db-type]
  (let [form-type (some-> honeysql-form database-type u/lower-case-en)]
    (if (instance? java.util.regex.Pattern db-type)
      (and (some? form-type) (some? (re-find db-type form-type)))
      (= form-type
         (some-> db-type name u/lower-case-en)))))

Convenience for adding only database type information to a honeysql-form. Wraps honeysql-form and returns a TypedHoneySQLForm. Passing nil as database-type will remove any existing type info.

(with-database-type-info :field "text") ;; -> [::typed :field "text"]

(mu/defn with-database-type-info
  {:style/indent [:form]}
  [honeysql-form db-type :- [:maybe ms/KeywordOrString]]
  (if (some? db-type)
    (with-type-info honeysql-form {:database-type db-type})
    (unwrap-typed-honeysql-form honeysql-form)))
(def ^:private TypedExpression
  [:fn {:error/message "::h2x/typed Honey SQL form"} typed?])
(mu/defn cast :- TypedExpression
  "Generate a statement like `cast(expr AS sql-type)`. Returns a typed HoneySQL form."
  [db-type expr]
  (-> [:cast expr [:raw (name db-type)]]
      (with-database-type-info db-type)))
(mu/defn quoted-cast :- TypedExpression
  "Generate a statement like `cast(expr AS \"sql-type\")`.
  Like `cast` but quotes `sql-type`. This is useful for cases where we deal with user-defined types or other types
  that may have a space in the name, for example Postgres enum types.
  Returns a typed HoneySQL form."
  [sql-type :- ms/NonBlankString expr]
  (-> [:cast expr (identifier :type-name sql-type)]
      (with-database-type-info sql-type)))
(mu/defn maybe-cast :- TypedExpression
  "Cast `expr` to `sql-type`, unless `expr` is typed and already of that type. Returns a typed HoneySQL form."
  [sql-type expr]
  (if (is-of-type? expr sql-type)
    expr
    (cast sql-type expr)))

Cast expr to desired-type unless expr is of one of the acceptable-types. Returns a typed HoneySQL form.

;; cast to TIMESTAMP unless form is already a TIMESTAMP, TIMESTAMPTZ, or DATE (cast-unless-type-in "timestamp" #{"timestamp" "timestamptz" "date"} form)

(defn cast-unless-type-in
  {:added "0.42.0"}
  [desired-type acceptable-types expr]
  {:pre [(string? desired-type) (set? acceptable-types)]}
  (if (some (partial is-of-type? expr)
            acceptable-types)
    expr
    (cast desired-type expr)))
(defn- math-operator [operator]
  (fn [& args]
    (let [arg-db-type (some (fn [arg]
                              (-> arg type-info type-info->db-type))
                            args)]
      (cond-> (into [operator]
                    (map (fn [arg]
                           (if (number? arg)
                             [:inline arg]
                             arg)))
                    args)
        arg-db-type (with-database-type-info arg-db-type)))))

Math operator. Interpose + between exprs and wrap in parentheses.

Math operator. Interpose - between exprs and wrap in parentheses.

Math operator. Interpose / between exprs and wrap in parentheses.

Math operator. Interpose * between exprs and wrap in parentheses.

Math operator. Interpose % between exprs and wrap in parentheses.

(def ^{:arglists '([& exprs])}  +   (math-operator :+))
(def ^{:arglists '([& exprs])}  -   (math-operator :-))
(def ^{:arglists '([& exprs])}  /   (math-operator :/))
(def ^{:arglists '([& exprs])}  *   (math-operator :*))
(def ^{:arglists '([& exprs])} mod  (math-operator :%))

Add 1 to x.

Subtract 1 from x.

(defn inc         [x] (+ x 1))
(defn dec  [x] (- x 1))

SQL format function.

(defn format
  [format-str expr]
  (sql/call :format expr (literal format-str)))

SQL round function.

(defn round
  [x decimal-places]
  (sql/call :round x decimal-places))

CAST x to a date.

CAST x to a datetime.

CAST x to a timestamp.

CAST x to a timestamp with time zone.

CAST x to a integer.

CAST x to a time datatype

CAST x to a boolean datatype

(defn ->date                                          [x] (maybe-cast :date x))
(defn ->datetime                                  [x] (maybe-cast :datetime x))
(defn ->timestamp                                [x] (maybe-cast :timestamp x))
(defn ->timestamp-with-time-zone  [x] (maybe-cast "timestamp with time zone" x))
(defn ->integer                                    [x] (maybe-cast :integer x))
(defn ->time                                  [x] (maybe-cast :time x))
(defn ->boolean                            [x] (maybe-cast :boolean x))

SQL abs function.

Random SQL fns. Not all DBs support all these!

SQL ceil function.

SQL floor function.

SQL second function.

SQL minute function.

SQL hour function.

SQL day function.

SQL week function.

SQL month function.

SQL quarter function.

SQL year function.

SQL concat function.

(def ^{:arglists '([& exprs])} abs          (partial sql/call :abs))
(def ^{:arglists '([& exprs])} ceil        (partial sql/call :ceil))
(def ^{:arglists '([& exprs])} floor      (partial sql/call :floor))
(def ^{:arglists '([& exprs])} second    (partial sql/call :second))
(def ^{:arglists '([& exprs])} minute    (partial sql/call :minute))
(def ^{:arglists '([& exprs])} hour        (partial sql/call :hour))
(def ^{:arglists '([& exprs])} day          (partial sql/call :day))
(def ^{:arglists '([& exprs])} week        (partial sql/call :week))
(def ^{:arglists '([& exprs])} month      (partial sql/call :month))
(def ^{:arglists '([& exprs])} quarter  (partial sql/call :quarter))
(def ^{:arglists '([& exprs])} year        (partial sql/call :year))
(def ^{:arglists '([& exprs])} concat    (partial sql/call :concat))
 
(ns metabase.util.humanization
  (:require
   [clojure.string :as str]
   [metabase.util :as u]))

Convert a name, such as num_toucans, to a human-readable name, such as Num Toucans.

(name->human-readable-name :simple "cool_toucans") ;-> "Cool Toucans"

;; specifiy a different strategy: (name->human-readable-name :none "cooltoucans") ;-> "cooltoucans"

(defmulti name->human-readable-name
  {:arglists '([strategy s])}
  (fn [strategy _s]
    (keyword strategy)))
(def ^:private ^:const acronyms
  #{"id" "url" "ip" "uid" "uuid" "guid"})
(defn- capitalize-word [word]
  (if (contains? acronyms (u/lower-case-en word))
    (u/upper-case-en word)
    ;; We are assuming that ALL_UPPER_CASE means we should be Title Casing
    (if (= word (u/upper-case-en word))
      (str/capitalize word)
      (str (str/capitalize (subs word 0 1)) (subs word 1)))))

simple replaces hyphens and underscores with spaces and capitalizes

(defmethod name->human-readable-name :simple
  [_strategy s]
  ;; explode on hyphens, underscores, and spaces
  (when (seq s)
    (let [humanized (str/join " " (for [part  (str/split s #"[-_\s]+")
                                        :when (not (str/blank? part))]
                                    (capitalize-word part)))]
      (if (str/blank? humanized)
        s
        humanized))))

:none is just an identity implementation

(defmethod name->human-readable-name :none
  [_strategy s]
  s)
 

i18n functionality.

(ns metabase.util.i18n
  (:require
   [cheshire.generate :as json.generate]
   [clojure.string :as str]
   [clojure.walk :as walk]
   [metabase.util.i18n.impl :as i18n.impl]
   [metabase.util.log :as log]
   [potemkin :as p]
   [potemkin.types :as p.types]
   [schema.core :as s])
  (:import
   (java.text MessageFormat)
   (java.util Locale)))
(set! *warn-on-reflection* true)
(p/import-vars
 [i18n.impl
  available-locale?
  fallback-locale
  locale
  normalized-locale-string
  translate])

Bind this to a string, keyword, or Locale to set the locale for the current User. To get the locale we should use, use the user-locale function instead.

(def ^:dynamic *user-locale*
  nil)

Bind this to a string, keyword to override the value returned by site-locale. For testing purposes, such as when swapping out an application database temporarily, when the setting table may not even exist.

(def ^:dynamic *site-locale-override*
  nil)

The default locale string for this Metabase installation. Normally this is the value of the site-locale Setting, which is also a string.

(defn site-locale-string
  []
  (or *site-locale-override*
      (i18n.impl/site-locale-from-setting)
      "en"))

Locale string we should use for the current User (e.g. tru messages) -- *user-locale* if bound, otherwise the system locale as a string.

(defn user-locale-string
  []
  (or *user-locale*
      (site-locale-string)))

The default locale for this Metabase installation. Normally this is the value of the site-locale Setting.

(defn site-locale
  ^Locale []
  (locale (site-locale-string)))

Locale we should use for the current User (e.g. tru messages) -- *user-locale* if bound, otherwise the system locale.

(defn user-locale
  ^Locale []
  (locale (user-locale-string)))

Returns all locale abbreviations and their full names

(defn available-locales-with-names
  []
  (for [locale-name (i18n.impl/available-locale-names)]
    ;; Abbreviation must be normalized or the language picker will show incorrect saved value
    ;; because the locale is normalized before saving (metabase#15657, metabase#16654)
    [(normalized-locale-string locale-name) (.getDisplayName (locale locale-name))]))

Translate a string with the System locale.

(defn- translate-site-locale
  [format-string args pluralization-opts]
  (let [translated (translate (site-locale) format-string args pluralization-opts)]
    (log/tracef "Translated %s for site locale %s -> %s"
                (pr-str format-string) (pr-str (site-locale-string)) (pr-str translated))
    translated))

Translate a string with the current User's locale.

(defn- translate-user-locale
  [format-string args pluralization-opts]
  (let [translated (translate (user-locale) format-string args pluralization-opts)]
    (log/tracef "Translating %s for user locale %s (site locale %s) -> %s"
                (pr-str format-string) (pr-str (user-locale-string))
                (pr-str (site-locale-string)) (pr-str translated))
    translated))
(p.types/defrecord+ UserLocalizedString [format-string args pluralization-opts]
  Object
  (toString [_]
    (translate-user-locale format-string args pluralization-opts))
  schema.core.Schema
  (explain [this]
    (str this)))
(p.types/defrecord+ SiteLocalizedString [format-string args pluralization-opts]
  Object
  (toString [_]
    (translate-site-locale format-string args pluralization-opts))
  s/Schema
  (explain [this]
    (str this)))

Write a UserLocalizedString or SiteLocalizedString to the json-generator. This is intended for json.generate/add-encoder. Ideally we'd implement those protocols directly as it's faster, but currently that doesn't work with Cheshire

(defn- localized-to-json
  [localized-string json-generator]
  (json.generate/write-string json-generator (str localized-string)))
(json.generate/add-encoder UserLocalizedString localized-to-json)
(json.generate/add-encoder SiteLocalizedString localized-to-json)

Schema for user and system localized string instances

(def LocalizedString
  (s/cond-pre UserLocalizedString SiteLocalizedString))
(defn- valid-str-form?
 [str-form]
 (and
  (= (first str-form) 'str)
  (every? string? (rest str-form))))

Make sure the right number of args were passed to trs/tru and related forms during macro expansion.

(defn- validate-number-of-args
  [format-string-or-str args]
  (let [format-string              (cond
                                     (string? format-string-or-str) format-string-or-str
                                     (valid-str-form? format-string-or-str) (apply str (rest format-string-or-str))
                                     :else (assert false "The first arg to (deferred-)trs/tru must be a String or a valid `str` form with String arguments!"))
        message-format             (MessageFormat. format-string)
        ;; number of {n} placeholders in format string including any you may have skipped. e.g. "{0} {2}" -> 3
        expected-num-args-by-index (count (.getFormatsByArgumentIndex message-format))
        ;; number of {n} placeholders in format string *not* including ones you make have skipped. e.g. "{0} {2}" -> 2
        expected-num-args          (count (.getFormats message-format))
        actual-num-args            (count args)]
    (assert (= expected-num-args expected-num-args-by-index)
            (format "(deferred-)trs/tru with format string %s is missing some {} placeholders. Expected %s. Did you skip any?"
                    (pr-str (.toPattern message-format))
                    (str/join ", " (map (partial format "{%d}") (range expected-num-args-by-index)))))
    (assert (= expected-num-args actual-num-args)
            (str (format (str "(deferred-)trs/tru with format string %s expects %d args, got %d.")
                         (pr-str (.toPattern message-format)) expected-num-args actual-num-args)
                 " Did you forget to escape a single quote?"))))

Similar to tru but creates a UserLocalizedString instance so that conversion to the correct locale can be delayed until it is needed. The user locale comes from the browser, so conversion to the localized string needs to be 'late bound' and only occur when the user's locale is in scope.

The first argument can be a format string, or a valid str form with all string arguments. The latter can be used to split a long string over multiple lines.

Calling str on the results of this invocation will lookup the translated version of the string.

(defmacro deferred-tru
  [format-string-or-str & args]
  (validate-number-of-args format-string-or-str args)
  `(UserLocalizedString. ~format-string-or-str ~(vec args) {}))

Similar to trs but creates a SiteLocalizedString instance so that conversion to the correct locale can be delayed until it is needed. This is needed as the system locale from the JVM can be overridden/changed by a setting.

The first argument can be a format string, or a valid str form with all string arguments. The latter can be used to split a long string over multiple lines.

Calling str on the results of this invocation will lookup the translated version of the string.

(defmacro deferred-trs
  [format-string & args]
  (validate-number-of-args format-string args)
  `(SiteLocalizedString. ~format-string ~(vec args) {}))

Ensures that trs/tru isn't called prematurely, during compilation.

(def ^String ^{:arglists '([& args])} str*
  (if *compile-files*
    (fn [& _]
      (throw (Exception. "Premature i18n string lookup. Is there a top-level call to `trs` or `tru`?")))
    str))

Applies str to deferred-tru's expansion.

The first argument can be a format string, or a valid str form with all string arguments. The latter can be used to split a long string over multiple lines.

Prefer this over deferred-tru. Use deferred-tru only in code executed at compile time, or where str is manually applied to the result.

(defmacro tru
  [format-string-or-str & args]
  `(str* (deferred-tru ~format-string-or-str ~@args)))

Applies str to deferred-trs's expansion.

The first argument can be a format string, or a valid str form with all string arguments. The latter can be used to split a long string over multiple lines.

Prefer this over deferred-trs. Use deferred-trs only in code executed at compile time, or where str is manually applied to the result.

(defmacro trs
  [format-string-or-str & args]
  `(str* (deferred-trs ~format-string-or-str ~@args)))

Make sure that trsn/trun and related forms have valid format strings, with most one placeholder (for n)

(defn- validate-n
  [format-string format-string-pl]
  (assert (and (string? format-string) (string? format-string-pl))
          "The first and second args to (deferred-)trsn/trun must be Strings!")
  (let [validate (fn [format-string]
                   (let [message-format    (MessageFormat. format-string)
                         ;; number of {n} placeholders in format string including any you may have skipped. e.g. "{0} {2}" -> 3
                         num-args-by-index (count (.getFormatsByArgumentIndex message-format))
                         ;; number of {n} placeholders in format string *not* including ones you make have skipped. e.g. "{0} {2}" -> 2
                         num-args          (count (.getFormats message-format))]
                     (assert (and (<= num-args-by-index 1) (<= num-args 1))
                             (format "(deferred-)trsn/trun only supports a single {0} placeholder for the value `n`"))))]
    (validate format-string)
    (validate format-string-pl)))

Similar to deferred-tru but chooses the appropriate singular or plural form based on the value of n.

The first argument should be the singular form; the second argument should be the plural form, and the third argument should be n. n can be interpolated into the translated string using the {0} placeholder syntax, but no additional placeholders are supported.

(deferred-trun "{0} table" "{0} tables" n)

(defmacro deferred-trun
  [format-string format-string-pl n]
  (validate-n format-string format-string-pl)
  `(UserLocalizedString. ~format-string ~[n] ~{:n n :format-string-pl format-string-pl}))

Similar to tru but chooses the appropriate singular or plural form based on the value of n.

The first argument should be the singular form; the second argument should be the plural form, and the third argument should be n. n can be interpolated into the translated string using the {0} placeholder syntax, but no additional placeholders are supported.

(trun "{0} table" "{0} tables" n)

(defmacro trun
  [format-string format-string-pl n]
  `(str* (deferred-trun ~format-string ~format-string-pl ~n)))

Similar to deferred-trs but chooses the appropriate singular or plural form based on the value of n.

The first argument should be the singular form; the second argument should be the plural form, and the third argument should be n. n can be interpolated into the translated string using the {0} placeholder syntax, but no additional placeholders are supported.

(deferred-trsn "{0} table" "{0} tables" n)

(defmacro deferred-trsn
  [format-string format-string-pl n]
  (validate-n format-string format-string-pl)
  `(SiteLocalizedString. ~format-string ~[n] ~{:n n :format-string-pl format-string-pl}))

Similar to trs but chooses the appropriate singular or plural form based on the value of n.

The first argument should be the singular form; the second argument should be the plural form, and the third argument should be n. n can be interpolated into the translated string using the {0} placeholder syntax, but no additional placeholders are supported.

(trsn "{0} table" "{0} tables" n)

(defmacro trsn
  [format-string format-string-pl n]
  `(str* (deferred-trsn ~format-string ~format-string-pl ~n)))

Returns true if x is a system or user localized string instance

(defn localized-string?
  [x]
  (boolean (some #(instance? % x) [UserLocalizedString SiteLocalizedString])))

Walks the datastructure x and converts any localized strings to regular string

(defn localized-strings->strings
  [x]
  (walk/postwalk (fn [node]
                   (cond-> node
                     (localized-string? node) str))
                 x))
 

Lower-level implementation functions for metabase.util.i18n. Most of this is not meant to be used directly; use the functions and macros in metabase.util.i18n instead.

(ns metabase.util.i18n.impl
  (:require
   [clojure.java.io :as io]
   [clojure.string :as str]
   [clojure.tools.reader.edn :as edn]
   [metabase.plugins.classloader :as classloader]
   [metabase.util.i18n.plural :as i18n.plural]
   [metabase.util.log :as log]
   [potemkin.types :as p.types])
  (:import
   (java.text MessageFormat)
   (java.util Locale)
   (org.apache.commons.lang3 LocaleUtils)))
(set! *warn-on-reflection* true)

Protocol for anything that can be coerced to a java.util.Locale.

(p.types/defprotocol+ CoerceToLocale
  (locale ^java.util.Locale [this]
    "Coerce `this` to a `java.util.Locale`."))

Normalize a locale string to the canonical format.

(normalized-locale-string "EN-US") ;-> "en_US"

Returns nil for invalid strings -- you can use this to check whether a String is valid.

(defn normalized-locale-string
  ^String [s]
  {:pre [((some-fn nil? string?) s)]}
  #_{:clj-kondo/ignore [:discouraged-var]}
  (when (string? s)
    (when-let [[_ language country] (re-matches #"^(\w{2})(?:[-_](\w{2}))?$" s)]
      (let [language (str/lower-case language)]
        (if country
          (str language \_ (some-> country str/upper-case))
          language)))))
(extend-protocol CoerceToLocale
  nil
  (locale [_] nil)

  Locale
  (locale [this] this)

  String
  (locale [^String s]
    (some-> (normalized-locale-string s) LocaleUtils/toLocale))

  ;; Support namespaced keywords like `:en/US` and `:en/UK` because we can
  clojure.lang.Keyword
  (locale [this]
    (locale (if-let [namespce (namespace this)]
              (str namespce \_ (name this))
              (name this)))))

True if locale (a string, keyword, or Locale) is a valid locale available on this system. Normalizes args automatically.

(defn available-locale?
  [locale-or-name]
  (boolean
   (when-let [locale (locale locale-or-name)]
     (LocaleUtils/isAvailableLocale locale))))
(defn- available-locale-names*
  []
  (log/info "Reading available locales from locales.clj...")
  (some-> (io/resource "locales.clj") slurp edn/read-string :locales (->> (apply sorted-set))))

Return sorted set of available locales, as Strings.

(available-locale-names) ; -> #{"en" "nl" "pt-BR" "zh"}

(def ^{:arglists '([])} available-locale-names
  (let [locales (delay (available-locale-names*))]
    (fn [] @locales)))
(defn- find-fallback-locale*
  ^Locale [^Locale a-locale]
  (some (fn [locale-name]
          (let [try-locale (locale locale-name)]
            ;; The language-only Locale is tried first by virtue of the
            ;; list being sorted.
            (when (and (= (.getLanguage try-locale) (.getLanguage a-locale))
                       (not (= try-locale a-locale)))
              try-locale)))
        (available-locale-names)))
(def ^:private ^{:arglists '([a-locale])} find-fallback-locale
  (memoize find-fallback-locale*))

Find a translated fallback Locale in the following order: 1) If it is a language + country Locale, try the language-only Locale 2) If the language-only Locale isn't translated or the input is a language-only Locale, find the first language + country Locale we have a translation for. Return nil if no fallback Locale can be found or the input is invalid.

(fallback-locale "en_US") ; -> #locale"en" (fallback-locale "pt") ; -> #locale"pt_BR" (fallback-locale "ptPT") ; -> #locale"ptBR"

(defn fallback-locale
  ^Locale [locale-or-name]
  (when-let [a-locale (locale locale-or-name)]
    (find-fallback-locale a-locale)))

The resource URL for the edn file containing translations for locale-or-name. These files are built by the scripts in bin/i18n from .po files from POEditor.

(locale-edn-resources "es") ;-> #object[java.net.URL "file:/home/cam/metabase/resources/metabase/es.edn"]

(defn- locale-edn-resource
  ^java.net.URL [locale-or-name]
  (when-let [a-locale (locale locale-or-name)]
    (let [locale-name (-> (normalized-locale-string (str a-locale))
                          (str/replace #"_" "-"))
          filename    (format "i18n/%s.edn" locale-name)]
      (io/resource filename (classloader/the-classloader)))))
(defn- translations* [a-locale]
  (when-let [resource (locale-edn-resource a-locale)]
    (edn/read-string (slurp resource))))

Fetch a map of original untranslated message format string -> translated message format string for locale-or-name by reading the corresponding EDN resource file. Does not include translations for parent locale(s). Memoized.

(translations "es") ;-> {:headers { ... } :messages {"Username" "Nombre Usuario", ...}}

(def ^:private ^{:arglists '([locale-or-name])} translations
  (comp (memoize translations*) locale))

Find the translated version of format-string for locale-or-name, or nil if none can be found. Does not search 'parent' (language-only) translations.

n is a number used for translations with plural forms, used to compute the index of the translation to return.

(defn- translated-format-string*
  ^String [locale-or-name format-string n]
  (when (seq format-string)
    (when-let [locale (locale locale-or-name)]
      (when-let [translations (translations locale)]
        (when-let [string-or-strings (get-in translations [:messages format-string])]
          (if (string? string-or-strings)
            ;; Only a singular form defined; ignore `n`
            string-or-strings
            (if-let [plural-forms-header (get-in translations [:headers "Plural-Forms"])]
              (get string-or-strings (i18n.plural/index plural-forms-header n))
              ;; Fall-back to singular if no header is present
              (first string-or-strings))))))))

Find the translated version of format-string for locale-or-name, or nil if none can be found. Searches parent (language-only) translations if none exist for a language + country locale.

(defn- translated-format-string
  ^String [locale-or-name format-string {:keys [n format-string-pl]}]
  (when-let [a-locale (locale locale-or-name)]
    (or (when (= (.getLanguage a-locale) "en")
          (if (or (nil? n) (= n 1))
            format-string
            format-string-pl))
        (translated-format-string* a-locale format-string n)
        (when-let [fallback-locale (fallback-locale a-locale)]
          (log/tracef "No translated string found, trying fallback locale %s" (pr-str fallback-locale))
          (translated-format-string* fallback-locale format-string n))
        format-string)))
(defn- message-format ^MessageFormat [locale-or-name ^String format-string pluralization-opts]
  (or (when-let [a-locale (locale locale-or-name)]
        (when-let [^String translated (translated-format-string a-locale format-string pluralization-opts)]
          (MessageFormat. translated a-locale)))
      (MessageFormat. format-string)))

Find the translated version of format-string for a locale-or-name, then format it. Translates using the resource bundles generated by the ./bin/i18n/build-translation-resources script; these live in ./resources/metabase/Metabase/Messages_<locale>.class. Attempts to translate with language-country Locale if specified, falling back to language (without country), finally falling back to English (i.e., not formatting the original untranslated format-string) if no matching bundles/translations exist, or if translation fails for some other reason.

n is used for strings with plural forms and essentially represents the quantity of items being described by the translated string. Defaults to 1 (the singular form).

Will attempt to translate format-string, but if for some reason we're not able to (such as a typo in the translated version of the string), log the failure but return the original (untranslated) string. This is a workaround for translations that, due to a typo, will fail to parse using Java's message formatter.

(translate "es-MX" "must be {0} characters or less" 140) ; -> "deben tener 140 caracteres o menos"

(defn translate
  ([locale-or-name ^String format-string]
   (translate locale-or-name format-string []))
  ([locale-or-name ^String format-string args]
   (translate locale-or-name format-string args {}))
  ([locale-or-name ^String format-string args pluralization-opts]
   (when (seq format-string)
     (try
       (.format (message-format locale-or-name format-string pluralization-opts) (to-array args))
       (catch Throwable e
         ;; Not translating this string to prevent an unfortunate stack overflow. If this string happened to be the one
         ;; that had the typo, we'd just recur endlessly without logging an error.
         (log/errorf e "Unable to translate string %s to %s" (pr-str format-string) (str locale-or-name))
         (try
           (.format (MessageFormat. format-string) (to-array args))
           (catch Throwable _
             (log/errorf e "Invalid format string %s" (pr-str format-string))
             format-string)))))))

Whether we're currently inside a call to [[site-locale-from-setting]], so we can prevent infinite recursion.

(def ^:private ^:dynamic *in-site-locale-from-setting*
  false)

Fetch the value of the site-locale Setting, or nil if it is unset.

(defn site-locale-from-setting
  []
  (when-let [get-value-of-type (resolve 'metabase.models.setting/get-value-of-type)]
    (when (bound? get-value-of-type)
      ;; make sure we don't try to recursively fetch the site locale when we're actively in the process of fetching it,
      ;; otherwise that will cause infinite loops if we try to log anything... see #32376
      (when-not *in-site-locale-from-setting*
        (binding [*in-site-locale-from-setting* true]
          ;; if there is an error fetching the Setting, e.g. if the app DB is in the process of shutting down, then just
          ;; return nil.
          (try
            (get-value-of-type :string :site-locale)
            (catch Exception _
              nil)))))))
(defmethod print-method Locale
  [locale ^java.io.Writer writer]
  ((get-method print-dup Locale) locale writer))
(defmethod print-dup Locale
  [locale ^java.io.Writer writer]
  (.write writer (format "#locale %s" (pr-str (str locale)))))
 

Resources for parsing the Plural-Forms header from a translation file and determining which of multiple pluralities to use for a translated string.

(ns metabase.util.i18n.plural
  (:require
   [clojure.core.memoize :as memoize]
   [instaparse.core :as insta]))

This is a parser for the C-like syntax used to express pluralization rules in the Plural-Forms header in translation files.

For example, the Plural-Forms header for Czech is: nplurals=3; plural=(n==1) ? 0 : (n>=2 && n<=4) ? 1 : 2; This is a parser for the expression following plural=.

See the original gettext docs for more details on how pluralization rules work: https://www.gnu.org/software/gettext/manual/html_node/Plural-forms.html

Operators with LOWER precedence are defined HIGHER in the grammar, and vice versa. A rule defines the grammar for all operators at or above a single level of precedence.

The instaparse README (https://github.com/Engelberg/instaparse) has an example of a parser called arithmetic which is essentially a simpler version of this exact same parser. It may help to read and understand that parser first before trying to understand this one.

(def ^:private plural-form-parser
  (insta/parser
   "expr           = <s> maybe-ternary <s> <';'>? <s>
   <maybe-ternary> = ternary | maybe-or
   ternary         = maybe-or <s> <'?'> <s> maybe-ternary <s> <':'> <s> maybe-ternary
   <maybe-or>      = or-expr | maybe-and
   or-expr         = maybe-or <s> <'||'> <s> maybe-and
   <maybe-and>     = and-expr | maybe-eq
   and-expr        = maybe-and <s> <'&&'> <s> maybe-eq
   <maybe-eq>      = eq-expr | neq-expr | maybe-comp
   eq-expr         = maybe-eq <s> <'=='> <s> maybe-comp
   neq-expr        = maybe-eq <s> <'!='> <s> maybe-comp
   <maybe-comp>    = lt-expr | lte-expr | gt-expr | gte-expr | maybe-add
   lt-expr         = maybe-comp <s> <'<'> <s> maybe-add
   lte-expr        = maybe-comp <s> <'<='> <s> maybe-add
   gt-expr         = maybe-comp <s> <'>'> <s> maybe-add
   gte-expr        = maybe-comp <s> <'>='> <s> maybe-add
   <maybe-add>     = add-expr | sub-expr | maybe-mult
   add-expr        = maybe-add <s> <'+'> <s> maybe-mult
   sub-expr        = maybe-add <s> <'-'> <s> maybe-mult
   <maybe-mult>    = mult-expr | div-expr | mod-expr | operand
   mult-expr       = maybe-mult <s> <'*'> <s> operand
   div-expr        = maybe-mult <s> <'/'> <s> operand
   mod-expr        = maybe-mult <s> <'%'> <s> operand
   <operand>       = integer | variable | parens
   <parens>        = <'('> <s> expr <s> <')'>
   <s>             = <#'\\s+'>*
   integer         = #'[0-9]+'
   variable        = 'n'"))

Converts an integer or Boolean to a Boolean to use in a C-style logical operator.

(defn- to-bool
  [x]
  (if (integer? x)
    (if (= x 0) false true)
    x))

Converts an integer or Boolean to an integer to use in a C-style arithmetic operator.

(defn- to-int
  [x]
  (if (boolean? x)
    (if x 1 0)
    x))

Converts a Clojure binary function f to a C-style operator that treats Booleans as integers, and returns an integer.

(defn- op
  [f]
  (fn [x y] (to-int (f (to-int x) (to-int y)))))

Functions to use for each tag in the parse tree, when transforming the tree into a single value.

(defn- tag-fns
  [n]
  {:add-expr  (op +)
   :sub-expr  (op -)
   :mult-expr (op *)
   :div-expr  (op /)
   :mod-expr  (op mod)
   :eq-expr   (op =)
   :neq-expr  (op not=)
   :gt-expr   (op >)
   :gte-expr  (op >=)
   :lt-expr   (op <)
   :lte-expr  (op <=)
   :and-expr  #(to-int (and (to-bool %1) (to-bool %2)))
   :or-expr   #(to-int (or (to-bool %1) (to-bool %2)))
   :ternary   #(to-int (if (to-bool %1) %2 %3))
   :integer   #(Integer. ^String %)
   :variable  (constantly n)
   :expr      identity})

Returns the index of the correct translated string for a given value n, based on the value of the Plural-Forms header for a locale.

Memoized to improve performance for cases where a single string is translated with a limited range of possible values of n (e.g. "{0} months"). However, in some cases, a string may be translated with a unique value of n in every lookup (e.g. "{0} rows"). Each distinct value of n would take up space in the cache with very little benefit, and if many of these translations are requested at once, they would take up the entire cache. Therefore, we use a least-used eviction policy to ensure that common values of n remain in the cache over time.

(def index
  (memoize/lu
   (fn [plural-forms-header n]
     (let [formula (second (re-find #"plural=(.*)" plural-forms-header))
           tree    (insta/parse plural-form-parser formula)]
       (insta/transform (tag-fns n) tree)))
   {}
   ;; This cache size is pretty arbitrary; can be tweaked if necessary
   :lu/threshold 500))
 

JVM-specific utilities and helpers. You don't want to import this namespace directly - these functions are re-exported by [[metabase.util]].

(ns metabase.util.jvm
  (:require
   [clojure.java.classpath :as classpath]
   [clojure.string :as str]
   [clojure.tools.namespace.find :as ns.find]
   [metabase.shared.util.i18n :refer [tru]]
   [metabase.util.format :as u.format]
   [metabase.util.log :as log]
   [nano-id.core :as nano-id])
  (:import
   (java.net InetAddress InetSocketAddress Socket)
   (java.util Base64 Base64$Decoder Base64$Encoder Locale PriorityQueue Random)
   (java.util.concurrent TimeoutException)))
(set! *warn-on-reflection* true)

Generates a random NanoID string. Usually these are used for the entity_id field of various models. If an argument is provided, it's taken to be an identity-hash string and used to seed the RNG, producing the same value every time.

(defn generate-nano-id
  ([] (nano-id/nano-id))
  ([seed-str]
   (let [seed (Long/parseLong seed-str 16)
         rnd  (Random. seed)
         gen  (nano-id/custom
               "_-0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
               21
               (fn [len]
                 (let [ba (byte-array len)]
                   (.nextBytes rnd ba)
                   ba)))]
     (gen))))

Make a properly-tagged Java interop varargs argument. This is basically the same as into-array but properly tags the result.

(u/varargs String) (u/varargs String ["A" "B"])

(defmacro varargs
  {:style/indent 1, :arglists '([klass] [klass xs])}
  [klass & [objects]]
  (vary-meta `(into-array ~klass ~objects)
             assoc :tag (format "[L%s;" (.getTypeName ^Class (ns-resolve *ns* klass)))))

Timeout (in ms) for checking if a host is available with host-up? and host-port-up?.

(def ^:private ^:const host-up-timeout
  5000)

Returns true if the port is active on a given host, false otherwise

(defn host-port-up?
  [^String hostname, ^Integer port]
  (try
    (let [sock-addr (InetSocketAddress. hostname port)]
      (with-open [sock (Socket.)]
        (.connect sock sock-addr host-up-timeout)
        true))
    (catch Throwable _ false)))

Returns true if the host given by hostname is reachable, false otherwise

(defn host-up?
  [^String hostname]
  (try
    (let [host-addr (InetAddress/getByName hostname)]
      (.isReachable host-addr host-up-timeout))
    (catch Throwable _ false)))
(defprotocol ^:private IFilteredStacktrace
  (filtered-stacktrace [this]
    "Get the stack trace associated with E and return it as a vector with non-metabase frames after the last Metabase
    frame filtered out."))
(extend-protocol IFilteredStacktrace
  nil
  (filtered-stacktrace [_] nil)

  Throwable
  (filtered-stacktrace [^Throwable this]
    (filtered-stacktrace (.getStackTrace this)))

  Thread
  (filtered-stacktrace [^Thread this]
    (filtered-stacktrace (.getStackTrace this))))
(extend (Class/forName "[Ljava.lang.StackTraceElement;")
  IFilteredStacktrace
  {:filtered-stacktrace
   (fn [this]
     ;; keep all the frames before the last Metabase frame, but then filter out any other non-Metabase frames after
     ;; that
     (let [[frames-after-last-mb other-frames]     (split-with #(not (str/includes? % "metabase"))
                                                               (seq this))
           [last-mb-frame & frames-before-last-mb] (for [frame other-frames
                                                         :when (str/includes? frame "metabase")]
                                                     (str/replace frame #"^metabase\." ""))]
       (vec
        (concat
         (map str frames-after-last-mb)
         ;; add a little arrow to the frame so it stands out more
         (cons
          (some->> last-mb-frame (str "--> "))
          frames-before-last-mb)))))})

Whether string s is a valid IP (v4 or v6) address.

(defn ip-address?
  [s]
  (and (string? s)
       (.isValid (org.apache.commons.validator.routines.InetAddressValidator/getInstance) ^String s)))

A reducing function that maintains a queue of the largest items as determined by kompare. The queue is bounded in size by size. Useful if you are interested in the largest size number of items without keeping the entire collection in memory.

In general, (= (take-last 2 (sort-by identity kompare coll)) (transduce (map identity) (u/sorted-take 2 kompare) coll)) But the entire collection is not in memory, just at most

(defn sorted-take
  [size kompare]
  (fn bounded-heap-acc
    ([] (PriorityQueue. size kompare))
    ([^PriorityQueue q]
     (loop [acc []]
       (if-let [x (.poll q)]
         (recur (conj acc x))
         acc)))
    ([^PriorityQueue q item]
     (if (>= (.size q) size)
       (let [smallest (.peek q)]
         (if (pos? (kompare item smallest))
           (doto q
             (.poll)
             (.offer item))
           q))
       (doto q
         (.offer item))))))

Gather the full exception chain into a sequence.

(defn full-exception-chain
  [e]
  (when (instance? Throwable e)
    (take-while some? (iterate ex-cause e))))

Like ex-data, but merges ex-data from causes. If duplicate keys exist, the keys from the highest level are preferred.

(def e (ex-info "A" {:a true, :both "a"} (ex-info "B" {:b true, :both "A"})))

(ex-data e) ;; -> {:a true, :both "a"}

(u.jvm/all-ex-data e) ;; -> {:a true, :b true, :both "a"}

(defn all-ex-data
  [e]
  (reduce
   (fn [data e]
     (merge (ex-data e) data))
   nil
   (full-exception-chain e)))

Execute f, a function that takes no arguments, and return the results. If f fails with an exception, retry f up to num-retries times until it succeeds.

Consider using the auto-retry macro instead of calling this function directly.

For implementing more fine grained retry policies like exponential backoff, consider using the metabase.util.retry namespace.

(defn do-with-auto-retries
  {:style/indent 1}
  [num-retries f]
  (if (<= num-retries 0)
    (f)
    (try
      (f)
      (catch Throwable e
        (when (::no-auto-retry? (all-ex-data e))
          (throw e))
        (log/warn (u.format/format-color 'red "auto-retry %s: %s" f (.getMessage e)))
        (do-with-auto-retries (dec num-retries) f)))))

Execute body and return the results. If body fails with an exception, retry execution up to num-retries times until it succeeds.

You can disable auto-retries for a specific ExceptionInfo by including {:metabase.util.jvm/no-auto-retry? true} in its data (or the data of one of its causes.)

For implementing more fine grained retry policies like exponential backoff, consider using the metabase.util.retry namespace.

(defmacro auto-retry
  {:style/indent 1}
  [num-retries & body]
  `(do-with-auto-retries ~num-retries
     (fn [] ~@body)))

A shared Base64 decoder instance.

(def ^:private ^Base64$Decoder base64-decoder
  (Base64/getDecoder))

Decodes a Base64 string into bytes.

(defn decode-base64-to-bytes
  ^bytes [^String string]
  (.decode base64-decoder string))

Decodes the Base64 string input to a UTF-8 string.

TODO -- this is only used [[metabase.analytics.snowplow-test]] these days

(defn decode-base64
  [input]
  (new java.lang.String (decode-base64-to-bytes input) "UTF-8"))

A shared Base64 encoder instance.

(def ^:private ^Base64$Encoder base64-encoder
  (Base64/getEncoder))

Encodes the UTF-8 encoding of the string input to a Base64 string.

(defn encode-base64
  ^String [^String input]
  (.encodeToString base64-encoder (.getBytes input "UTF-8")))
(def ^:private do-with-us-locale-lock (Object.))

Implementation for with-us-locale macro; see below.

(defn do-with-us-locale
  [f]
  ;; Since I'm 99% sure default Locale isn't thread-local we better put a lock in place here so we don't end up with
  ;; the following race condition:
  ;;
  ;; Thread 1 ....*.............................*........................*...........*
  ;;              ^getDefault() -> Turkish      ^setDefault(US)          ^(f)        ^setDefault(Turkish)
  ;; Thread 2 ....................................*....................*................*......*
  ;;                                              ^getDefault() -> US  ^setDefault(US)  ^(f)   ^setDefault(US)
  (locking do-with-us-locale-lock
    (let [original-locale (Locale/getDefault)]
      (try
        (Locale/setDefault Locale/US)
        (f)
        (finally
          (Locale/setDefault original-locale))))))

Execute body with the default system locale temporarily set to locale. Why would you want to do this? Tons of code relies on String/toUpperCase which converts a string to uppercase based on the default locale. Normally, this does what you'd expect, but when the default locale is Turkish, all hell breaks loose:

;; Locale is Turkish / -Duser.language=tr (.toUpperCase "filename") ;; -> "FİLENAME"

Rather than submit PRs to every library in the world to use (.toUpperCase <str> Locale/US), it's simpler just to temporarily bind the default Locale to something predicatable (i.e. US English) when doing something important that tends to break like running Liquibase migrations.)

Note that because Locale/setDefault and Locale/getDefault aren't thread-local (as far as I know) I've had to put a lock in place to prevent race conditions where threads simulataneously attempt to fetch and change the default Locale. Thus this macro should be used sparingly, and only in places that are already single-threaded (such as the launch code that runs Liquibase).

DO NOT use this macro in API endpoints or other places that are multithreaded or performance will be negatively impacted. (You shouldn't have a good reason for using this there anyway. Rewrite your code to pass Locale/US when you call .toUpperCase or str/upper-case. Only use this macro if the calls in question are part of a 3rd-party library.)

(defmacro with-us-locale
  {:style/indent 0}
  [& body]
  `(do-with-us-locale (fn [] ~@body)))

Vector of symbols of all Metabase namespaces, excluding test namespaces. This is intended for use by various routines that load related namespaces, such as task and events initialization.

This is made ^:const so it will get calculated when the uberjar is compiled. find-namespaces won't work if source is excluded; either way this takes a few seconds, so doing it at compile time speeds up launch as well.

(defonce ^:const 
  metabase-namespace-symbols
  (vec (sort (for [ns-symb (ns.find/find-namespaces (classpath/system-classpath))
                   :when   (and (str/starts-with? ns-symb "metabase")
                                (not (str/includes? ns-symb "test")))]
               ns-symb))))

Call deref on a something derefable (e.g. a future or promise), and throw an exception if it takes more than timeout-ms. If ref is a future it will attempt to cancel it as well.

(defn deref-with-timeout
  [reff timeout-ms]
  (let [result (deref reff timeout-ms ::timeout)]
    (when (= result ::timeout)
      (when (future? reff)
        (future-cancel reff))
      (throw (TimeoutException. (tru "Timed out after {0}" (u.format/format-milliseconds timeout-ms)))))
    result))

Impl for with-timeout macro.

(defn do-with-timeout
  [timeout-ms f]
  (try
    (deref-with-timeout (future-call f) timeout-ms)
    (catch java.util.concurrent.ExecutionException e
      (throw (.getCause e)))))

Run body in a future and throw an exception if it fails to complete after timeout-ms.

(defmacro with-timeout
  [timeout-ms & body]
  `(do-with-timeout ~timeout-ms (fn [] ~@body)))
 
(ns metabase.util.log
  (:require
   [goog.log :as glog]
   [goog.string :as gstring]
   [goog.string.format :as gstring.format]
   [lambdaisland.glogi :as log]
   [lambdaisland.glogi.console :as glogi-console])
  (:require-macros
   [metabase.util.log]))

The formatting functionality is only loaded if you depend on goog.string.format.

(comment gstring.format/keep-me)
(glogi-console/install!)
(log/set-levels {:glogi/root :info})

Part of the internals of [[glogi-logp]] etc.

#_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]}
(defn is-loggable?
  [logger-name level]
  (glog/isLoggable (log/logger logger-name) (log/level level)))

Part of the internals of [[logf]].

#_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]}
(defn format-msg
  [fmt & args]
  (apply gstring/format fmt args))

Converts our standard metabase.util.log levels to those understood by glogi.

(defn glogi-level
  [level]
  (if (= level :fatal)
    :shout
    level))
 

Common logging interface that wraps clojure.tools.logging in JVM Clojure and Glogi in CLJS.

The interface is the same as [[clojure.tools.logging]].

(ns metabase.util.log
  (:require
   [clojure.pprint :as pprint]
   [clojure.string :as str]
   #_{:clj-kondo/ignore [:discouraged-namespace]}
   [clojure.tools.logging]
   [clojure.tools.logging.impl]
   [net.cgrand.macrovich :as macros]))

Macro helper for [[logp]] in CLJS.

--------------------------------------------- CLJ-side macro helpers ---------------------------------------------

(defn- glogi-logp
  [logger-name level x more]
  `(let [level#  (glogi-level ~level)
         logger# ~logger-name]
    (when (is-loggable? logger# level#)
     (let [x# ~x]
       (if (instance? js/Error x#)
         (lambdaisland.glogi/log logger# level# (print-str ~@more) x#)
         (lambdaisland.glogi/log logger# level# (print-str x# ~@more) nil))))))

Macro helper for [[logf]] in CLJS.

(defn- glogi-logf
  [logger-name level x more]
  `(let [level#  (glogi-level ~level)
         logger# ~logger-name]
     (when (is-loggable? logger# level#)
       (let [x# ~x]
         (if (instance? js/Error x#)
           (lambdaisland.glogi/log logger# level# (format-msg ~@more) x#)
           (lambdaisland.glogi/log logger# level# (format-msg x# ~@more) nil))))))

Macro helper for [[spy]] and [[spyf]] in CLJS.

(defn- glogi-spy
  [logger-name level expr formatter]
  `(let [level#  (glogi-level ~level)
         logger# ~logger-name]
     (when (is-loggable? logger# level#)
       (let [a# ~expr
             s# (~formatter a#)]
         (lambdaisland.glogi/log logger# level# nil s#)
         a#))))

Macro helper for [[logp]] in CLJ.

(defn- tools-logp
  [logger-ns level x more]
  `(let [logger# (clojure.tools.logging.impl/get-logger clojure.tools.logging/*logger-factory* ~logger-ns)]
     (when (clojure.tools.logging.impl/enabled? logger# ~level)
       (let [x# ~x]
         (if (instance? Throwable x#)
           (clojure.tools.logging/log* logger# ~level x#  ~(if (nil? more)
                                                             ""
                                                             `(print-str ~@more)))
           (clojure.tools.logging/log* logger# ~level nil (print-str x# ~@more)))))))

Macro helper for [[logf]] in CLJ.

(defn- tools-logf
  [logger-ns level x more]
  (if (and (instance? String x) (nil? more))
    ;; Simple case: just a String and no args.
    `(let [logger# (clojure.tools.logging.impl/get-logger clojure.tools.logging/*logger-factory* ~logger-ns)]
       (when (clojure.tools.logging.impl/enabled? logger# ~level)
         (clojure.tools.logging/log* logger# ~level nil ~x)))
    ;; Full case, with formatting.
    `(let [logger# (clojure.tools.logging.impl/get-logger clojure.tools.logging/*logger-factory* ~logger-ns)]
       (when (clojure.tools.logging.impl/enabled? logger# ~level)
         (let [x# ~x]
           (if (instance? Throwable x#)
             (clojure.tools.logging/log* logger# ~level x#  (format ~@more))
             (clojure.tools.logging/log* logger# ~level nil (format x# ~@more))))))))

Implementation for prn-style logp. You shouldn't have to use this directly; prefer the level-specific macros like [[info]].

------------------------------------------------ Internal macros -------------------------------------------------

(defmacro logp
  {:arglists '([level message & more] [level throwable message & more])}
  [level x & more]
  (macros/case
    :cljs (glogi-logp (str *ns*) level x more)
    :clj  (tools-logp *ns*       level x more)))

Implementation for printf-style logf. You shouldn't have to use this directly; prefer the level-specific macros like [[infof]].

(defmacro logf
  [level x & args]
  (macros/case
    :cljs (glogi-logf (str *ns*) level x args)
    :clj  (tools-logf *ns*       level x args)))

Log one or more args at the :trace level.

--------------------------------------------------- Public API ---------------------------------------------------

(defmacro trace
  {:arglists '([& args] [e & args])}
  [& args]
  `(logp :trace ~@args))

Log a message at the :trace level by applying format to a format string and args.

(defmacro tracef
  {:arglists '([format-string & args] [e format-string & args])}
  [& args]
  `(logf :trace ~@args))

Log one or more args at the :debug level.

(defmacro debug
  {:arglists '([& args] [e & args])}
  [& args]
  `(logp :debug ~@args))

Log a message at the :debug level by applying format to a format string and args.

(defmacro debugf
  {:arglists '([format-string & args] [e format-string & args])}
  [& args]
  `(logf :debug ~@args))

Log one or more args at the :info level.

(defmacro info
  {:arglists '([& args] [e & args])}
  [& args]
  `(logp :info ~@args))

Log a message at the :info level by applying format to a format string and args.

(defmacro infof
  {:arglists '([format-string & args] [e format-string & args])}
  [& args]
  `(logf :info ~@args))

Log one or more args at the :warn level.

(defmacro warn
  {:arglists '([& args] [e & args])}
  [& args]
  `(logp :warn ~@args))

Log a message at the :warn level by applying format to a format string and args.

(defmacro warnf
  {:arglists '([format-string & args] [e format-string & args])}
  [& args]
  `(logf :warn ~@args))

Log one or more args at the :error level.

(defmacro error
  {:arglists '([& args] [e & args])}
  [& args]
  `(logp :error ~@args))

Log a message at the :error level by applying format to a format string and args.

(defmacro errorf
  {:arglists '([format-string & args] [e format-string & args])}
  [& args]
  `(logf :error ~@args))

Log one or more args at the :fatal level.

#_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]}
(defmacro fatal
  {:arglists '([& args] [e & args])}
  [& args]
  `(logp :fatal ~@args))

Log a message at the :fatal level by applying format to a format string and args.

(defmacro fatalf
  {:arglists '([format-string & args] [e format-string & args])}
  [& args]
  `(logf :fatal ~@args))

Evaluates an expression, and may write both the form and its result to the log. Returns the result of expr. Defaults to the :debug level.

(defmacro spy
  ([expr] `(spy :debug ~expr))
  ([level expr]
   (macros/case
     :cljs (glogi-spy (str *ns*) level expr
                      #(str/trim-newline
                        (with-out-str
                          #_{:clj-kondo/ignore [:discouraged-var]}
                           (pprint/with-pprint-dispatch pprint/code-dispatch
                             (pprint/pprint '~expr)
                             (print "=> ")
                             (pprint/pprint %)))))
     :clj  `(clojure.tools.logging/spy ~level ~expr))))

Evaluates an expression, and may write both the form and its formatted result to the log. Defaults to the :debug level.

#_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]}
(defmacro spyf
  ([fmt expr]
   `(spyf :debug ~fmt ~expr))
  ([level fmt expr]
   (macros/case
    :cljs (glogi-spy (str *ns*) level expr #(format ~fmt %))
    :clj  `(spyf ~level ~fmt ~expr))))

Turns off logs in body.

(defmacro with-no-logs
  [& body]
  `(binding [clojure.tools.logging/*logger-factory* clojure.tools.logging.impl/disabled-logger-factory]
     ~@body))
 
(ns metabase.util.malli.defn
  (:refer-clojure :exclude [defn])
  (:require
   [clojure.string :as str]
   [malli.destructure]
   [metabase.util :as u]
   [metabase.util.malli.fn :as mu.fn]
   [net.cgrand.macrovich :as macros]))

TODO -- this should generate type hints from the schemas and from the return type as well.

(defn- deparameterized-arglist [{:keys [args]}]
  (-> (malli.destructure/parse args)
      :arglist
      (with-meta (meta args))))
(defn- deparameterized-arglists [{:keys [arities], :as _parsed}]
  (let [[arities-type arities-value] arities]
    (case arities-type
      :single   (list (deparameterized-arglist arities-value))
      :multiple (map deparameterized-arglist (:arities arities-value)))))

Generate a docstring with additional information about inputs and return type using a parsed fn tail (as parsed by [[mx/SchematizedParams]]).

(defn- annotated-docstring
  [{original-docstring           :doc
    [arities-type arities-value] :arities
    :keys                        [return]
    :as                          _parsed}]
  (str/trim
   (str "Inputs: " (case arities-type
                     :single   (pr-str (:args arities-value))
                     :multiple (str "("
                                    (str/join "\n           "
                                              (map (comp pr-str :args)
                                                   (:arities arities-value)))
                                    ")"))
        "\n  Return: " (str/replace (u/pprint-to-str (:schema return :any))
                                    "\n"
                                    (str "\n          "))
        (when (not-empty original-docstring)
          (str "\n\n  " original-docstring)))))

Implementation of [[metabase.util.malli/defn]]. Like [[schema.core/defn]], but for Malli.

Doesn't Malli already have a version of this in [[malli.experimental]]? It does, but it tends to eat memory; see https://metaboat.slack.com/archives/CKZEMT1MJ/p1690496060299339 and #32843 for more information. This new implementation solves most of our memory consumption problems.

Example macroexpansion:

(mu/defn f :- :int [x :- :int] (inc x))

;; =>

(def f (let [&f (fn [x] (inc x))] (fn ([a] (metabase.util.malli.fn/validate-input :int a) (->> (&f a) (metabase.util.malli.fn/validate-output :int))))))

Known issue: does not currently generate automatic type hints the way [[schema.core/defn]] does, nor does it attempt to preserve them if you specify them manually. We can fix this in the future.

(defmacro defn
  [& [fn-name :as fn-tail]]
  (let [parsed           (mu.fn/parse-fn-tail fn-tail)
        {attr-map :meta} parsed
        attr-map         (merge
                          {:arglists (list 'quote (deparameterized-arglists parsed))
                           :schema   (mu.fn/fn-schema parsed)}
                          attr-map)
        docstring        (annotated-docstring parsed)]
    `(def ~(vary-meta fn-name merge attr-map)
       ~docstring
       ~(macros/case
          :clj  (let [error-context {:fn-name (list 'quote (symbol (name (ns-name *ns*)) (name fn-name)))}]
                  (mu.fn/instrumented-fn-form error-context parsed))
          :cljs (mu.fn/deparameterized-fn-form parsed)))))
 

This is exactly the same as [[malli.experimental.describe]], but handles our deferred i18n forms.

(ns metabase.util.malli.describe
  (:require
   [clojure.string :as str]
   [malli.core :as mc]
   [malli.experimental.describe :as med]))

Given a schema, returns a string explaiaing the required shape in English

(defn describe
  ([?schema]
   (describe ?schema nil))
  ([?schema options]
   (let [options (merge options
                        {::mc/walk-entry-vals true
                         ::med/definitions    (atom {})
                         ::med/describe       med/-describe})]
     (str/trim (str (med/-describe ?schema options))))))

This is a fix for upstream issue https://github.com/metosin/malli/issues/924 (the generated descriptions for :min and :max were backwards). We can remove this when that issue is fixed upstream.

#?(:clj
   (defn- -length-suffix [schema]
     (let [{:keys [min max]} (-> schema mc/properties)]
       (cond
         (and min max) (str " with length between " min " and " max " inclusive")
         min           (str " with length >= " min)
         max           (str " with length <= " max)
         :else         ))))
#?(:clj
   (alter-var-root #'med/-length-suffix (constantly -length-suffix)))
 
(ns metabase.util.malli.fn
  (:refer-clojure :exclude [fn])
  (:require
   [clojure.core :as core]
   [malli.core :as mc]
   [malli.destructure :as md]
   [malli.error :as me]
   [metabase.config :as config]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util.log :as log]
   [metabase.util.malli.humanize :as mu.humanize]
   [metabase.util.malli.registry :as mr]))
(set! *warn-on-reflection* true)

Malli normally generates wacky default schemas when you use destructuring in an argslist; this never seems to work correctly, so just add default schemas manually to circumvent Malli's weird behavior.

(add-default-schemas '[x {:keys [y]}]) ;; => [x {:keys [y]} :- [:maybe :map]]

(defn- add-default-schemas
  [args]
  (if (empty? args)
    args
    (loop [acc [], [x & [y z :as more]] args]
      (let [schema (when (= y :-) z)
            more   (if schema
                     (drop 2 more)
                     more)
            schema (cond
                     schema
                     schema
                     (and (or (map? x)
                              (sequential? x))
                          (= (last acc) '&))
                     [:* :any]
                     (map? x)
                     [:maybe :map]
                     (sequential? x)
                     [:maybe [:sequential :any]])
            acc    (concat acc (if schema
                                 [x :- schema]
                                 [x]))]
        (if (seq more)
          (recur acc more)
          acc)))))

Given a fn arity as parsed by [[SchematizedParams]] an return-schema, return an appropriate :=> schema for the arity.

(defn- arity-schema
  [{:keys [args], :as _arity} return-schema]
  [:=>
   (:schema (md/parse (add-default-schemas args)))
   return-schema])

This is exactly the same as [[malli.experimental/SchematizedParams]], but it preserves metadata from the arglists.

(def ^:private SchematizedParams
  (mc/schema
   [:schema
    {:registry {"Schema"    any?
                "Separator" [:= :-]
                "Args"      vector? ; [:vector :any] loses metadata, but vector? keeps it :shrug:
                "PrePost"   [:map
                             [:pre {:optional true} [:sequential any?]]
                             [:post {:optional true} [:sequential any?]]]
                "Arity"     [:catn
                             [:args "Args"]
                             [:prepost [:? "PrePost"]]
                             [:body [:* :any]]]
                "Params"    [:catn
                             [:name symbol?]
                             [:return [:? [:catn
                                           [:- "Separator"]
                                           [:schema "Schema"]]]]
                             [:doc [:? string?]]
                             [:meta [:? :map]]
                             [:arities [:altn
                                        [:single "Arity"]
                                        [:multiple [:catn
                                                    [:arities [:+ [:schema "Arity"]]]
                                                    [:meta [:? :map]]]]]]]}}
    "Params"]))
(def ^:private ^{:arglists '([fn-tail])} parse-SchematizedParams
  (mc/parser SchematizedParams))

Parse a parameterized fn tail with the [[SchematizedParams]] schema. Throw an exception if it cannot be parsed.

(defn parse-fn-tail
  [fn-tail]
  (let [parsed (parse-SchematizedParams (if (symbol? (first fn-tail))
                                          fn-tail
                                          (cons '&f fn-tail)))]
    (when (= parsed ::mc/invalid)
      (let [error     (mc/explain SchematizedParams fn-tail)
            humanized (mu.humanize/humanize error)]
        (throw (ex-info (format "Invalid function tail: %s" humanized)
                        {:fn-tail   fn-tail
                         :error     error
                         :humanized humanized}))))
    parsed))

Implementation for [[fn]] and [[metabase.util.malli.defn/defn]]. Given an unparsed parametered fn tail, extract the annotations and return a :=> or :function schema.

(defn fn-schema
  [parsed]
  (let [{:keys [return arities]}     parsed
        return-schema                (:schema return :any)
        [arities-type arities-value] arities]
    (case arities-type
      :single   (arity-schema arities-value return-schema)
      :multiple (into [:function]
                      (for [arity (:arities arities-value)]
                        (arity-schema arity return-schema))))))
(defn- deparameterized-arity [{:keys [body args prepost], :as _arity}]
  (concat
   [(:arglist (md/parse args))]
   (when prepost
     [prepost])
   body))

Generate a deparameterized fn tail (the contents of a fn form after the fn symbol).

(defn deparameterized-fn-tail
  [{[arities-type arities-value] :arities, :as _parsed}]
  (let [body (case arities-type
               :single   (deparameterized-arity arities-value)
               :multiple (for [arity (:arities arities-value)]
                           (deparameterized-arity arity)))]
    body))

Impl for [[metabase.util.malli.fn/fn]] and [[metabase.util.malli.defn/defn]]. Given a parsed fn tail (as parsed by [[parsed-fn-tail]]), return a [[clojure.core.fn]] form with the parameters stripped out.

(deparameterized-fn-form (parse-fn-tail '[:- :int [x :- :int] (inc x)])) ;; => (fn [x] (inc x))

(defn deparameterized-fn-form
  [parsed]
  `(core/fn ~@(deparameterized-fn-tail parsed)))

Whether [[validate-input]] and [[validate-output]] should validate things or not. In Cljc code, you can use [[metabase.util.malli/disable-enforcement]] to bind this only in Clojure code.

(def ^:dynamic *enforce*
  true)
(defn- validate [error-context schema value error-type]
  (when *enforce*
    (when-let [error (mr/explain schema value)]
      (let [humanized (me/humanize error)
            details   (merge
                        {:type      error-type
                         :error     error
                         :humanized humanized
                         :schema    schema
                         :value     value}
                        error-context)]
        (if (or config/is-dev?
              config/is-test?)
          ;; In dev and test, throw an exception.
          (throw (ex-info (case error-type
                            ::invalid-input  (i18n/tru "Invalid input: {0}" (pr-str humanized))
                            ::invalid-output (i18n/tru "Invalid output: {0}" (pr-str humanized)))
                          details))
          ;; In prod, log a warning.
          (log/warn
            (case error-type
              ::invalid-input  (i18n/tru "Invalid input - Please report this as an issue on Github: {0}"
                                         (pr-str humanized))
              ::invalid-output (i18n/tru "Invalid output - Please report this as an issue on Github: {0}"
                                         (pr-str humanized)))
            details))))))

Impl for [[metabase.util.malli.fn/fn]]; validates an input argument with value against schema using a cached explainer and throws an exception if the check fails.

(defn validate-input
  [error-context schema value]
  (validate error-context schema value ::invalid-input))

Impl for [[metabase.util.malli.fn/fn]]; validates function output value against schema using a cached explainer and throws an exception if the check fails. Returns validated value.

(defn validate-output
  [error-context schema value]
  (validate error-context schema value ::invalid-output)
  value)
(defn- varargs-schema? [[_cat & args :as _input-schema]]
  (letfn [(star-schema? [schema]
            (and (sequential? schema)
                 (= (first schema) :*)))]
    (star-schema? (last args))))
(defn- input-schema-arg-names [[_cat & args :as input-schema]]
  (let [varargs?    (varargs-schema? input-schema)
        normal-args (if varargs?
                      (butlast args)
                      args)]
    (concat
     (for [n (range (count normal-args))]
       (symbol (str (char (+ (int \a) n)))))
     (when varargs?
       ['more]))))
(defn- input-schema->arglist [input-schema]
  (let [arg-names (input-schema-arg-names input-schema)]
    (vec (if (varargs-schema? input-schema)
           (concat (butlast arg-names) ['& (last arg-names)])
           arg-names))))
(defn- input-schema->validation-forms [error-context [_cat & schemas :as input-schema]]
  (let [arg-names (input-schema-arg-names input-schema)
        schemas   (if (varargs-schema? input-schema)
                    (concat (butlast schemas) [[:maybe (last schemas)]])
                    schemas)]
    (->> (map (core/fn [arg-name schema]
                ;; 1. Skip checks against `:any` schema, there is no situation where it would fail.
                ;;
                ;; 2. Skip checks against the default varargs schema, there is no situation where [:maybe [:* :any]] is
                ;; going to fail.
                (when-not (= schema (if (= arg-name 'more)
                                      [:maybe [:* :any]]
                                      :any))
                  `(validate-input ~error-context ~schema ~arg-name)))
              arg-names
              schemas)
         (filter some?))))
(defn- input-schema->application-form [input-schema]
  (let [arg-names (input-schema-arg-names input-schema)]
    (if (varargs-schema? input-schema)
      (list* `apply '&f arg-names)
      (list* '&f arg-names))))

If exception is thrown from the [[validate]] machinery, remove those stack trace elements so the top of the stack is the calling function.

(defn fixup-stacktrace
  [^Exception e]
  (if (#{::invalid-input ::invalid-output} (-> e ex-data :type))
    (let [trace (.getStackTrace e)
          cleaned (when trace
                    (into-array StackTraceElement
                                (drop-while (comp #{(.getName (class validate))
                                                    (.getName (class validate-input))
                                                    (.getName (class validate-output))}
                                                  #(.getClassName ^StackTraceElement %))
                                            trace)))]
      (doto e
        (.setStackTrace cleaned)))
    e))
(defn- instrumented-arity [error-context [_=> input-schema output-schema]]
  (let [input-schema           (if (= input-schema :cat)
                                 [:cat]
                                 input-schema)
        arglist                (input-schema->arglist input-schema)
        input-validation-forms (input-schema->validation-forms error-context input-schema)
        result-form            (input-schema->application-form input-schema)
        result-form            (if (and output-schema
                                        (not= output-schema :any))
                                 `(->> ~result-form
                                       (validate-output ~error-context ~output-schema))
                                 result-form)]
    `(~arglist
      (try
        ~@input-validation-forms
        ~result-form
        (catch Exception ~'error
          (throw (fixup-stacktrace ~'error)))))))
(defn- instrumented-fn-tail [error-context [schema-type :as schema]]
  (case schema-type
    :=>
    [(instrumented-arity error-context schema)]
    :function
    (let [[_function & schemas] schema]
      (for [schema schemas]
        (instrumented-arity error-context schema)))))

Given a fn-tail like

([x :- :int y] (+ 1 2))

and parsed by [[parsed-fn-tail]],

return an unevaluated instrumented [[fn]] form like

(mc/-instrument {:schema [:=> [:cat :int :any] :any]} (fn [x y] (+ 1 2)))

(defn instrumented-fn-form
  [error-context parsed]
  `(let [~'&f ~(deparameterized-fn-form parsed)]
     (core/fn ~@(instrumented-fn-tail error-context (fn-schema parsed)))))

Malli version of [[schema.core/fn]]. A form like

(fn :- :int [x :- :int] (inc x))

compiles to something like

(let [&f (fn [x] (inc x))] (fn [a] (validate-input {} :int a) (validate-output {} :int (&f a))))

The map arg here is additional error context; for something like [[metabase.util.malli/defn]], it will be something like

{:fn-name 'metabase.lib.field/resolve-field-id}

for [[metabase.util.malli/defmethod]] it will be something like

{:fn-name 'whatever/my-multimethod, :dispatch-value :field}

Known issue: this version of fn does not capture the optional function name and make it available, e.g. you can't do

(mu/fn my-fn ([x] (my-fn x 1)) ([x y :- :int] (+ x y)))

If we were to include my-fn in the uninstrumented fn form, then it would bypass schema checks when you call another arity:

(let [&f (fn my-fn ([x] (my-fn x 1)) ([x y] (+ x y)))] (fn ([a] (&f a)) ([a b] (validate-input {} :int b) (&f a b))))

;; skips the :- :int check on y in the 2-arity (my-fn 1.0) ;; => 2.0

Since this is a big gotcha, we are currently not including the optional function name my-fn in the generated output. We can probably fix this with [[letfn]], since it allows mutually recursive function calls, but that's a problem for another day. The passed function name comes back from [[mc/parse]] as :name if we want to attempt to fix this later.

(defmacro fn
  [& fn-tail]
  (let [error-context (if (symbol? (first fn-tail))
                        {:fn-name (list 'quote (first fn-tail))}
                        {})]
    (instrumented-fn-form error-context (parse-fn-tail fn-tail))))
 
(ns metabase.util.malli.humanize
  (:require
   [malli.error :as me]))

This is the same behavior as what [[malli.error/humanize]] does to resolve errors.

(defn- resolve-error
  [explanation error]
  (me/-resolve-direct-error explanation error {:wrap :message, :resolve me/-resolve-direct-error}))

Given a [path message] pair like

[[2] "some error"]

return a flattened error message like

[nil nil "some error"]

(defn- flatten-error
  [[path message]]
  (if (empty? path)
    message
    (recur
     [(butlast path)
      (if (integer? (last path))
        (me/-push [] (last path) message nil)
        {(last path) message})])))

Merge two flattened errors into a single error, e.g.

(merge-errors {:x "oops"} {:x "oh no"}) ;; => {:x ("oops" "oh no")}

List-like structures are used to differentiate multiple errors (e.g., the result of an :or schema) from single errors (which use a vector instead).

(defn- merge-errors
  [msg-1 msg-2]
  (cond
    (= msg-1 msg-2)
    msg-1
    (nil? msg-1)
    msg-2
    (seq? msg-1)
    (distinct (concat msg-1 (if (seq? msg-2) msg-2 [msg-2])))
    (and (map? msg-1)
         (map? msg-2))
    (merge-with merge-errors msg-1 msg-2)
    (and (vector? msg-1)
         (vector? msg-2)
         (= (count msg-1) (count msg-2)))
    (mapv merge-errors msg-1 msg-2)
    :else
    (distinct (list msg-1 msg-2))))

Improved version of [[malli.error/humanize]]. This is mostly similar to vanilla [[malli.error/humanize]], but combines 'resolved' errors in a different way that avoids discarding errors in :or schemas when they occur at different levels of nesting (see [[metabase.util.malli.humanize-test/basic-test]] or [[metabase.util.malli.humanize-test/basic-test-2]] for example) and eliminates duplicates.

(defn humanize
  [{:keys [errors], :as explanation}]
  (transduce
   (comp (map (fn [error]
                (resolve-error explanation error)))
         (map flatten-error))
   (completing merge-errors)
   nil
   errors))
 

TODO: Consider refacor this namespace by defining custom schema with [[mr/def]] instead.

For example the PositiveInt can be defined as (mr/def ::positive-int pos-int?)

(ns metabase.util.malli.schema
  (:require
   [cheshire.core :as json]
   [malli.core :as mc]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.schema :as mbql.s]
   [metabase.models.dispatch :as models.dispatch]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date]
   [metabase.util.i18n :as i18n :refer [deferred-tru]]
   [metabase.util.malli :as mu]
   [metabase.util.password :as u.password]))
(set! *warn-on-reflection* true)

-------------------------------------------------- Utils --------------------------------------------------

Helper for creating a schema to check whether something is an instance of model.

(ms/defn my-fn [user :- (ms/InstanceOf User)] ...)

TODO -- consider renaming this to InstanceOfModel to differentiate it from [[InstanceOfClass]]

(defn InstanceOf
  [model]
  (mu/with-api-error-message
    [:fn
     {:error/message (format "value must be an instance of %s" (name model))}
     #(models.dispatch/instance-of? model %)]
    (deferred-tru "value must be an instance of {0}" (name model))))

Helper for creating schemas to check whether something is an instance of a given class.

(defn InstanceOfClass
  [^Class klass]
  [:fn
   {:error/message (format "Instance of a %s" (.getCanonicalName klass))}
   (partial instance? klass)])

Given a schema of a sequence of maps, returns a schema that does an additional unique check on key k.

(defn maps-with-unique-key
  [maps-schema k]
  (mu/with-api-error-message
    [:and
     [:fn (fn [maps]
            (= (count maps)
               (-> (map #(get % k) maps)
                   distinct
                   count)))]
     maps-schema]
    (deferred-tru "value must be seq of maps in which {0}s are unique" (name k))))

-------------------------------------------------- Schemas --------------------------------------------------

Schema for a string that cannot be blank.

TODO -- this does not actually ensure that the string cannot be BLANK at all!

(def NonBlankString
  (mu/with-api-error-message ::lib.schema.common/non-blank-string (deferred-tru "value must be a non-blank string.")))

Schema representing an integer than must also be greater than or equal to zero.

(def IntGreaterThanOrEqualToZero
  (mu/with-api-error-message
    [:int {:min 0}]
    ;; FIXME: greater than _or equal to_ zero.
    (deferred-tru "value must be an integer greater than zero.")))

Schema representing an integer.

(def Int
  (mu/with-api-error-message
    int?
    (deferred-tru "value must be an integer.")))

Schema representing an integer than must also be greater than zero.

(def PositiveInt
  (mu/with-api-error-message
    pos-int?
    (deferred-tru "value must be an integer greater than zero.")))

Schema representing an integer than must be less than zero.

(def NegativeInt
  (mu/with-api-error-message
    neg?
    (deferred-tru "value must be a negative integer")))

Schema representing a numeric value greater than zero. This allows floating point numbers and integers.

(def PositiveNum
  (mu/with-api-error-message
    [:and number? pos?]
    (deferred-tru "value must be a number greater than zero.")))

Schema for something that can be either a Keyword or a String.

(def KeywordOrString
  (mu/with-api-error-message
    [:or :string :keyword]
    (deferred-tru "value must be a keyword or string.")))

Schema for a valid Field base or effective (data) type (does it derive from :type/*)?

(def FieldType
  (mu/with-api-error-message
    [:fn #(isa? % :type/*)]
    (deferred-tru "value must be a valid field type.")))

Schema for a valid Field semantic type deriving from :Semantic/*.

(def FieldSemanticType
  (mu/with-api-error-message
    [:fn #(isa? % :Semantic/*)]
    (deferred-tru "value must be a valid field semantic type.")))

Schema for a valid Field relation type deriving from :Relation/*

(def FieldRelationType
  (mu/with-api-error-message
    [:fn #(isa? % :Relation/*)]
    (deferred-tru "value must be a valid field relation type.")))

Schema for a valid Field semantic or Relation type. This is currently needed because the semantic_column is used to store either the semantic type or relation type info. When this is changed in the future we can get rid of this schema. See #15486.

(def FieldSemanticOrRelationType
  (mu/with-api-error-message
    [:fn (fn [k] (or (isa? k :Semantic/*) (isa? k :Relation/*)))]
    (deferred-tru "value must be a valid field semantic or relation type.")))

Schema for a valid Field coercion strategy (does it derive from :Coercion/*)?

(def CoercionStrategy
  (mu/with-api-error-message
    [:fn #(isa? % :Coercion/*)]
    (deferred-tru "value must be a valid coercion strategy.")))

Like FieldType (e.g. a valid derivative of :type/*) but allows either a keyword or a string. This is useful especially for validating API input or objects coming out of the DB as it is unlikely those values will be encoded as keywords at that point.

(def FieldTypeKeywordOrString
  (mu/with-api-error-message
    [:fn #(isa? (keyword %) :type/*)]
    (deferred-tru "value must be a valid field data type (keyword or string).")))

Like FieldSemanticType but accepts either a keyword or string.

(def FieldSemanticTypeKeywordOrString
  (mu/with-api-error-message
    [:fn #(isa? (keyword %) :Semantic/*)]
    (deferred-tru "value must be a valid field semantic type (keyword or string).")))

Like FieldRelationType but accepts either a keyword or string.

(def FieldRelationTypeKeywordOrString
  (mu/with-api-error-message
    [:fn #(isa? (keyword %) :Relation/*)]
    (deferred-tru "value must be a valid field relation type (keyword or string).")))

Like FieldSemanticOrRelationType but accepts either a keyword or string.

(def FieldSemanticOrRelationTypeKeywordOrString
  (mu/with-api-error-message
    [:fn (fn [k]
           (let [k (keyword k)]
             (or (isa? k :Semantic/*)
                 (isa? k :Relation/*))))]
    (deferred-tru "value must be a valid field semantic or relation type (keyword or string).")))

Schema for a valid Field for API usage.

(def Field
  (mu/with-api-error-message
    [:fn (fn [k]
           ((comp (mc/validator mbql.s/Field)
                  mbql.normalize/normalize-tokens) k))]
    (deferred-tru "value must an array with :field id-or-name and an options map")))

Like CoercionStrategy but accepts either a keyword or string.

(def CoercionStrategyKeywordOrString
  (mu/with-api-error-message
    [:fn #(isa? (keyword %) :Coercion/*)]
    (deferred-tru "value must be a valid coercion strategy (keyword or string).")))

Validates entity type derivatives of :entity/*. Allows strings or keywords

(def EntityTypeKeywordOrString
  (mu/with-api-error-message
    [:fn #(isa? (keyword %) :entity/*)]
    (deferred-tru "value must be a valid entity type (keyword or string).")))

Schema for a valid map.

(def Map
  (mu/with-api-error-message
    :map
    (deferred-tru "Value must be a map.")))

Schema for a valid email string.

(def Email
  (mu/with-api-error-message
    [:and
     :string
     [:fn u/email?]]
    (deferred-tru "value must be a valid email address.")))

Schema for a valid password of sufficient complexity which is not found on a common password list.

(def ValidPassword
  (mu/with-api-error-message
    [:and
     :string
     [:fn (every-pred string? #'u.password/is-valid?)]]
    (deferred-tru "password is too common.")))

Schema for a string that can be parsed as an integer. Something that adheres to this schema is guaranteed to to work with Integer/parseInt.

(def IntString
  (mu/with-api-error-message
    [:and
     :string
     [:fn #(u/ignore-exceptions (Integer/parseInt %))]]
    (deferred-tru "value must be a valid integer.")))

Schema for a string that can be parsed as an integer, and is greater than zero. Something that adheres to this schema is guaranteed to to work with Integer/parseInt.

(def IntStringGreaterThanZero
  (mu/with-api-error-message
    [:and
     :string
     [:fn #(u/ignore-exceptions (< 0 (Integer/parseInt %)))]]
    (deferred-tru "value must be a valid integer greater than zero.")))

Schema for a string that can be parsed as an integer, and is greater than or equal to zero. Something that adheres to this schema is guaranteed to to work with Integer/parseInt.

(def IntStringGreaterThanOrEqualToZero
  (mu/with-api-error-message
    [:and
     :string
     [:fn #(u/ignore-exceptions (<= 0 (Integer/parseInt %)))]]
    (deferred-tru "value must be a valid integer greater than or equal to zero.")))

Schema for a string that is a valid representation of a boolean (either true or false). Defendpoint uses this to coerce the value for this schema to a boolean.

(def BooleanString
  (mu/with-api-error-message
    [:enum "true" "false" "TRUE" "FALSE"]
    (deferred-tru "value must be a valid boolean string (''true'' or ''false'').")))

Schema for a string that can be parsed by date2/parse.

(def TemporalString
  (mu/with-api-error-message
    [:and
     :string
     [:fn #(u/ignore-exceptions (boolean (u.date/parse %)))]]
    (deferred-tru "value must be a valid date string")))

Schema for a string that is valid serialized JSON.

(def JSONString
  (mu/with-api-error-message
    [:and
     :string
     [:fn #(try
             (json/parse-string %)
             true
             (catch Throwable _
               false))]]
    (deferred-tru "value must be a valid JSON string.")))
(def ^:private keyword-or-non-blank-str-malli
  (mc/schema
    [:or :keyword NonBlankString]))

Schema for a valid representation of a boolean (one of "true" or true or "false" or false.). Used by [[metabase.api.common/defendpoint]] to coerce the value for this schema to a boolean. Garanteed to evaluate to true or false when passed through a json decoder.

(def BooleanValue
  (-> [:enum {:decode/json (fn [b] (contains? #{"true" true} b))}
       "true" "false" true false]
      (mu/with-api-error-message
        (deferred-tru "value must be a valid boolean string (''true'' or ''false'')."))))

Schema for valid source_options within a Parameter

(def ValuesSourceConfig
  ;; TODO: This should be tighter
  (mc/schema
    [:map
     [:values {:optional true} [:* :any]]
     [:card_id {:optional true} PositiveInt]
     [:value_field {:optional true} Field]
     [:label_field {:optional true} Field]]))

Has two components: 1. (can be anything) 2. (must be a string)

(def RemappedFieldValue
  [:tuple :any :string])

Has one component:

(def NonRemappedFieldValue
  [:tuple :any])

Schema for a valid list of values for a field, in contexts where the field can have a remapped field.

(def FieldValuesList
  [:or
   [:sequential RemappedFieldValue]
   [:sequential NonRemappedFieldValue]])

Schema for a value result of fetching the values for a field, in contexts where the field can have a remapped field.

(def FieldValuesResult
  [:map
   [:has_more_values :boolean]
   [:values FieldValuesList]])

Schema for a valid Parameter. We're not using [metabase.mbql.schema/Parameter] here because this Parameter is meant to be used for Parameters we store on dashboard/card, and it has some difference with Parameter in MBQL.

#_(def ParameterSource
      (mc/schema
        [:multi {:dispatch :values_source_type}
         ["card"        [:map
                         [:values_source_type :string]
                         [:values_source_config
                          [:map {:closed true}
                           [:card_id {:optional true} IntGreaterThanZero]
                           [:value_field {:optional true} Field]
                           [:label_field {:optional true} Field]]]]]
         ["static-list" [:map
                         [:values_source_type :string]
                         [:values_source_config
                          [:map {:closed true}
                           [:values {:optional true} [:* :any]]]]]]]))
(def Parameter
  ;; TODO we could use :multi to dispatch values_source_type to the correct values_source_config
  (mu/with-api-error-message
    [:map [:id NonBlankString]
     [:type keyword-or-non-blank-str-malli]
     ;; TODO how to merge this with ParameterSource above?
     [:values_source_type {:optional true} [:enum "static-list" "card" nil]]
     [:values_source_config {:optional true} ValuesSourceConfig]
     [:slug {:optional true} :string]
     [:name {:optional true} :string]
     [:default {:optional true} :any]
     [:sectionId {:optional true} NonBlankString]]
    (deferred-tru "parameter must be a map with :id and :type keys")))

Schema for a valid Parameter Mapping

(def ParameterMapping
  (mu/with-api-error-message
    [:map [:parameter_id NonBlankString]
     [:target :any]
     [:card_id {:optional true} PositiveInt]]
    (deferred-tru "parameter_mapping must be a map with :parameter_id and :target keys")))

Schema for a valid map of embedding params.

(def EmbeddingParams
  (mu/with-api-error-message
    [:maybe [:map-of
             :keyword
             [:enum "disabled" "enabled" "locked"]]]
    (deferred-tru "value must be a valid embedding params map.")))

Schema for a valid ISO Locale code e.g. en or en-US. Case-insensitive and allows dashes or underscores.

(def ValidLocale
  (mu/with-api-error-message
    [:and
     NonBlankString
     [:fn i18n/available-locale?]]
    (deferred-tru "String must be a valid two-letter ISO language or language-country code e.g. 'en' or 'en_US'.")))

Schema for a 21-character NanoID string, like "FReCLx5hSWTBU7kjCWfuu".

(def NanoIdString
  (mu/with-api-error-message
    [:re #"^[A-Za-z0-9_\-]{21}$"]
    (deferred-tru "String must be a valid 21-character NanoID string.")))

Schema for a UUID string

(def UUIDString
  (mu/with-api-error-message
   [:re u/uuid-regex]
   (deferred-tru "value must be a valid UUID.")))
 
(ns metabase.util.memoize
  (:require
   [clojure.core.memoize :as memoize]
   [metabase.shared.util.namespaces :as shared.ns]))
(comment
  memoize/keep-me)
(shared.ns/import-fns
 [memoize
  lru
  memoizer])
 

Copied from clojure.core.memoize.

(ns metabase.util.memoize
  (:require [cljs.cache :as cache]))

Similar to clojure.lang.Delay, but will not memoize an exception and will instead retry. fun - the function, never nil available? - indicates a memoized value is available, volatile for visibility value - the value (if available) - volatile for visibility

(deftype RetryingDelay [fun ^:volatile-mutable available? ^:volatile-mutable value]
  IDeref
  (-deref [_]
    ;; first check (safe with volatile flag)
    (if available?
      value
      ;; fun may throw - will retry on next deref
      (let [v (fun)]
        (set! value v)
        (set! available? true)
        v)))
  IPending
  (-realized? [_]
    available?))
(defn- d-lay [fun]
  (->RetryingDelay fun false nil))

If a value is not already derefable, wrap it up.

This is used to help rebuild seed/base maps passed in to the various caches so that they conform to core.memoize's world view.

(defn- make-derefable
  [v]
  (if (instance? IDeref v)
    v
    (reify IDeref
      (-deref [_] v))))

Given a seed/base map, ensure all the values in it are derefable.

(defn- derefable-seed
  [seed]
  (update-vals seed make-derefable))
(deftype PluggableMemoization [f cache]
  cache/CacheProtocol
  (has? [_ item]
    (cache/has? cache item))
  (hit  [_ item]
    (PluggableMemoization. f (cache/hit cache item)))
  (miss [_ item result]
    (PluggableMemoization. f (cache/miss cache item result)))
  (evict [_ key]
    (PluggableMemoization. f (cache/evict cache key)))
  (lookup [_ item]
    (cache/lookup cache item nil))
  (lookup [_ item not-found]
    (cache/lookup cache item (delay not-found)))
  (seed [_ base]
    (PluggableMemoization.
     f (cache/seed cache (derefable-seed base))))
  Object
  (toString [_] (str cache)))

Returns a function's argument transformer.

(def ^{:private true
       :doc }
  args-fn #(or (::args-fn (meta %)) identity))

The basic hit/miss logic for the cache system based on cache/through. Clojure delays are used to hold the cache value.

(defn- through*
  [cache f args item]
  (cache/through
   (fn [f _] (d-lay #(f args)))
   #(apply f %)
   cache
   item))

Given a function, an atom containing a (pluggable memoization cache), and and cache key function, return a new function that behaves like the original function except it is cached, based on its arguments.

(defn- cached-function
  [f cache-atom ckey-fn]
  (fn [& args]
    (let [ckey (or (ckey-fn args) [])
          cs   (swap! cache-atom through* f args ckey)
          val  (cache/lookup cs ckey ::not-found)]
       ;; If `lookup` returns `(delay ::not-found)`, it's likely that
       ;; we ran into a timing issue where eviction and access
       ;; are happening at about the same time. Therefore, we retry
       ;; the `swap!` (potentially several times).
       ;;
       ;; metabase.util.memoize currently wraps all of its values in a `delay`.
      (when val
        (loop [n 0 v @val]
          (if (= ::not-found v)
            (when-let [v' (cache/lookup
                           (swap! cache-atom through* f args ckey)
                           ckey ::not-found)]
              (when (< n 10)
                (recur (inc n) @v')))
            v))))))

Build a pluggable memoized version of a function. Given a function and a (pluggable memoized) cache, and an optional seed (hash map of arguments to return values), return a cached version of that function.

If you want to build your own cached function, perhaps with combined caches or customized caches, this is the preferred way to do so now.

(defn memoizer
  ([f cache]
   (let [cache   (atom (PluggableMemoization. f cache))
         ckey-fn (args-fn f)]
     (cached-function f cache ckey-fn)))
  ([f cache seed]
   (let [cache   (atom (cache/seed (PluggableMemoization. f cache)
                                   (derefable-seed seed)))
         ckey-fn (args-fn f)]
     (cached-function f cache ckey-fn))))

Works the same as the basic memoization function (i.e. core.memoize except when a given threshold is breached. When the threshold is passed, the cache will expel the Least Recently Used element in favor of the new.

(defn lru
  ([f] (lru f {} :lru/threshold 32))
  ([f base] (lru f base :lru/threshold 32))
  ([f tkey threshold] (lru f {} tkey threshold))
  ([f base key threshold]
   (assert (= key :lru/threshold) (str "wrong parameter key " key))
   (memoizer f (cache/lru-cache-factory {} :threshold threshold) base)))
 
(ns metabase.util.methodical.null-cache
  (:require
   [methodical.interface])
  (:import
   (methodical.interface Cache)))
(set! *warn-on-reflection* true)
(comment methodical.interface/keep-me)
(declare null-cache)
(deftype ^:private NullCache []
  Cache
  (cached-method [_cache _dispatch-value] nil)
  (cache-method! [_cache _dispatch-value _method] nil)
  (clear-cache! [_cache] nil)
  (empty-copy [_cache] (null-cache)))

A cache implementation that doesn't actually cache anything. To work around upstream bug https://github.com/camsaul/methodical/issues/98

(defn null-cache
  []
  (->NullCache))
 

Workaround for upstream issue https://github.com/camsaul/methodical/issues/97

Actually a bit of a misnomer since this does still sort dispatch values; it just doesn't complain if any are ambiguous.

(ns metabase.util.methodical.unsorted-dispatcher
  (:require
   [methodical.impl.dispatcher.standard]
   [methodical.interface])
  (:import
   (methodical.interface Dispatcher)))
(set! *warn-on-reflection* true)
(comment methodical.interface/keep-me)
(deftype UnsortedDispatcher [dispatch-fn hierarchy-var default-value]
  Dispatcher
  (dispatch-value [_]              (dispatch-fn))
  (dispatch-value [_ a]            (dispatch-fn a))
  (dispatch-value [_ a b]          (dispatch-fn a b))
  (dispatch-value [_ a b c]        (dispatch-fn a b c))
  (dispatch-value [_ a b c d]      (dispatch-fn a b c d))
  (dispatch-value [_ a b c d more] (apply dispatch-fn a b c d more))
  (matching-primary-methods [_this method-table dispatch-value]
    (methodical.impl.dispatcher.standard/matching-primary-methods
     {:hierarchy      (deref hierarchy-var)
      :default-value  default-value
      :method-table   method-table
      :dispatch-value dispatch-value
      :ambiguous-fn   (constantly false)}))
  (matching-aux-methods [_this method-table dispatch-value]
    (methodical.impl.dispatcher.standard/matching-aux-methods
     {:hierarchy      (deref hierarchy-var)
      :default-value  default-value
      :method-table   method-table
      :dispatch-value dispatch-value
      :ambiguous-fn   (constantly false)}))
  (default-dispatch-value [_this]
    default-value)
  (prefers [_]
    nil)
  (with-prefers [this new-prefs]
    (when (seq new-prefs)
      (throw (UnsupportedOperationException. (format "%s does not support preferences." `unsupported-dispatcher))))
    this)
  (dominates? [_this _x _y]
    false))

This is basically similar the same as the [[methodical.core/standard-dispatcher]], but doesn't complain when dispatch values are ambiguous, and doesn't support preferences.

(defn unsorted-dispatcher
  [dispatch-fn & {:keys [hierarchy default-value]
                  :or   {hierarchy     #'clojure.core/global-hierarchy
                         default-value :default}}]
  {:pre [(ifn? dispatch-fn) (instance? clojure.lang.IDeref hierarchy)]}
  (->UnsortedDispatcher dispatch-fn hierarchy default-value))
 

Utility functions for checking passwords against hashes and for making sure passwords match complexity requirements.

(ns metabase.util.password
  (:require
   [clojure.java.io :as io]
   [metabase.config :as config]
   [metabase.util :as u])
  (:import
   (org.mindrot.jbcrypt BCrypt)))
(set! *warn-on-reflection* true)

Return a map of the counts of each class of character for password.

(count-occurrences "GoodPw!!") -> {:total 8, :lower 4, :upper 2, :letter 6, :digit 0, :special 2}

(defn- count-occurrences
  [password]
  (loop [[^Character c & more] password, counts {:total 0, :lower 0, :upper 0, :letter 0, :digit 0, :special 0}]
    (if-not c
      counts
      (recur more (let [counts (update counts :total inc)]
                    (cond
                      (Character/isLowerCase c) (-> (update counts :letter inc) (update :lower inc))
                      (Character/isUpperCase c) (-> (update counts :letter inc) (update :upper inc))
                      (Character/isDigit     c) (update counts :digit   inc)
                      :else                     (update counts :special inc)))))))

Minimum counts of each class of character a password should have for a given password complexity level.

(def ^:private ^:const complexity->char-type->min
  {:weak   {:total   6} ; total here effectively means the same thing as a minimum password length
   :normal {:total   6
            :digit   1}
   :strong {:total   8
            :lower   2
            :upper   2
            :digit   1
            :special 1}})

Check that PASSWORD satisfies the minimum count requirements for each character class.

(password-has-char-counts? {:total 6, :lower 1, :upper 1, :digit 1, :special 1} "abc") -> false (password-has-char-counts? {:total 6, :lower 1, :upper 1, :digit 1, :special 1} "passworD1!") -> true

(defn- password-has-char-counts?
  [char-type->min password]
  {:pre [(map? char-type->min)
         (string? password)]}
  (let [occurences (count-occurrences password)]
    (boolean (loop [[[char-type min-count] & more] (seq char-type->min)]
               (if-not char-type true
                 (when (>= (occurences char-type) min-count)
                   (recur more)))))))

The currently configured description of the password complexity rules being enforced

(defn active-password-complexity
  []
  (merge (complexity->char-type->min (config/config-kw :mb-password-complexity))
         ;; Setting MB_PASSWORD_LENGTH overrides the default :total for a given password complexity class
         (when-let [min-len (config/config-int :mb-password-length)]
           {:total min-len})))

Check if a given password meets complexity standards for the application.

(defn- is-complex?
  [password]
  (password-has-char-counts? (active-password-complexity) password))

A set of ~12k common passwords to reject, that otherwise meet Metabase's default complexity requirements. Sourced from Dropbox's zxcvbn repo: https://github.com/dropbox/zxcvbn/blob/master/data/passwords.txt

(def ^java.net.URL common-passwords-url
  (io/resource "common_passwords.txt"))

Check if a given password is not present in the common passwords set. Case-insensitive search since the list only contains lower-case passwords.

(defn- is-uncommon?
  [password]
  (with-open [is (.openStream common-passwords-url)
              reader (java.io.BufferedReader. (java.io.InputStreamReader. is))]
    (not-any?
      (partial = (u/lower-case-en password))
      (iterator-seq (.. reader lines iterator)))))

Check that a password both meets complexity standards, and is not present in the common passwords list. Common password list is ignored if minimum password complexity is set to :weak

(defn is-valid?
  [password]
  (and (is-complex? password)
       (or (= (config/config-kw :mb-password-complexity) :weak)
           (is-uncommon? password))))

Hashes a given plaintext password using bcrypt and an optional :work-factor (defaults to 10 as of this writing). Should be used to hash passwords included in stored user credentials that are to be later verified using bcrypt-credential-fn.

copied from cemerick.friend.credentials EPL v1.0 license

(defn hash-bcrypt
  [password & {:keys [work-factor]}]
  (BCrypt/hashpw password (if work-factor
                            (BCrypt/gensalt work-factor)
                            (BCrypt/gensalt))))

Returns true if the plaintext [password] corresponds to [hash], the result of previously hashing that password.

(defn bcrypt-verify
  [password hash]
  (BCrypt/checkpw password hash))

Verify if a given unhashed password + salt matches the supplied hashed-password. Returns true if matched, false otherwise.

(defn verify-password
  ^Boolean [password salt hashed-password]
  ;; we wrap the friend/bcrypt-verify with this function specifically to avoid unintended exceptions getting out
  (boolean (u/ignore-exceptions
             (bcrypt-verify (str salt password) hashed-password))))
 

Regex-related utility functions

(ns metabase.util.regex
  (:require
   [clojure.string :as str]))

Wrap regex pattern in a non-capturing group.

(defn non-capturing-group
  [pattern]
  (re-pattern (format "(?:%s)" pattern)))

Combine regex patterns into a single pattern by joining with or (i.e., a logical disjunction).

(defn re-or
  [patterns]
  (non-capturing-group (str/join "|" (map non-capturing-group patterns))))

Make regex pattern optional.

(defn re-optional
  [pattern]
  (str (non-capturing-group pattern) "?"))

Make regex pattern negated.

(defn re-negate
  [pattern]
  (str "(?!" pattern ")"))
(defmulti ^:private rx-dispatch
  {:arglists '([listt])}
  first)
(declare rx*)
(defmethod rx-dispatch :default [x] x)
(defmethod rx-dispatch :?
  [[_ & args]]
  (re-optional (rx* (into [:and] args))))
(defmethod rx-dispatch :or
  [[_ & args]]
  (re-or (map rx* args)))
(defmethod rx-dispatch :and
  [[_ & args]]
  (apply str (map rx* args)))
(defmethod rx-dispatch :not
  [[_ arg]]
  (re-negate (rx* arg)))
(defn- rx*
  [x]
  (if (seqable? x) (rx-dispatch x) x))

A quick-and-dirty port of the Emacs Lisp rx macro (C-h f rx) implemented as a function but not currently as fully-featured. Convenient for building mega-huge regular expressions from a hiccup-like representation. Feel free to add support for more stuff as needed.

 This is memoized because arguments to rx are less optimal than they should be, in favor of better clarity -- hence skipping recompilation makes sense.

TODO -- instead of memoizing this, why not just do this as a macro and do it at macroexpansion time? Weird.

(def ^{:doc
       :arglists '([x] [x & more])
       } rx
  (memoize (fn  rx
             ;; (rx [:and [:or "Cam" "can"] [:? #"\s+"] #"\d+"])
             ;; -> #\"(?:(?:Cam)|(?:can))(?:\s+)?\d+\"
             ([x] (re-pattern (rx* x)))
             ([x & more] (rx (into [:and x] more))))))
 

Support for in-memory, thread-blocking retrying.

(ns metabase.util.retry
  (:import
   (io.github.resilience4j.core IntervalFunction)
   (io.github.resilience4j.retry Retry RetryConfig)
   (java.util.function Predicate)))
(set! *warn-on-reflection* true)
(defn- make-predicate [f]
  (reify Predicate (test [_ x] (f x))))

Returns a randomized exponential backoff retry named retry-name configured according the options in the second parameter.

(defn random-exponential-backoff-retry
  ^Retry [^String retry-name
          {:keys [^long max-attempts ^long initial-interval-millis
                  ^double multiplier ^double randomization-factor
                  ^long max-interval-millis
                  retry-on-result-pred retry-on-exception-pred]
           :or {max-attempts 3
                initial-interval-millis 500
                multiplier 1.5
                randomization-factor 0.5
                max-interval-millis Long/MAX_VALUE}}]
  (let [interval-fn (IntervalFunction/ofExponentialRandomBackoff
                     initial-interval-millis multiplier
                     randomization-factor max-interval-millis)
        base-config (-> (RetryConfig/custom)
                        (.maxAttempts max-attempts)
                        (.intervalFunction interval-fn))
        retry-config (cond-> base-config
                       retry-on-result-pred
                       (.retryOnResult (make-predicate retry-on-result-pred))
                       retry-on-exception-pred
                       (.retryOnException (make-predicate retry-on-exception-pred)))]
    (Retry/of retry-name (.build retry-config))))

Returns a function accepting the same arguments as f but retrying on error as specified by retry. The calling thread is blocked during the retries.

(defn decorate
  [f ^Retry retry]
  (fn [& args]
    (let [callable (reify Callable (call [_] (apply f args)))]
      (.call (Retry/decorateCallable retry callable)))))
 

Various schemas that are useful throughout the app.

Schemas defined are deprecated and should be replaced with Malli schema defined in [[metabase.util.malli.schema]]. If you update schemas in this ns, please make sure you update the malli schema too. It'll help us makes the transition easier.

(ns ^{:deprecated "0.46.0"}
 metabase.util.schema
  (:require
   [clojure.string :as str]
   [metabase.types :as types]
   [metabase.util.i18n :as i18n :refer [deferred-tru]]
   [schema.core :as s]
   [schema.macros :as s.macros]
   [schema.utils :as s.utils]))
(set! *warn-on-reflection* true)

So the :type/ hierarchy is loaded.

(comment types/keep-me)

always validate all schemas in s/defn function declarations. See https://github.com/plumatic/schema#schemas-in-practice for details.

(s/set-fn-validation! true)

swap out the default impl of schema.core/validator with one that does not barf out the entire schema, since it's way too huge with things like our MBQL query schema

(defn- schema-core-validator [schema]
  (let [c (s/checker schema)]
    (fn [value]
      (when-let [error (c value)]
        (s.macros/error! (s.utils/format* "Value does not match schema: %s" (pr-str error))
                         {:value value, :error error}))
      value)))
(alter-var-root #'s/validator (constantly schema-core-validator))

+----------------------------------------------------------------------------------------------------------------+ | Plumatic API Schema Validation & Error Messages | +----------------------------------------------------------------------------------------------------------------+

Return schema with an additional api-error-message that will be used to explain the error if a parameter fails validation.

(defn with-api-error-message
  {:style/indent [:form]}
  [schema api-error-message]
  (if-not (record? schema)
    ;; since this only works for record types, if `schema` isn't already one just wrap it in `s/named` to make it one
    (recur (s/named schema api-error-message) api-error-message)
    (assoc schema :api-error-message api-error-message)))

Add an addditonal constraint to schema (presumably an array) that requires it to be non-empty (i.e., it must satisfy seq).

(defn non-empty
  [schema]
  (with-api-error-message (s/constrained schema seq "Non-empty")
    (deferred-tru "The array cannot be empty.")))

+----------------------------------------------------------------------------------------------------------------+ | USEFUL SCHEMAS | +----------------------------------------------------------------------------------------------------------------+

Schema for a string that cannot be blank.

(def NonBlankString
  (with-api-error-message (s/constrained s/Str (complement str/blank?) "Non-blank string")
    (deferred-tru "value must be a non-blank string.")))

Schema representing an integer than must also be greater than zero.

TODO - rename this to PositiveInt?

(def IntGreaterThanZero
  (with-api-error-message
    (s/constrained s/Int (partial < 0) (deferred-tru "Integer greater than zero"))
    (deferred-tru "value must be an integer greater than zero.")))

Schema for a valid map.

(def Map
  (with-api-error-message (s/named clojure.lang.IPersistentMap (deferred-tru "Valid map"))
    (deferred-tru "value must be a map.")))
 
(ns metabase.util.secret
  (:require
   [metabase.util.i18n :refer [trs]])
  (:import (java.io Writer)))
(set! *warn-on-reflection* true)

Define a protocol for secrets to make things harder to accidentally expose.

(defprotocol ISecret
  (expose [this] "Expose the secret"))
(defrecord Secret [value-fn]
  ISecret
  (expose [_this] (value-fn))
  Object
  (toString [_this] (trs "<< REDACTED SECRET >>")))
(defmethod print-method Secret
  [^Secret secret ^Writer writer]
  (.write writer (.toString secret)))
(defmethod print-dup Secret
  [^Secret secret ^Writer w]
  (.write w (.toString secret)))

Create a Secret that can't be accidentally read without calling the expose method on it.

(defn secret
  [value]
  (->Secret (constantly value)))
 

This is a map type that catches attempts to get :snake_case values from it. In prod, it logs a warning and gets the value for the equivalent kebab-case key; in tests and dev it throws an Exception.

This is here so we can catch driver code that needs to be updated in 48+ to use MLv2 metadata rather than Toucan instances. After 51 we can remove this, everything should be updated by then.

(ns metabase.util.snake-hating-map
  (:require
   [clojure.string :as str]
   [metabase.config :as config]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [potemkin :as p]
   [pretty.core :as pretty]))
(defn- snake-cased-key? [k]
  (some-> k (str/includes? "_")))
(defn- warn-about-using-snake-case [k]
  (let [e (ex-info (format "Accessing metadata using :snake_case key %s. This is deprecated in 0.48.0. Use %s instead."
                           (pr-str k)
                           (pr-str (u/->kebab-case-en k)))
                   {:k k})]
    (if config/is-prod?
      (log/warn e)
      (throw e))))
(defn- normalize-key [k]
  (if (snake-cased-key? k)
    (do
      (warn-about-using-snake-case k)
      (u/->kebab-case-en k))
    k))
(declare ->SnakeHatingMap)
(p/def-map-type SnakeHatingMap [m]
  (get [_this k default-value]
    (get m (normalize-key k) default-value))
  (assoc [this k v]
    (let [m' (assoc m (normalize-key k) v)]
      (if (identical? m m')
        this
        (->SnakeHatingMap m'))))
  (dissoc [this k]
    (let [m' (dissoc m k)]
      (if (identical? m m')
        this
        (->SnakeHatingMap m'))))
  (keys [_this]
    (keys m))
  (meta [_this]
    (meta m))
  (with-meta [this metta]
    (let [m' (with-meta m metta)]
      (if (identical? m m')
        this
        (->SnakeHatingMap m'))))
  pretty/PrettyPrintable
  (pretty [_this]
    (list `snake-hating-map m)))

Create a new map that handles either snake_case or kebab-case keys, but warns is you use snake_case keys (in prod) or throws an Exception (in dev and tests). This is here so we can catch code that needs to be updated to use MLv2 metadata in 48+.

(defn snake-hating-map
  ([]
   (snake-hating-map {}))
  ([m]
   (-> (or m {})
       (vary-meta assoc :metabase.driver/metadata-type :metabase.driver/metadata-type.mlv2)
       ->SnakeHatingMap))
  ([k v & more]
   (snake-hating-map (into {k v} (partition-all 2) more))))
 

SSH tunnel support for JDBC-based DWs. TODO -- it seems like this code is JDBC-specific, or at least big parts of this all. We should consider moving some or all of this code to a new namespace like metabase.driver.sql-jdbc.connection.ssh-tunnel or something like that.

(ns metabase.util.ssh
  (:require
   [metabase.driver :as driver]
   [metabase.models.setting :refer [defsetting]]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru]]
   [metabase.util.log :as log])
  (:import
   (java.io ByteArrayInputStream)
   (java.util.concurrent TimeUnit)
   (org.apache.sshd.client SshClient)
   (org.apache.sshd.client.future ConnectFuture)
   (org.apache.sshd.client.session ClientSession)
   (org.apache.sshd.client.session.forward PortForwardingTracker)
   (org.apache.sshd.common.config.keys FilePasswordProvider
                                       FilePasswordProvider$Decoder
                                       FilePasswordProvider$ResourceDecodeResult)
   (org.apache.sshd.common.future CancelOption)
   (org.apache.sshd.common.session SessionHeartbeatController$HeartbeatType SessionHolder)
   (org.apache.sshd.common.util GenericUtils)
   (org.apache.sshd.common.util.io.resource AbstractIoResource)
   (org.apache.sshd.common.util.net SshdSocketAddress)
   (org.apache.sshd.common.util.security SecurityUtils)
   (org.apache.sshd.server.forward AcceptAllForwardingFilter)))
(defsetting ssh-heartbeat-interval-sec
  (deferred-tru "Controls how often the heartbeats are sent when an SSH tunnel is established (in seconds).")
  :visibility :public
  :type       :integer
  :default    180
  :audit      :getter)
(set! *warn-on-reflection* true)

The default port for SSH tunnels (22) used if no port is specified

(def default-ssh-tunnel-port
  22)
(def ^:private ^Long default-ssh-timeout 30000)
(def ^:private ^SshClient client
  (doto (SshClient/setUpDefaultClient)
    (.start)
    (.setForwardingFilter AcceptAllForwardingFilter/INSTANCE)))
(def ^:private ^"[Lorg.apache.sshd.common.future.CancelOption;" no-cancel-options
  (make-array CancelOption 0))
(defn- maybe-add-tunnel-password!
  [^ClientSession session ^String tunnel-pass]
  (when tunnel-pass
    (.addPasswordIdentity session tunnel-pass)))
(defn- maybe-add-tunnel-private-key!
  [^ClientSession session ^String tunnel-private-key tunnel-private-key-passphrase]
  (when tunnel-private-key
    (let [resource-key      (proxy [AbstractIoResource] [(class "key") "key"])
          password-provider (proxy [FilePasswordProvider] []
                              (getPassword [_ _ _]
                                tunnel-private-key-passphrase)
                              (handleDecodeAttemptResult [_ _ _ _ _]
                                FilePasswordProvider$ResourceDecodeResult/TERMINATE)
                              (decode [_ _ ^FilePasswordProvider$Decoder decoder]
                                (.decode decoder tunnel-private-key-passphrase)))
          ids               (with-open [is (ByteArrayInputStream. (.getBytes tunnel-private-key "UTF-8"))]
                              (SecurityUtils/loadKeyPairIdentities session resource-key is password-provider))
          keypair           (GenericUtils/head ids)]
      (.addPublicKeyIdentity session keypair))))

Opens a new ssh tunnel and returns the connection along with the dynamically assigned tunnel entrance port. It's the callers responsibility to call [[close-tunnel!]] on the returned connection object.

(defn- start-ssh-tunnel!
  [{:keys [^String tunnel-host ^Integer tunnel-port ^String tunnel-user tunnel-pass tunnel-private-key
           tunnel-private-key-passphrase host port]}]
  {:pre [(integer? port)]}
  (let [^Integer tunnel-port       (or tunnel-port default-ssh-tunnel-port)
        ^ConnectFuture conn-future (.connect client tunnel-user tunnel-host tunnel-port)
        ^SessionHolder conn-status (.verify conn-future default-ssh-timeout no-cancel-options)
        hb-sec                     (ssh-heartbeat-interval-sec)
        session                    (doto ^ClientSession (.getSession conn-status)
                                     (maybe-add-tunnel-password! tunnel-pass)
                                     (maybe-add-tunnel-private-key! tunnel-private-key tunnel-private-key-passphrase)
                                     (.setSessionHeartbeat SessionHeartbeatController$HeartbeatType/IGNORE
                                                           TimeUnit/SECONDS
                                                           hb-sec)
                                     (.. auth (verify default-ssh-timeout no-cancel-options)))
        tracker                    (.createLocalPortForwardingTracker session
                                                                      (SshdSocketAddress. "" 0)
                                                                      (SshdSocketAddress. host port))
        input-port                 (.. tracker getBoundAddress getPort)]
    (log/trace (u/format-color 'cyan "creating ssh tunnel (heartbeating every %d seconds) %s@%s:%s -L %s:%s:%s"
                               hb-sec tunnel-user tunnel-host tunnel-port input-port host port))
    [session tracker]))

Is the SSH tunnel currently turned on for these connection details

(defn use-ssh-tunnel?
  [details]
  (:tunnel-enabled details))

Is the SSH tunnel currently open for these connection details?

(defn ssh-tunnel-open?
  [details]
  (when-let [session (:tunnel-session details)]
    (.isOpen ^ClientSession session)))

Updates connection details for a data warehouse to use the ssh tunnel host and port For drivers that enter hosts including the protocol (https://host), copy the protocol over as well

(defn include-ssh-tunnel!
  [details]
  (if (use-ssh-tunnel? details)
    (let [[_ proto host]                           (re-find #"(.*://)?(.*)" (:host details))
          [session ^PortForwardingTracker tracker] (start-ssh-tunnel! (assoc details :host host))
          tunnel-entrance-port                     (.. tracker getBoundAddress getPort)
          tunnel-entrance-host                     (.. tracker getBoundAddress getHostName)
          orig-port                                (:port details)
          details-with-tunnel                      (assoc details
                                                          :port tunnel-entrance-port ;; This parameter is set dynamically when the connection is established
                                                          :host (str proto "localhost") ;; SSH tunnel will always be through localhost
                                                          :orig-port orig-port
                                                          :tunnel-entrance-host tunnel-entrance-host
                                                          :tunnel-entrance-port tunnel-entrance-port ;; the input port is not known until the connection is opened
                                                          :tunnel-enabled true
                                                          :tunnel-session session
                                                          :tunnel-tracker tracker)]
      details-with-tunnel)
    details))

TODO Seems like this definitely belongs in [[metabase.driver.sql-jdbc.connection]] or something like that.

(defmethod driver/incorporate-ssh-tunnel-details :sql-jdbc
  [_driver db-details]
  (cond (not (use-ssh-tunnel? db-details))
        ;; no ssh tunnel in use
        db-details
        (ssh-tunnel-open? db-details)
        ;; tunnel in use, and is open
        db-details
        :else
        ;; tunnel in use, and is not open
        (include-ssh-tunnel! db-details)))

Close a running tunnel session

(defn close-tunnel!
  [details]
  (when (and (use-ssh-tunnel? details) (ssh-tunnel-open? details))
    (log/tracef "Closing SSH tunnel: %s" (:tunnel-session details))
    (.close ^ClientSession (:tunnel-session details))))

Starts an SSH tunnel, runs the supplied function with the tunnel open, then closes it

(defn do-with-ssh-tunnel
  [details f]
  (if (use-ssh-tunnel? details)
    (let [details-with-tunnel (include-ssh-tunnel! details)]
      (try
        (log/trace (u/format-color 'cyan "<< OPENED SSH TUNNEL >>"))
        (f details-with-tunnel)
        (finally
          (close-tunnel! details-with-tunnel)
          (log/trace (u/format-color 'cyan "<< CLOSED SSH TUNNEL >>")))))
    (f details)))

Starts an ssh tunnel, and binds the supplied name to a database details map with it's values adjusted to use the tunnel

TODO -- I think with-ssh-tunnel-details or something like that would be a better name for this. Since it doesn't actually give you a tunnel. It just gives you connection details that include a tunnel in there.

(defmacro with-ssh-tunnel
  [[details-binding details] & body]
  `(do-with-ssh-tunnel ~details
                       (fn [~details-binding]
                         ~@body)))
 

Util for building strings

(ns metabase.util.string
  (:require
   [clojure.string :as str]
   [metabase.util.i18n :refer [deferred-tru]]))

Join parts of a sentence together to build a compound one.

Options: - stop? (default true): whether to add a period at the end of the sentence

Examples:

(build-sentence ["foo" "bar" "baz"]) => "foo, bar and baz."

(build-sentence ["foo" "bar" "baz"] :stop? false) => "foo, bar and baz"

Note: this assumes we're building a sentence with parts from left to right, It might not works correctly with right-to-left language. Also not all language uses command and "and" to represting 'listing'.

(defn build-sentence
  ([parts]
   (build-sentence parts :stop? true))
  ([parts & {:keys [stop?]
             :or   {stop? true}
             :as options}]
   (when (seq parts)
     (cond
       (= (count parts) 1) (str (first parts) (when stop? \.))
       (= (count parts) 2) (str (first parts) " " (deferred-tru "and")  " " (second parts) (when stop? \.))
       :else               (str (first parts) ", " (build-sentence (rest parts) options))))))

Mask string value behind 'start...end' representation.

First four and last four symbols are shown. Even less if string is shorter than 8 chars.

(defn mask
  ([s]
   (mask s 4))
  ([s start-limit]
   (mask s start-limit 4))
  ([s start-limit end-limit]
   (if (str/blank? s)
     s
     (let [cnt (count s)]
       (str
        (subs s 0 (max 1 (min start-limit (- cnt 2))))
        "..."
        (when (< (+ end-limit start-limit) cnt)
          (subs s (- cnt end-limit) cnt)))))))
 

This namespace has clojure implementations of logic currently found in the UI, but is needed for the backend. Idealling code here would be refactored such that the logic for this isn't needed in two places

(ns metabase.util.ui-logic)
(set! *warn-on-reflection* true)

A dimension column is any non-aggregation column

(defn- dimension-column?
  [col]
  (not= :aggregation (:source col)))

A summable column is any numeric column that isn't a relation type like an FK or PK. It also excludes unix timestamps that are numbers, but with an effective type of Temporal.

(defn- summable-column?
  [{base-type :base_type, effective-type :effective_type, semantic-type :semantic_type}]
  (and (isa? base-type :type/Number)
       (not (isa? effective-type :type/Temporal))
       (not (isa? semantic-type :Relation/*))))

A metric column is any non-breakout column that is summable (numeric that isn't a semantic type like an FK/PK/Unix timestamp)

(defn- metric-column?
  [col]
  (and (not= :breakout (:source col))
       (summable-column? col)))

For graphs with goals, this function returns the index of the default column that should be used to compare against the goal. This follows the frontend code getDefaultLineAreaBarColumns closely with a slight change (detailed in the code)

(defn- default-goal-column-index
  [{graph-type :display :as _card} {[col-1 col-2 col-3 :as all-cols] :cols :as _result}]
  (let [cols-count (count all-cols)]
    (cond
      ;; Progress goals return a single row and column, compare that
      (= :progress graph-type)
      0
      ;; Called DIMENSION_DIMENSION_METRIC in the UI, grab the metric third column for comparison
      (and (= cols-count 3)
           (dimension-column? col-1)
           (dimension-column? col-2)
           (metric-column? col-3))
      2
      ;; Called DIMENSION_METRIC in the UI, use the metric column for comparison
      (and (= cols-count 2)
           (dimension-column? col-1)
           (metric-column? col-2))
      1
      ;; Called DIMENSION_METRIC_METRIC in the UI, use the metric column for comparison. The UI returns all of the
      ;; metric columns here, but that causes an issue around which column the user intended to compare to the
      ;; goal. The below code always takes the first metric column, this might diverge from the UI
      (and (>= cols-count 3)
           (dimension-column? col-1)
           (every? metric-column? (rest all-cols)))
      1
      ;; If none of the above is true, return nil as we don't know what to compare the goal to
      :else nil)))

The results seq is seq of vectors, this function returns the index in that vector of the given COLUMN-NAME

(defn- column-name->index
  [column-name {:keys [cols] :as _result}]
  (first (remove nil? (map-indexed (fn [idx column]
                                     (when (.equalsIgnoreCase (name column-name) (name (:name column)))
                                       idx))
                                   cols))))
(defn- graph-column-index [viz-kwd card results]
  (when-let [metrics-col-index (some-> card
                                       (get-in [:visualization_settings viz-kwd])
                                       first
                                       (column-name->index results))]
    (fn [row]
      (nth row metrics-col-index))))

This is used as the Y-axis column in the UI

(defn y-axis-rowfn
  [card results]
  (graph-column-index :graph.metrics card results))

This is used as the X-axis column in the UI

(defn x-axis-rowfn
  [card results]
  (graph-column-index :graph.dimensions card results))

This is used as the Y-axis column in the UI when we have comboes, which have more than one y axis.

(defn mult-y-axis-rowfn
  [card results]
  (let [metrics     (some-> card
                            (get-in [:visualization_settings :graph.metrics]))
        col-indices (keep #(column-name->index % results) metrics)]
    (when (seq col-indices)
      (fn [row]
        (let [res (vec (for [idx col-indices]
                         (nth row idx)))]
          (if (every? some? res)
            res
            nil))))))

This is used as the X-axis column in the UI when we have comboes, which have more than one x axis.

(defn mult-x-axis-rowfn
  [card results]
  (let [dimensions  (some-> card
                            (get-in [:visualization_settings :graph.dimensions]))
        col-indices (keep #(column-name->index % results) dimensions)]
    (when (seq col-indices)
      (fn [row]
        (let [res (vec (for [idx col-indices]
                         (nth row idx)))]
          (if (every? some? res)
            res
            nil))))))

For a given resultset, return the index of the column that should be used for the goal comparison. This can come from the visualization settings if the column is specified, or from our default column logic

(defn make-goal-comparison-rowfn
  [card result]
  (if-let [user-specified-rowfn (y-axis-rowfn card result)]
    user-specified-rowfn
    (when-let [default-col-index (default-goal-column-index card result)]
      (fn [row]
        (nth row default-col-index)))))

The goal value can come from a progress goal or a graph goal_value depending on it's type

(defn find-goal-value
  [result]
  (case (get-in result [:card :display])
    (:area :bar :line)
    (get-in result [:card :visualization_settings :graph.goal_value])
    :progress
    (get-in result [:card :visualization_settings :progress.goal])
    nil))
 

Utility functions for generating the frontend URLs that correspond various user-facing Metabase objects, like Cards or Dashboards. This is intended as the central place for all such URL-generation activity, so if frontend routes change, only this file need be changed on the backend.

Functions for generating URLs not related to Metabase objects generally do not belong here, unless they are used in many places in the codebase; one-off URL-generation functions should go in the same namespaces or modules where they are used.

(ns metabase.util.urls
  (:require
   [metabase.public-settings :as public-settings]))

Return the Notification Link Base URL if set by enterprise env var, or Site URL.

(defn site-url
  []
  (or (public-settings/notification-link-base-url) (public-settings/site-url)))

Return an appropriate URL to view the archive page.

(defn archive-url
  []
  (str (site-url) "/archive"))

Return an appropriate URL for a Dashboard with ID.

(dashboard-url 10) -> "http://localhost:3000/dashboard/10"

(defn dashboard-url
  [^Integer id]
  (format "%s/dashboard/%d" (site-url) id))

Return an appropriate URL for a Card with ID.

(card-url 10) -> "http://localhost:3000/question/10"

(defn card-url
  [^Integer id]
  (format "%s/question/%d" (site-url) id))

Return an appropriate URL for a legacy Pulse with ID.

(legacy-pulse-url 10) -> "http://localhost:3000/pulse/10"

(defn legacy-pulse-url
  [^Integer id]
  (format "%s/pulse/%d" (site-url) id))

Returns an appropriate URL to view a database.

(database-url 4) -> "http://localhost:3000/browse/4"

(defn database-url
  [^Integer db-id]
  (format "%s/browse/%d" (site-url) db-id))

Returns an appropriate URL to view a table.

(table-url 1 10) -> "http://localhost:3000/question?db=1&table=10"

(defn table-url
  [^Integer db-id ^Integer table-id]
  (format "%s/question?db=%d&table=%d" (site-url) db-id table-id))

URL prefix for a public Cards. Get the complete URL by adding the UUID to the end.

(defn public-card-prefix
  []
  (str (site-url) "/public/question/"))

URL prefix for a public Dashboards. Get the complete URL by adding the UUID to the end.

(defn public-dashboard-prefix
  []
  (str (site-url) "/public/dashboard/"))

URL for the notification management page in account settings.

(defn notification-management-url
  []
  (str (site-url) "/account/notifications"))

URL for nonusers to unsubscribe from alerts

(defn unsubscribe-url
  []
  (str (site-url) "/unsubscribe"))

Return an appropriate URL for a Collection with ID or nil for root. (collection-url 10) -> "http://localhost:3000/collection/10" (collection-url nil) -> "http://localhost:3000/collection/root"

(defn collection-url
  [collection-id-or-nil]
  (format "%s/collection/%s" (site-url) (or collection-id-or-nil "root")))

Return an appropriate URL for linking to caching log details.

(defn tools-caching-details-url
  [^Integer persisted-info-id]
  (format "%s/admin/tools/model-caching/%d" (site-url) persisted-info-id))
 

Convenience functions for parsing and generating YAML.

(ns metabase.util.yaml
  (:refer-clojure :exclude [load])
  (:require
   #_{:clj-kondo/ignore [:discouraged-namespace]}
   [clj-yaml.core :as yaml]
   [clojure.java.io :as io]
   [clojure.string :as str]
   [metabase.util :as u]
   [metabase.util.date-2 :as u.date]
   [metabase.util.files :as u.files]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log])
  (:import
   (java.nio.file Files Path)
   (java.time.temporal Temporal)))
(set! *warn-on-reflection* true)

Returns x with lazy seqs converted to vectors wherever they appear in the data structure.

(defn- vectorized
  [x]
  (cond
    (map? x)        (update-vals x vectorized)
    (sequential? x) (mapv vectorized x)
    :else           x))
(extend-protocol yaml/YAMLCodec
  Temporal
  (encode [data]
    (u.date/format data)))

Returns YAML parsed from file/file-like/path f, with options passed to clj-yaml.

(defn from-file
  [f & {:as opts}]
  (when (.exists (io/file f))
    (with-open [r (io/reader f)]
      (vectorized (yaml/parse-stream r opts)))))

Returns a YAML string from Clojure value x

(defn generate-string
  [x & {:as opts}]
  (yaml/generate-string x opts))

Returns a Clojure object parsed from YAML in string s with opts passed to clj-yaml.

(defn parse-string
  [s & {:as opts}]
  (vectorized (yaml/parse-string s opts)))

Legacy API:

Load YAML at path f, parse it, and (optionally) pass the result to constructor.

(defn load
  ([f] (load identity f))
  ([constructor ^Path f]
   (try
     (-> f .toUri slurp parse-string constructor)
     (catch Exception e
       (log/error (trs "Error parsing {0}:\n{1}"
                       (.getFileName f)
                       (or (some-> e
                                   ex-data
                                   (select-keys [:error :value])
                                   u/pprint-to-str)
                           e)))
       (throw e)))))

Load and parse all YAMLs in dir. Optionally pass each resulting data structure through constructor-fn.

(defn load-dir
  ([dir] (load-dir dir identity))
  ([dir constructor]
   (u.files/with-open-path-to-resource [dir dir]
     (with-open [ds (Files/newDirectoryStream dir)]
       (->> ds
            (filter (comp #(str/ends-with? % ".yaml") u/lower-case-en (memfn ^Path getFileName)))
            (mapv (partial load constructor)))))))
 

Util functions for dealing with parameters. Primarily used for substituting parameters into variables in Markdown dashboard cards.

(ns metabase.shared.parameters.parameters
  #?@
   (:clj
    [(:require
      [clojure.string :as str]
      [metabase.mbql.normalize :as mbql.normalize]
      [metabase.shared.util.i18n :refer [trs trsn]]
      [metabase.util.date-2 :as u.date]
      [metabase.util.date-2.parse.builder :as b]
      [metabase.util.i18n.impl :as i18n.impl])
     (:import
      (java.time.format DateTimeFormatter))]
    :cljs
    [(:require
      ["moment" :as moment]
      [clojure.string :as str]
      [metabase.mbql.normalize :as mbql.normalize]
      [metabase.shared.util.i18n :refer [trs trsn]])]))

Formats a value appropriately for inclusion in a text card, based on its type. Does not do any escaping. For datetime parameters, the logic here should mirror the logic (as best as possible) in frontend/src/metabase/parameters/utils/date-formatting.ts

Without this comment, the namespace-checker linter incorrectly detects moment as unused

#?(:cljs (comment moment/keep-me))
(defmulti formatted-value
  (fn [tyype _value _locale] (keyword tyype)))
(defmethod formatted-value :date/single
  [_ value locale]
  #?(:cljs (let [m (.locale (moment value) locale)]
             (.format m "MMMM D, YYYY"))
     :clj  (u.date/format "MMMM d, yyyy" (u.date/parse value) locale)))
(defmethod formatted-value :date/month-year
  [_ value locale]
  #?(:cljs (let [m (.locale (moment value "YYYY-MM") locale)]
             (if (.isValid m) (.format m "MMMM, YYYY") ""))
     :clj  (u.date/format "MMMM, yyyy" (u.date/parse value) locale)))
#?(:clj
   (def ^:private quarter-formatter-in
     (b/formatter
      "Q" (b/value :iso/quarter-of-year 1) "-" (b/value :year 4))))
#?(:clj
   (def ^:private quarter-formatter-out
     (b/formatter
      "Q" (b/value :iso/quarter-of-year 1) ", " (b/value :year 4))))
(defmethod formatted-value :date/quarter-year
  [_ value locale]
  #?(:cljs (let [m (.locale (moment value "[Q]Q-YYYY") locale)]
             (if (.isValid m) (.format m "[Q]Q, YYYY") ""))
     :clj (.format (.withLocale ^DateTimeFormatter quarter-formatter-out (i18n.impl/locale locale))
                   (.parse ^DateTimeFormatter quarter-formatter-in value))))
(defmethod formatted-value :date/range
  [_ value locale]
  (let [[start end] (str/split value #"~")]
    (if (and start end)
      (str (formatted-value :date/single start locale)
           " - "
           (formatted-value :date/single end locale))
      "")))
(defn- translated-interval
  [interval n]
  (case interval
    "minutes"  (trsn "Minute" "Minutes" n)
    "hours"    (trsn "Hour" "Hours" n)
    "days"     (trsn "Day" "Days" n)
    "weeks"    (trsn "Week" "Weeks" n)
    "months"   (trsn "Month" "Months" n)
    "quarters" (trsn "Quarter" "Quarters" n)
    "years"    (trsn "Year" "Years" n)))
(defn- format-relative-date
  [prefix n interval]
  (let [n        #?(:clj (Integer/valueOf ^String n) :cljs (js/parseInt n))
        interval (translated-interval interval n)]
    (case [prefix (= n 1)]
      ["past" true]  (trs "Previous {0}" interval)
      ["past" false] (trs "Previous {0} {1}" n interval)
      ["next" true]  (trs "Next {0}" interval)
      ["next" false] (trs "Next {0} {1}" n interval))))
(defmethod formatted-value :date/relative
  [_ value _]
  (condp (fn [re value] (->> (re-find re value) next)) value
    #"^today$"                             (trs "Today")
    #"^thisday$"                           (trs "Today")
    #"^thisweek$"                          (trs "This Week")
    #"^thismonth$"                         (trs "This Month")
    #"^thisquarter$"                       (trs "This Quarter")
    #"^thisyear$"                          (trs "This Year")
    #"^past1days$"                         (trs "Yesterday")
    #"^next1days$"                         (trs "Tomorrow")
    #"^(past|next)([0-9]+)([a-z]+)~?$" :>> (fn [matches] (apply format-relative-date matches))))
(defmethod formatted-value :date/all-options
  [_ value locale]
  ;; Test value against a series of regexes (similar to those in metabase/parameters/utils/mbql.js) to determine
  ;; the appropriate formatting, since it is not encoded in the parameter type.
  ;; TODO: this is a partial implementation that only handles simple dates
  (condp (fn [re value] (->> (re-find re value) second)) value
    #"^(this[a-z]+)$"          :>> #(formatted-value :date/relative % locale)
    #"^~?([0-9-T:]+)~?$"       :>> #(formatted-value :date/single % locale)
    #"^([0-9-T:]+~[0-9-T:]+)$" :>> #(formatted-value :date/range % locale)
    (formatted-value :date/relative value locale)))

Given a seq of parameter values, returns them as a single comma-separated string. Does not do additional formatting on the values.

(defn formatted-list
  [values]
  (condp = (count values)
    1 (str (first values))
    2 (trs "{0} and {1}" (first values) (second values))
    (trs "{0}, {1}, and {2}"
         (str/join ", " (drop-last 2 values))
         (nth values (- (count values) 2))
         (last values))))
(defmethod formatted-value :default
  [_ value _]
  (cond
    (sequential? value)
    (formatted-list value)

    :else
    (str value)))

Used markdown characters.

(def escaped-chars-regex
  #"[\\/*_`'\[\](){}<>#+-.!$@%^&=|\?~]")

Escape markdown characters.

(defn escape-chars
  [text regex]
  (str/replace text regex #(str \\ %)))
(defn- value
  [tag-name tag->param locale escape-markdown]
  (let [param    (get tag->param tag-name)
        value    (:value param)
        tyype    (:type param)]
    (when value
      (try (cond-> (formatted-value tyype value locale)
             escape-markdown (escape-chars escaped-chars-regex))
           (catch #?(:clj Throwable :cljs js/Error) _
             ;; If we got an exception (most likely during date parsing/formatting), fallback to the default
             ;; implementation of formatted-value
             (formatted-value :default value locale))))))

A regex to find template tags in a text card on a dashboard. This should mirror the regex used to find template tags in native queries, with the exception of snippets and card ID references (see the metabase-lib function recognizeTemplateTags for that regex).

If you modify this, also modify template-tag-splitting-regex below.

(def ^:private template-tag-regex
  #"\{\{\s*([A-Za-z0-9_\.]+?)\s*\}\}")

A regex for spliting text around template tags. This should be identical to template-tag-regex above, but without the capture group around the tag name.

(def ^:private template-tag-splitting-regex
  #"\{\{\s*[A-Za-z0-9_\.]+?\s*\}\}")

Represents a variable parsed out of a text card. tag contains the tag name alone, as a string. source contains the full original syntax for the parameter)

(defrecord ^:private TextParam [tag source]
  Object
  (toString
    [x]
    (or (:value x) source)))
(defn- TextParam?
  [x]
  (instance? TextParam x))

Given the text of a Markdown card, splits it into a sequence of alternating strings and TextParam records.

(defn- split-on-tags
  [text]
  (let [split-text      (str/split text template-tag-splitting-regex)
        matches         (map first (re-seq template-tag-regex text))
        max-len         (max (count split-text) (count matches))
        ;; Pad both `split-text` and `matches` with empty strings until they are equal length, so that nothing is
        ;; dropped by the call to `interleave`
        padded-text     (concat split-text (repeatedly (- max-len (count split-text)) (constantly "")))
        padded-matches  (concat matches (repeatedly (- max-len (count matches)) (constantly "")))
        full-split-text (interleave padded-text padded-matches)]
    (map (fn [text]
           (if-let [[_, match] (re-matches template-tag-regex text)]
             (->TextParam match text)
             text))
         full-split-text)))

Given a vector of strings and/or TextParam, concatenate consecutive strings and TextParams without values.

(defn- join-consecutive-strings
  [strs-or-vars]
  (->> strs-or-vars
       (partition-by (fn [str-or-var]
                         (or (string? str-or-var)
                             (not (:value str-or-var)))))
       (mapcat (fn [strs-or-var]
                   (if (string? (first strs-or-var))
                     [(str/join strs-or-var)]
                     strs-or-var)))))

Given split-text, containing a list of alternating strings and TextParam, add a :value key to any TextParams with a corresponding value in tag->normalized-param.

(defn- add-values-to-variables
  [tag->normalized-param locale escape-markdown split-text]
  (map
   (fn [maybe-variable]
     (if (TextParam? maybe-variable)
         (assoc maybe-variable :value (value (:tag maybe-variable) tag->normalized-param locale escape-markdown))
         maybe-variable))
   split-text))
(def ^:private optional-block-regex
  #"\[\[.+\]\]")
(def ^:private non-optional-block-regex
  #"\[\[(.+?)\]\]")

Removes any [[optional]] blocks from individual strings in split-text, which are blocks that have no parameters with values. Then, concatenates the full string and removes the brackets from any remaining optional blocks.

(defn- strip-optional-blocks
  [split-text]
  (let [s (->> split-text
               (map #(if (TextParam? %) % (str/replace % optional-block-regex "")))
               str/join)]
    (str/replace s non-optional-block-regex second)))

Given the content of a text dashboard card, return a set of the unique names of template tags in the text.

(defn ^:export tag_names
  [text]
  (let [tag-names (->> (re-seq template-tag-regex (or text ""))
                       (map second)
                       set)]
    #?(:clj  tag-names
       :cljs (clj->js tag-names))))

Normalize a single parameter by calling [[mbql.normalize/normalize-fragment]] on it, and converting all string keys to keywords.

(defn- normalize-parameter
  [parameter]
  (-> (mbql.normalize/normalize-fragment [:parameters] [parameter])
      first
      (update-keys keyword)))

Given the context of a text dashboard card, replace all template tags in the text with their corresponding values, formatted and escaped appropriately if escape-markdown is true. Specifically escape-markdown should be false when the output isn't being rendered directly as markdown, such as in header cards.

(defn ^:export substitute_tags
  ([text tag->param]
   (substitute_tags text tag->param "en" true))
  ([text tag->param locale escape-markdown]
   (when text
     (let [tag->param #?(:clj tag->param
                         :cljs (js->clj tag->param))
           tag->normalized-param (update-vals tag->param normalize-parameter)]
       ;; Most of the functions in this pipeline are relating to handling optional blocks in the text which use
       ;; the [[ ]] syntax.
       ;; For example, given an input "[[a {{b}}]] [[{{c}}]]", where `b` has no value and `c` = 3:
       ;; 1. `split-on-tags` =>
       ;;      ("[[a " {:tag "b" :source "{{b}}"} "]] [[" {:tag "c" :source "{{c}}"} "]]")
       ;; 2. `add-values-to-variables` =>
       ;;      ("[[a " {:tag "b" :source "{{b}}" :value nil} "]] [[" {:tag "c" :source "{{c}}" :value 3} "]]")
       ;; 3. `join-consecutive-strings` => ("[[a {{b}}]] [[" {:tag "b" :source "{{c}}" :value 3} "]]")
       ;; 4. `strip-optional-blocks` => "3"
       (->> text
            split-on-tags
            (add-values-to-variables tag->normalized-param locale escape-markdown)
            join-consecutive-strings
            strip-optional-blocks)))))
 
(ns metabase.lib.metadata.protocols
  (:require
   [metabase.util :as u]
   #?@(:clj [[potemkin :as p]])))

Protocol for something that we can get information about Tables and Fields from. This can be provided in various ways various ways:

  1. By raw metadata attached to the query itself

  2. By the application database in Clj code

  3. By the Query Processor store in Clj code

  4. By the Redux store in JS

  5. By (hopefully cached) REST API calls

This protocol is pretty limited at this point; in the future, we'll probably want to add:

  • methods for searching for Tables or Fields matching some string

  • paging, so if you have 10k Tables we don't do crazy requests that fetch them all at once

For all of these methods: if no matching object can be found, you should generally return nil rather than throwing an Exception. Let [[metabase.lib.metadata]] worry about throwing exceptions.

(#?(:clj p/defprotocol+ :cljs defprotocol) MetadataProvider
  (database [metadata-provider]
    "Metadata about the Database we're querying. Should match the [[metabase.lib.metadata/DatabaseMetadata]] schema.
  This includes important info such as the supported `:features` and the like.")
  (table [metadata-provider table-id]
    "Return metadata for a specific Table. Metadata should satisfy [[metabase.lib.metadata/TableMetadata]].")
  (field [metadata-provider field-id]
    "Return metadata for a specific Field. Metadata should satisfy [[metabase.lib.metadata/ColumnMetadata]].")
  (card [metadata-provider card-id]
    "Return information about a specific Saved Question, aka a Card. This should
    match [[metabase.lib.metadata/CardMetadata]. Currently just used for display name purposes if you have a Card as a
    source query.")
  (metric [metadata-provider metric-id]
    "Return metadata for a particular capital-M Metric, i.e. something from the `metric` table in the application
    database. Metadata should match [[metabase.lib.metadata/MetricMetadata]].")
  (segment [metadata-provider segment-id]
    "Return metadata for a particular captial-S Segment, i.e. something from the `segment` table in the application
    database. Metadata should match [[metabase.lib.metadata/SegmentMetadata]]." )
  ;; these methods are only needed for using the methods BUILDING queries, so they're sort of optional I guess? Things
  ;; like the Query Processor, which is only manipulating already-built queries, shouldn't need to use these methods.
  ;; I'm on the fence about maybe putting these in a different protocol. They're part of this protocol for now tho so
  ;; implement them anyway.
  (tables [metadata-provider]
    "Return a sequence of Tables in this Database. Tables should satisfy the [[metabase.lib.metadata/TableMetadata]]
  schema. This should also include things that serve as 'virtual' tables, e.g. Saved Questions or Models. But users of
  MLv2 should not need to know that! If we add support for Super Models or Quantum Questions in the future, they can
  just come back from this method in the same shape as everything else, the Query Builder can display them, and the
  internals can be tucked away here in MLv2.")
  (fields [metadata-provider table-id]
    "Return a sequence of Fields associated with a Table with the given `table-id`. Fields should satisfy
  the [[metabase.lib.metadata/ColumnMetadata]] schema. If no such Table exists, this should error.")
  (metrics [metadata-provider table-id]
    "Return a sequence of legacy Metrics associated with a Table with the given `table-id`. Metrics should satisfy
  the [[metabase.lib.metadata/MetricMetadata]] schema. If no such Table exists, this should error.")
  (segments [metadata-provider table-id]
    "Return a sequence of legacy Segments associated with a Table with the given `table-id`. Segments should satisfy
  the [[metabase.lib.metadata/SegmentMetadata]] schema. If no Table with ID `table-id` exists, this should error.")
  (setting [metadata-provider setting-name]
    "Return the value of the given Metabase setting, a keyword."))

Whether x is a valid [[MetadataProvider]].

(defn metadata-provider?
  [x]
  (satisfies? MetadataProvider x))

Optional. A protocol for a MetadataProvider that some sort of internal cache. This is mostly useful for MetadataProviders that can hit some sort of relatively expensive external service, e.g. [[metabase.lib.metadata.jvm/application-database-metadata-provider]]. The main purpose of this is to allow pre-warming the cache with stuff that was already fetched elsewhere. See [[metabase.models.metric/warmed-metadata-provider]] for example.

See [[cached-metadata-provider]] below to wrap for a way to wrap an existing MetadataProvider to add caching on top of it.

(#?(:clj p/defprotocol+ :cljs defprotocol) CachedMetadataProvider
  (cached-database [cached-metadata-provider]
    "Get cached metadata for the query's Database.")
  (cached-metadata [cached-metadata-provider metadata-type id]
    "Get cached metadata of a specific type, e.g. `:metadata/table`.")
  (store-database! [cached-metadata-provider database-metadata]
    "Store metadata for the query's Database.")
  (store-metadata! [cached-metadata-provider metadata-type id metadata]
    "Store metadata of a specific type, e.g. `:metadata/table`."))

A protocol for a MetadataProvider that can fetch several objects in a single batched operation. This is mostly useful for MetadataProviders e.g. [[metabase.lib.metadata.jvm/application-database-metadata-provider]].

(#?(:clj p/defprotocol+ :cljs defprotocol) BulkMetadataProvider
  (bulk-metadata [bulk-metadata-provider metadata-type ids]
    "Fetch lots of metadata of a specific type, e.g. `:metadata/table`, in a single bulk operation."))

Convenience. Store several metadata maps at once.

(defn store-metadatas!
  [cached-metadata-provider metadata-type metadatas]
  (doseq [metadata metadatas]
    (store-metadata! cached-metadata-provider metadata-type (u/the-id metadata) metadata)))
 
(ns metabase.util.malli.registry
  (:refer-clojure :exclude [declare def])
  (:require
   [malli.core :as mc]
   [malli.registry]
   [malli.util :as mut]
   #?@(:clj ([malli.experimental.time :as malli.time])))
  #?(:cljs (:require-macros [metabase.util.malli.registry])))
(defonce ^:private cache (atom {}))
(defn- cached [k schema value-thunk]
  (or (get-in @cache [k schema])
      (let [v (value-thunk)]
        (swap! cache assoc-in [k schema] v)
        v)))

Fetch a cached [[mc/validator]] for schema, creating one if needed. The cache is flushed whenever the registry changes.

(defn validator
  [schema]
  (cached :validator schema #(mc/validator schema)))

[[mc/validate]], but uses a cached validator from [[validator]].

(defn validate
  [schema value]
  ((validator schema) value))

Fetch a cached [[mc/explainer]] for schema, creating one if needed. The cache is flushed whenever the registry changes.

(defn explainer
  [schema]
  (letfn [(make-explainer []
            #_{:clj-kondo/ignore [:discouraged-var]}
            (let [validator* (mc/validator schema)
                  explainer* (mc/explainer schema)]
              ;; for valid values, it's significantly faster to just call the validator. Let's optimize for the 99.9%
              ;; of calls whose values are valid.
              (fn schema-explainer [value]
                (when-not (validator* value)
                  (explainer* value)))))]
    (cached :explainer schema make-explainer)))

[[mc/explain]], but uses a cached explainer from [[explainer]].

(defn explain
  [schema value]
  ((explainer schema) value))
(defonce ^:private registry*
  (atom (merge (mc/default-schemas)
               (mut/schemas)
               #?(:clj (malli.time/schemas)))))
(defonce ^:private registry (malli.registry/mutable-registry registry*))
(malli.registry/set-default-registry! registry)

Register a spec with our Malli spec registry.

(defn register!
  [schema definition]
  (swap! registry* assoc schema definition)
  (reset! cache {})
  nil)

Like [[clojure.spec.alpha/def]]; add a Malli schema to our registry.

#?(:clj
   (defmacro def
     [type schema]
     `(register! ~type ~schema)))

For REPL/test usage: get the definition of a registered schema from the registry.

(defn resolve-schema
  [schema]
  (mc/deref-all (mc/schema schema)))
 
(ns metabase.lib.schema.expression.temporal
  (:require
   [clojure.set :as set]
   [malli.core :as mc]
   [metabase.lib.hierarchy :as lib.hierarchy]
   [metabase.lib.schema.common :as common]
   [metabase.lib.schema.expression :as expression]
   [metabase.lib.schema.literal :as literal]
   [metabase.lib.schema.mbql-clause :as mbql-clause]
   [metabase.lib.schema.temporal-bucketing :as temporal-bucketing]
   [metabase.shared.util.internal.time-common :as shared.ut.common]
   [metabase.util.malli.registry :as mr])
  #?@
  (:clj
   [(:import
     (java.time ZoneId))]
   :cljs
   [(:require
     ["moment" :as moment]
     ["moment-timezone" :as mtz])]))
#?(:cljs
   ;; so the moment-timezone stuff gets loaded
   (comment mtz/keep-me))

(mbql-clause/define-tuple-mbql-clause :interval :- :type/Interval
  :int
  ::temporal-bucketing/unit.date-time.interval)
(defmethod expression/type-of-method :lib.type-of/type-is-temporal-type-of-first-arg [[_tag _opts temporal]]
  ;; For datetime-add, datetime-subtract, etc. the first arg is a temporal value. However, some valid values are
  ;; formatted strings for which type-of returns eg. #{:type/String :type/DateTime}. Since we're doing date arithmetic,
  ;; we know for sure it's the temporal type.
  (let [inner-type (expression/type-of temporal)]
    (if (set? inner-type)
      (let [temporal-set (set/intersection inner-type #{:type/Date :type/DateTime})]
        (if (= (count temporal-set) 1)
          (first temporal-set)
          temporal-set))
      inner-type)))

For most purposes, :lib.type-of/type-is-temporal-type-of-first-arg is the same as :lib.type-of/type-is-type-of-first-arg. In particular, for the unambiguous lib.metadata.calculation/type-of, they are identical. They only differ when there's a set of possibilities in lib.schema.expression/type-of.

(lib.hierarchy/derive :lib.type-of/type-is-temporal-type-of-first-arg :lib.type-of/type-is-type-of-first-arg)

TODO -- we should constrain this so that you can only use a Date unit if expr is a date, etc.

(doseq [op [:datetime-add :datetime-subtract]]
  (mbql-clause/define-tuple-mbql-clause op
    #_expr   [:ref ::expression/temporal]
    #_amount :int
    #_unit   [:ref ::temporal-bucketing/unit.date-time.interval])
  (lib.hierarchy/derive op :lib.type-of/type-is-temporal-type-of-first-arg))
(doseq [op [:get-year :get-month :get-day :get-hour :get-minute :get-second :get-quarter]]
  (mbql-clause/define-tuple-mbql-clause op :- :type/Integer
    [:schema [:ref ::expression/temporal]]))
(mbql-clause/define-tuple-mbql-clause :datetime-diff :- :type/Integer
  #_:datetime1 [:schema [:ref ::expression/temporal]]
  #_:datetime2 [:schema [:ref ::expression/temporal]]
  #_:unit [:ref ::temporal-bucketing/unit.date-time.truncate])
(doseq [temporal-extract-op #{:get-second :get-minute :get-hour
                              :get-day :get-day-of-week
                              :get-month :get-quarter :get-year}]
  (mbql-clause/define-tuple-mbql-clause temporal-extract-op :- :type/Integer
    #_:datetime [:schema [:ref ::expression/temporal]]))
(mr/def ::get-week-mode
  [:enum :iso :us :instance])
(mbql-clause/define-catn-mbql-clause :get-week :- :type/Integer
  [:datetime [:schema [:ref ::expression/temporal]]]
  ;; TODO : the mode should probably go in the options map in modern MBQL rather than have it be a separate positional
  ;; argument. But we can't refactor everything in one go, so that will have to be a future refactor.
  [:mode     [:? [:schema [:ref ::get-week-mode]]]])
(mr/def ::timezone-id
  [:and
   ::common/non-blank-string
   [:or
    (into [:enum
           {:error/message "valid timezone ID"
            :error/fn      (fn [{:keys [value]} _]
                             (str "invalid timezone ID: " (pr-str value)))}]
          (sort
           #?( ;; 600 timezones on java 17
              :clj (ZoneId/getAvailableZoneIds)
              ;; 596 timezones on moment-timezone 0.5.38
              :cljs (.names (.-tz moment)))))
    ::literal/string.zone-offset]])
(mbql-clause/define-catn-mbql-clause :convert-timezone
  [:datetime [:schema [:ref ::expression/temporal]]]
  [:target   [:schema [:ref ::timezone-id]]]
  [:source   [:? [:schema [:ref ::timezone-id]]]])
(lib.hierarchy/derive :convert-timezone :lib.type-of/type-is-temporal-type-of-first-arg)
(mbql-clause/define-tuple-mbql-clause :now :- :type/DateTimeWithTZ)

if :absolute-datetime has :base-type in options, it must either derive from :type/Date or :type/DateTime. TODO -- we should do additional validation here and make sure the unit/value agree with base-type when it's present.

(mr/def ::absolute-datetime.base-type
  [:and
   [:ref ::common/base-type]
   [:fn
    {:error/message ":absolute-datetime base-type must derive from :type/Date or :type/DateTime"}
    (fn [base-type]
      (some #(isa? base-type %)
            [:type/Date
             :type/DateTime]))]])
(mr/def ::absolute-datetime.options
  [:merge
   [:ref ::common/options]
   [:map
    [:base-type {:optional true} [:ref ::absolute-datetime.base-type]]]])
(mbql-clause/define-mbql-clause :absolute-datetime
  [:cat
   {:error/message "valid :absolute-datetime clause"}
   [:= :absolute-datetime]
   [:schema [:ref ::absolute-datetime.options]]
   [:alt
    [:cat
     {:error/message ":absolute-datetime literal and unit for :type/Date"}
     [:schema [:or
               [:ref ::literal/date]
               ;; absolute datetime also allows `year-month` and `year` literals.
               [:ref ::literal/string.year-month]
               [:ref ::literal/string.year]]]
     [:schema [:or
               [:= :default]
               [:ref ::temporal-bucketing/unit.date]]]]
    [:cat
     {:error/message ":absolute-datetime literal and unit for :type/DateTime"}
     [:schema [:or
               [:= :current]
               [:ref ::literal/datetime]]]
     [:schema [:or
               [:= :default]
               [:ref ::temporal-bucketing/unit.date-time]]]]]])
(defmethod expression/type-of-method :absolute-datetime
  [[_tag _opts value unit]]
  (or
   ;; if value is `:current`, then infer the type based on the unit. Date unit = `:type/Date`. Anything else =
   ;; `:type/DateTime`.
   (when (= value :current)
     (cond
       (= unit :default)                                 :type/DateTime
       (mc/validate ::temporal-bucketing/unit.date unit) :type/Date
       :else                                             :type/DateTime))
   ;; handle year-month and year string regexes, which are not allowed as date literals unless wrapped in
   ;; `:absolute-datetime`.
   (when (string? value)
     (cond
       (re-matches shared.ut.common/year-month-regex value) :type/Date
       (re-matches shared.ut.common/year-regex value)       :type/Date))
   ;; for things that return a union of types like string literals, only the temporal types make sense, so filter out
   ;; everything else.
   (let [value-type (expression/type-of value)
         value-type (if (set? value-type)
                      (into #{} (filter #(isa? % :type/Temporal)) value-type)
                      value-type)]
     (if (and (set? value-type)
              (= (count value-type) 1))
       (first value-type)
       value-type))))
(mr/def ::relative-datetime.amount
  [:or
   [:= :current]
   :int])
(mbql-clause/define-catn-mbql-clause :relative-datetime :- :type/DateTime
  [:n    [:schema [:ref ::relative-datetime.amount]]]
  [:unit [:? [:schema [:ref ::temporal-bucketing/unit.date-time.interval]]]])
(mbql-clause/define-tuple-mbql-clause :time :- :type/Time
  #_:timestr [:schema [:ref ::expression/string]]
  #_:unit [:ref ::temporal-bucketing/unit.time.interval])
(mr/def ::temporal-extract.unit
  [:enum
   :year-of-era
   :quarter-of-year
   :month-of-year
   :week-of-year-iso
   :week-of-year-us
   :week-of-year-instance
   :day-of-month
   :day-of-week
   :hour-of-day
   :minute-of-hour
   :second-of-minute])
(mr/def ::temporal-extract.week-mode
  [:enum :iso :us :instance])

TODO -- this should make sure unit agrees with the type of expression we're extracting from.

(mbql-clause/define-catn-mbql-clause :temporal-extract :- :type/Integer
  [:datetime [:schema [:ref ::expression/temporal]]]
  [:unit     [:schema [:ref ::temporal-extract.unit]]]
  [:mode     [:? [:schema [:ref ::temporal-extract.week-mode]]]])
 

Formatters for time values without date information.

(ns metabase.shared.formatting.time
  (:require
   [metabase.shared.formatting.date :as date]
   [metabase.shared.formatting.internal.date-options :as options]
   [metabase.shared.util.time :as shared.ut])
  #?(:clj
     (:import
      [java.time.format DateTimeFormatter FormatStyle])))

Formats a give time (an hour number, a local time string, or a platform-specific local time object) in the idiomatic style for this locale.

For example, "7:45 PM" in English, "19h45" in French.

------------------------------------------------- Format Time ---------------------------------------------------

(defn ^:export format-time
  [value]
  (let [t (shared.ut/coerce-to-time value)]
    ;; Uses localized time formatting.
    (when (shared.ut/valid? t)
      #?(:cljs (.format t "LT")
         :clj  (.format (DateTimeFormatter/ofLocalizedTime FormatStyle/SHORT) t)))))

Formats the given time (as a string or platform-specific local time or datetime object) based on the :unit and other options, as is done for date formatting.

(defn ^:export format-time-with-unit
  [value options]
  (let [options (-> options options/prepare-options (assoc :date-enabled false))]
    (date/format-datetime-with-unit value options)))
 

The Metabase Hierarchical Type System (MHTS). This is a hierarchy where types derive from one or more parent types, which in turn derive from their own parents. This makes it possible to add new types without needing to add corresponding mappings in the frontend or other places. For example, a Database may want a type called something like :type/CaseInsensitiveText; we can add this type as a derivative of :type/Text and everywhere else can continue to treat it as such until further notice.

There are a few different keyword hierarchies below:

Data (Base/Effective) Types -- keys starting with `:type/` and deriving from `:type/*`, but not `:Semantic/*` or `:Relation/*`

The 'base type' represents the actual data type of the column in the data warehouse. The 'effective type' is the data type we treat this column as; it may be the same as base type or something different if the column has a coercion strategy (see below). Example: a VARCHAR column might have a base type of :type/Text, but store ISO-8601 timestamps; we might choose to interpret this column as a timestamp column by giving it an effective type of :type/DateTime and the coercion strategy :Coercion/ISO8601->DateTime

Coercion Strategies -- keys starting with `:Coercion/`

These strategies tell us how to coerce a column from its base type to it effective type when the two differ. For example, :Coercion/ISO8601->DateTime can be used to tell us how to interpret a VARCHAR column (base type = :type/Text) as a :type/DateTime column (effective type). This depends of the database, but we might do something like using a parse_timestamp() function whenever we fetch this column.

Semantic Types -- types starting with `:type/*` and deriving from `:Semantic/*`

NOTE: In the near future we plan to rename the semantic types so they start with :Semantic/ rather than :type/.

These types represent the semantic meaning/interpretation/purpose of a column in the data warehouse, for example :type/UpdatedTimestamp. This affects things like how we display this column or how we generate Automagic Dashboards. How is this different from Base/Effective type? Suppose we have an updated_at TIMESTAMP column; its data type is TIMESTAMP and thus its base type would be :type/DateTime. There is no such thing as an UPDATED_AT_TIMESTAMP data type; the fact that this column is used to record update timestamps is purely a semantic one.

:Semantic types descend from data type(s) that are allowed to have this semantic type. For example, :type/UpdatedTimestamp descends from :type/DateTime, which means a column with an effective type of :type/DateTime can have a semantic type of:type/UpdatedTimestamp; however a :type/Boolean cannot -- this would make no sense. (Unless maybe false meant 1970-01-01T00:00:00Z and true meant 1970-01-01T00:00:01Z, but I think we can agree that's dumb.)

Relation Type -- types starting with `:type/*` and deriving from `:Relation/*`

NOTE: As with Semantic types, in the near future we'll change the relation types so they all start with :Relation/.

Types that have to do with whether this column is a primary key or foreign key. These are currently stored in the semantic_type column, but we'll split them out into a separate relation_type column in the future.

Entity Types -- keys starting with `:entity/`

These are used to record the semantic purpose of a Table.

(ns metabase.types
  (:require
   [clojure.set :as set]
   [metabase.types.coercion-hierarchies :as coercion-hierarchies]
   [metabase.util.malli :as mu]
   #?@(:cljs
       [[metabase.util :as u]])))

Table (entity) Types

(derive :entity/GenericTable :entity/*)
(derive :entity/UserTable :entity/GenericTable)
(derive :entity/CompanyTable :entity/GenericTable)
(derive :entity/TransactionTable :entity/GenericTable)
(derive :entity/ProductTable :entity/GenericTable)
(derive :entity/SubscriptionTable :entity/GenericTable)
(derive :entity/EventTable :entity/GenericTable)
(derive :entity/GoogleAnalyticsTable :entity/GenericTable)

Numeric Types

(derive :type/Number :type/*)
(derive :type/Integer :type/Number)
(derive :type/BigInteger :type/Integer)
(derive :type/Quantity :Semantic/*)
(derive :type/Quantity :type/Integer)

:type/Float means any number with a decimal place! It doesn't explicitly mean a 32-bit or 64-bit floating-point number. That's why there's no :type/Double.

(derive :type/Float :type/Number)

:type/Decimal means a column that is actually stored as an arbitrary-precision decimal type, e.g. BigDecimal or DECIMAL. For fixed-precision columns, just use :type/Float

(derive :type/Decimal :type/Float)
(derive :type/Share :Semantic/*)
(derive :type/Share :type/Float)

A percent value (generally 0-100)

(derive :type/Percentage :Semantic/*)
(derive :type/Percentage :type/Decimal)

:type/Currency -- an actual currency data type, for example Postgres money. :type/Currency -- a column that should be interpreted as money.

money (base type :type/Currency) columns will likely have a semantic type :type/Currency or a descendant thereof like :type/Income, but other floating-point data type columns can be interpreted as currency as well; a DECIMAL (base type :type/Decimal) column can also have a semantic type :type/Currency.

(derive :type/Currency :type/Decimal)
(derive :type/Currency :Semantic/*)
(derive :type/Income :type/Currency)
(derive :type/Discount :type/Currency)
(derive :type/Price :type/Currency)
(derive :type/GrossMargin :type/Currency)
(derive :type/Cost :type/Currency)

:type/Location -- anything having to do with a location, e.g. country, city, or coordinates.

(derive :type/Location :Semantic/*)
(derive :type/Coordinate :type/Location)
(derive :type/Coordinate :type/Float)
(derive :type/Latitude :type/Coordinate)
(derive :type/Longitude :type/Coordinate)
(derive :type/Score :Semantic/*)
(derive :type/Score :type/Number)
(derive :type/Duration :Semantic/*)
(derive :type/Duration :type/Number)

Text Types

(derive :type/Text :type/*)
(derive :type/UUID :type/Text)
(derive :type/URL :Semantic/*)
(derive :type/URL :type/Text)
(derive :type/ImageURL :type/URL)
(derive :type/AvatarURL :type/ImageURL)
(derive :type/Email :Semantic/*)
(derive :type/Email :type/Text)

Semantic types deriving from :type/Category should be marked as 'category' Fields during sync, i.e. they should have their FieldValues cached and synced. See metabase.sync.analyze.classifiers.category/field-should-be-category?

(derive :type/Category :Semantic/*)
(derive :type/Enum :Semantic/*)
(derive :type/Address :type/Location)
(derive :type/City :type/Address)
(derive :type/City :type/Category)
(derive :type/City :type/Text)
(derive :type/State :type/Address)
(derive :type/State :type/Category)
(derive :type/State :type/Text)
(derive :type/Country :type/Address)
(derive :type/Country :type/Category)
(derive :type/Country :type/Text)
(derive :type/ZipCode :type/Address)
(derive :type/ZipCode :type/Text)
(derive :type/Name :type/Category)
(derive :type/Name :type/Text)
(derive :type/Title :type/Category)
(derive :type/Title :type/Text)
(derive :type/Description :Semantic/*)
(derive :type/Description :type/Text)
(derive :type/Comment :Semantic/*)
(derive :type/Comment :type/Text)
(derive :type/PostgresEnum :type/Text)

DateTime Types

(derive :type/Temporal :type/*)
(derive :type/Date :type/Temporal)

You could have Dates with TZ info but it's not supported by JSR-310 so we'll not worry about that for now.

(derive :type/Time :type/Temporal)
(derive :type/TimeWithTZ :type/Time)
(derive :type/TimeWithLocalTZ :type/TimeWithTZ)    ; a column that is timezone-aware, but normalized to UTC or another offset at rest.
(derive :type/TimeWithZoneOffset :type/TimeWithTZ) ; a column that stores its timezone offset
(derive :type/DateTime :type/Temporal)
(derive :type/DateTimeWithTZ :type/DateTime)
(derive :type/DateTimeWithLocalTZ :type/DateTimeWithTZ)    ; a column that is timezone-aware, but normalized to UTC or another offset at rest.
(derive :type/DateTimeWithZoneOffset :type/DateTimeWithTZ) ; a column that stores its timezone offset, e.g. `-08:00`
(derive :type/DateTimeWithZoneID :type/DateTimeWithTZ)     ; a column that stores its timezone ID, e.g. `US/Pacific`

An Instant is a timestamp in (milli-)seconds since the epoch, UTC. Since it doesn't store TZ information, but is normalized to UTC, it is a DateTimeWithLocalTZ

Instant if differentiated from other DateTimeWithLocalTZ columns in the same way java.time.Instant is different from java.time.OffsetDateTime;

(derive :type/Instant :type/DateTimeWithLocalTZ)

TODO -- shouldn't we have a :type/LocalDateTime as well?

(derive :type/CreationTemporal :Semantic/*)
(derive :type/CreationTimestamp :type/CreationTemporal)
(derive :type/CreationTimestamp :type/DateTime)
(derive :type/CreationTime :type/CreationTemporal)
(derive :type/CreationTime :type/Time)
(derive :type/CreationDate :type/CreationTemporal)
(derive :type/CreationDate :type/Date)
(derive :type/JoinTemporal :Semantic/*)
(derive :type/JoinTimestamp :type/JoinTemporal)
(derive :type/JoinTimestamp :type/DateTime)
(derive :type/JoinTime :type/JoinTemporal)
(derive :type/JoinTime :type/Time)
(derive :type/JoinDate :type/JoinTemporal)
(derive :type/JoinDate :type/Date)
(derive :type/CancelationTemporal :Semantic/*)
(derive :type/CancelationTimestamp :type/CancelationTemporal)
(derive :type/CancelationTimestamp :type/DateTime)
(derive :type/CancelationTime :type/CancelationTemporal)
(derive :type/CancelationTime :type/Date)
(derive :type/CancelationDate :type/CancelationTemporal)
(derive :type/CancelationDate :type/Date)
(derive :type/DeletionTemporal :Semantic/*)
(derive :type/DeletionTimestamp :type/DeletionTemporal)
(derive :type/DeletionTimestamp :type/DateTime)
(derive :type/DeletionTime :type/DeletionTemporal)
(derive :type/DeletionTime :type/Time)
(derive :type/DeletionDate :type/DeletionTemporal)
(derive :type/DeletionDate :type/Date)
(derive :type/UpdatedTemporal :Semantic/*)
(derive :type/UpdatedTimestamp :type/UpdatedTemporal)
(derive :type/UpdatedTimestamp :type/DateTime)
(derive :type/UpdatedTime :type/UpdatedTemporal)
(derive :type/UpdatedTime :type/Time)
(derive :type/UpdatedDate :type/UpdatedTemporal)
(derive :type/UpdatedDate :type/Date)
(derive :type/Birthdate :Semantic/*)
(derive :type/Birthdate :type/Date)
(derive :type/Interval :type/Temporal)

Other

(derive :type/Boolean :type/*)
(derive :type/DruidHyperUnique :type/*)

Text-Like Types: Things that should be displayed as text for most purposes but that shouldn't support advanced filter options like starts with / contains

(derive :type/TextLike :type/*)
(derive :type/MongoBSONID :type/TextLike)

IP address can be either a data type e.g. Postgres inet or a semantic type e.g. a text column that has IP addresses

(derive :type/IPAddress :type/TextLike)
(derive :type/IPAddress :Semantic/*)

Structured/Collections

(derive :type/Collection :type/*)
(derive :type/Structured :type/*)
(derive :type/Dictionary :type/Collection)
(derive :type/Array :type/Collection)

:type/JSON currently means a column that is JSON data, e.g. a Postgres JSON column

(derive :type/JSON :type/Structured)
(derive :type/JSON :type/Collection)

:type/XML -- an actual native XML data column

(derive :type/XML :type/Structured)
(derive :type/XML :type/Collection)

:type/Structured columns are ones that are stored as text, but should be treated as a :type/Collection column (e.g. JSON or XML). These should probably be coercion strategies instead, e.g.

base type = :type/Text coercion strategy = :Coercion/SerializedJSON effective type = :type/JSON

but for the time being we'll have to live with these being "weird" semantic types.

(derive :type/Structured :Semantic/*)
(derive :type/Structured :type/Text)
(derive :type/SerializedJSON :type/Structured)
(derive :type/XML :type/Structured)

Other

(derive :type/User :Semantic/*)
(derive :type/Author :type/User)
(derive :type/Owner :type/User)
(derive :type/Product :type/Category)
(derive :type/Company :type/Category)
(derive :type/Subscription :type/Category)
(derive :type/Source :type/Category)

Relation types

(derive :type/FK :Relation/*)
(derive :type/PK :Relation/*)

Coercion strategies

(derive :Coercion/String->Temporal :Coercion/*)
(derive :Coercion/ISO8601->Temporal :Coercion/String->Temporal)
(derive :Coercion/ISO8601->DateTime :Coercion/ISO8601->Temporal)
(derive :Coercion/ISO8601->Time :Coercion/ISO8601->Temporal)
(derive :Coercion/ISO8601->Date :Coercion/ISO8601->Temporal)
(derive :Coercion/YYYYMMDDHHMMSSString->Temporal :Coercion/String->Temporal)
(derive :Coercion/Bytes->Temporal :Coercion/*)
(derive :Coercion/YYYYMMDDHHMMSSBytes->Temporal :Coercion/Bytes->Temporal)
(derive :Coercion/Number->Temporal :Coercion/*)
(derive :Coercion/UNIXTime->Temporal :Coercion/Number->Temporal)
(derive :Coercion/UNIXSeconds->DateTime :Coercion/UNIXTime->Temporal)
(derive :Coercion/UNIXMilliSeconds->DateTime :Coercion/UNIXTime->Temporal)
(derive :Coercion/UNIXMicroSeconds->DateTime :Coercion/UNIXTime->Temporal)
(derive :Coercion/UNIXNanoSeconds->DateTime :Coercion/UNIXTime->Temporal)

---------------------------------------------------- Util Fns ----------------------------------------------------

E.g. the version coming back from the app DB as opposed to MLv2 metadata. This should eventually be considered deprecated.

(def ^:private SnakeCasedField
  [:map
   [:base_type :any]])

True if a Metabase Field instance has a temporal base or semantic type, i.e. if this Field represents a value relating to a moment in time.

(mu/defn field-is-type?
  [tyype                                                  :- :keyword
   {base-type :base_type, effective-type :effective_type} :- SnakeCasedField]
  (some #(isa? % tyype) [base-type effective-type]))

True if a Metabase Field instance has a temporal base or semantic type, i.e. if this Field represents a value relating to a moment in time.

(mu/defn temporal-field?
  [field :- SnakeCasedField]
  (field-is-type? :type/Temporal field))
(def ^:private assignable-hierarchy
  (make-hierarchy))

Declare that a value of type x assignable to a variable of type y.

(defn declare-assignable
  [x y]
  #?(:clj (alter-var-root #'assignable-hierarchy derive x y)
     :cljs (set! assignable-hierarchy (derive assignable-hierarchy x y))))
(declare-assignable :type/Integer :type/Decimal)

Is a value of type x assignable to a variable of type y?

When deciding assignability, We also consider the type hierarchy. If x is assignable to z and z is a y, then x is also assignable to y. Also, if z is assignable to y and x is an z, then x is assignable to y.

(defn assignable?
  [x y]
  (or (isa? assignable-hierarchy x y)
      (boolean (some #(assignable? x %) (descendants y)))
      (boolean (some #(assignable? % y) (parents x)))))

Impl for [[most-specific-common-ancestor]].

(defn- most-specific-common-ancestor*
  [x y]
  (cond
    (= x :type/*)     nil
    (= y :type/*)     nil
    (assignable? x y) y
    (assignable? y x) x
    ;; if we haven't had a match yet, recursively try using parent types.
    :else
    (some (fn [x']
            (some (fn [y']
                    (when-not (= [x' y'] [x y])
                      (most-specific-common-ancestor* x' y')))
                  (cons y (parents y))))
          (cons x (parents x)))))

Return the most-specific type that is an ancestor of both x and y.

(most-specific-common-ancestor :type/BigInteger :type/Decimal) => :type/Number

(defn most-specific-common-ancestor
  [x y]
  (or (most-specific-common-ancestor* x y)
      :type/*))
#?(:cljs
   (defn ^:export isa
     "Is `x` the same as, or a descendant type of, `y`?"
     [x y]
     (isa? (keyword x) (keyword y))))

#?(:cljs
   (def ^:export TYPE
     "A map of Type name (as string, without `:type/` namespace) -> qualified type name as string

         {\"Temporal\" \"type/Temporal\", ...}"
     (clj->js (into {} (for [tyype (distinct (mapcat descendants [:type/* :Semantic/* :Relation/*]))]
                         [(name tyype) (u/qualified-name tyype)])))))

(coercion-hierarchies/define-types! :Coercion/UNIXNanoSeconds->DateTime #{:type/Integer :type/Decimal} :type/Instant)
(coercion-hierarchies/define-types! :Coercion/UNIXMicroSeconds->DateTime #{:type/Integer :type/Decimal} :type/Instant)
(coercion-hierarchies/define-types! :Coercion/UNIXMilliSeconds->DateTime #{:type/Integer :type/Decimal} :type/Instant)
(coercion-hierarchies/define-types! :Coercion/UNIXSeconds->DateTime      #{:type/Integer :type/Decimal} :type/Instant)
(coercion-hierarchies/define-types! :Coercion/ISO8601->Date              :type/Text                     :type/Date)
(coercion-hierarchies/define-types! :Coercion/ISO8601->DateTime          :type/Text                     :type/DateTime)
(coercion-hierarchies/define-types! :Coercion/ISO8601->Time              :type/Text                     :type/Time)
(coercion-hierarchies/define-types! :Coercion/YYYYMMDDHHMMSSString->Temporal :type/Text                 :type/DateTime)
(coercion-hierarchies/define-non-inheritable-type! :Coercion/YYYYMMDDHHMMSSBytes->Temporal :type/* :type/DateTime)

Whether coercion-strategy is allowed for base-type.

(defn is-coercible-from?
  [coercion-strategy base-type]
  (or (isa? (coercion-hierarchies/base-type-hierarchy) base-type coercion-strategy)
      (boolean (some-> (coercion-hierarchies/non-descending-strategies)
                       (get base-type)
                       (contains? coercion-strategy)))))

Whether coercion-strategy coerces to effective-type or some subtype thereof.

(defn is-coercible-to?
  [coercion-strategy effective-type]
  (isa? (coercion-hierarchies/effective-type-hierarchy) coercion-strategy effective-type))

Whether coercion-strategy is allowed for base-type and coerces to effective-type or some subtype thereof.

(defn is-coercible?
  [coercion-strategy base-type effective-type]
  (and (is-coercible-from? coercion-strategy base-type)
       (is-coercible-to? coercion-strategy effective-type)))

Possible coercions for a base type, returned as a map of effective-type -> #{coercion-strategy}

(defn coercion-possibilities
  [base-type]
  (let [base-type-hierarchy      (coercion-hierarchies/base-type-hierarchy)
        effective-type-hierarchy (coercion-hierarchies/effective-type-hierarchy)]
    (->> (for [strategy       (ancestors base-type-hierarchy base-type)
               :when          (isa? strategy :Coercion/*)
               :let           [effective-types (parents effective-type-hierarchy strategy)]
               effective-type effective-types
               :when          (not (isa? effective-type :Coercion/*))]
           {effective-type #{strategy}})
         (reduce (partial merge-with set/union)
                 (select-keys (coercion-hierarchies/non-descending-strategies) [base-type]))
         not-empty)))

Returns a boolean of whether a field base-type has any coercion strategies available.

(defn ^:export is_coerceable
  [base-type]
  (boolean (not-empty (coercion-possibilities (keyword base-type)))))

The effective type resulting from a coercion.

(defn effective-type-for-coercion
  [coercion]
  (coercion-hierarchies/effective-type-for-strategy coercion))

Coercions available for a type. In cljs will return a js array of strings like ["Coercion/ISO8601->Time" ...]. In clojure will return a sequence of keywords.

(defn ^:export coercions_for_type
   [base-type]
  (let [applicable (into () (comp (distinct) cat)
                         (vals (coercion-possibilities (keyword base-type))))]
     #?(:cljs
        (clj->js (map (fn [kw] (str (namespace kw) "/" (name kw)))
                      applicable))
        :clj
        applicable)))
 

Utility functions used by the Queries in metabase-lib.

(ns metabase.domain-entities.queries.util
  (:require
   [metabase.util.malli :as mu]
   #?@(:cljs ([metabase.domain-entities.converters :as converters]))))

Schema for an Expression that's part of a query filter.

(def Expression
  :any)

Malli schema for a map of expressions by name.

(def ExpressionMap
  [:map-of string? Expression])

Malli schema for a list of {:name :expression} maps.

(def ExpressionList
  [:vector [:map [:name string?] [:expression Expression]]])
(def ^:private ->expression-map
  #?(:cljs (converters/incoming ExpressionMap)
     :clj  identity))
(def ^:private expression-list->
  #?(:cljs (converters/outgoing ExpressionList)
     :clj  identity))
(mu/defn ^:export expressions-list :- ExpressionList
  "Turns a map of expressions by name into a list of `{:name name :expression expression}` objects."
  [expressions :- ExpressionMap]
  (->> expressions
       ->expression-map
       (mapv (fn [[name expr]] {:name name :expression expr}))
       expression-list->))
(defn- unique-name [names original-name index]
  (let [indexed-name (str original-name " (" index ")")]
    (if (names indexed-name)
      (recur names original-name (inc index))
      indexed-name)))
(mu/defn ^:export unique-expression-name :- string?
  "Generates an expression name that's unique in the given map of expressions."
  [expressions   :- ExpressionMap
   original-name :- string?]
  (let [expression-names (-> expressions ->expression-map keys set)]
    (if (not (expression-names original-name))
      original-name
      (let [re-duplicates (re-pattern (str "^" original-name " \\([0-9]+\\)$"))
            duplicates    (set (filter #(or (= % original-name)
                                            (re-matches re-duplicates %))
                                       expression-names))]
        (unique-name duplicates original-name (count duplicates))))))
 

Utilitiy functions for working with MBQL queries.

(ns metabase.mbql.util
  (:refer-clojure :exclude [replace])
  (:require
   [clojure.string :as str]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.mbql.predicates :as mbql.preds]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.schema.helpers :as schema.helpers]
   [metabase.mbql.util.match :as mbql.match]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   #?@(:clj
       [[metabase.models.dispatch :as models.dispatch]
        [potemkin :as p]])))

Like name, but if x is a namespace-qualified keyword, returns that a string including the namespace.

(defn qualified-name
  [x]
  (if (and (keyword? x) (namespace x))
    (str (namespace x) "/" (name x))
    (name x)))
(mu/defn normalize-token :- :keyword
  "Convert a string or keyword in various cases (`lisp-case`, `snake_case`, or `SCREAMING_SNAKE_CASE`) to a lisp-cased
  keyword."
  [token :- schema.helpers/KeywordOrString]
  #_{:clj-kondo/ignore [:discouraged-var]}
  (-> (qualified-name token)
      str/lower-case
      (str/replace #"_" "-")
      keyword))

True if x is an MBQL clause (a sequence with a keyword as its first arg). (Since this is used by the code in normalize this handles pre-normalized clauses as well.)

(defn mbql-clause?
  [x]
  (and (sequential? x)
       (not (map-entry? x))
       (keyword? (first x))))

If x is an MBQL clause, and an instance of clauses defined by keyword(s) k-or-ks?

(is-clause? :count [:count 10]) ; -> true (is-clause? #{:+ :- :* :/} [:+ 10 20]) ; -> true

(defn is-clause?
  [k-or-ks x]
  (and
   (mbql-clause? x)
   (if (coll? k-or-ks)
     ((set k-or-ks) (first x))
     (= k-or-ks (first x)))))

Returns x if it's an instance of a clause defined by keyword(s) k-or-ks

(check-clause :count [:count 10]) ; => [:count 10] (check-clause? #{:+ :- :* :/} [:+ 10 20]) ; -> [:+ 10 20] (check-clause :sum [:count 10]) ; => nil

(defn check-clause
  [k-or-ks x]
  (when (is-clause? k-or-ks x)
    x))

+----------------------------------------------------------------------------------------------------------------+ | Functions for manipulating queries | +----------------------------------------------------------------------------------------------------------------+

(defn- combine-compound-filters-of-type [compound-type subclauses]
  (mapcat #(mbql.match/match-one %
             [(_ :guard (partial = compound-type)) & args]
             args
             _
             [&match])
          subclauses))
(declare simplify-compound-filter)
(defn- simplify-and-or-filter
  [op args]
  (let [args (distinct (filter some? args))]
    (case (count args)
      ;; an empty filter, toss it
      0 nil
      ;; single arg, unwrap it
      1 (simplify-compound-filter (first args))
      (if (some (partial is-clause? op) args)
        ;; clause of the same type embedded, faltten it
        (recur op (combine-compound-filters-of-type op args))
        ;; simplify the arguments
        (let [simplified (map simplify-compound-filter args)]
          (if (= simplified args)
            ;; no change, we can stop
            (into [op] args)
            ;; there is a change, we might be able to simplify even further
            (recur op simplified)))))))

Simplify compound :and, :or, and :not compound filters, combining or eliminating them where possible. This also fixes theoretically disallowed compound filters like :and with only a single subclause, and eliminates nils and duplicate subclauses from the clauses.

(defn simplify-compound-filter
  [x]
  (cond
    ;; look for filters in the values
    (map? x) (update-vals x simplify-compound-filter)
    (seq? x) (recur (vec x))
    ;; not a map and not vector, leave it as is
    (not (vector? x)) x
    ;; an empty filter, toss it
    (not (some some? x)) nil
    :else (let [[op & [farg :as args]] x]
            (case op
              :not (if-not (seqable? farg)
                     x
                     (case (first farg)
                       ;; double negation, eliminate both
                       :not (recur (second farg))
                       ;; use de Morgan's law to push the negation down
                       :and (simplify-and-or-filter :or (map #(vector :not %) (rest farg)))
                       :or  (simplify-and-or-filter :and (map #(vector :not %) (rest farg)))
                       x))
              :and (simplify-and-or-filter :and args)
              :or  (simplify-and-or-filter :or args)
              ;; simplify the elements of the vector
              (mapv simplify-compound-filter x)))))
(mu/defn combine-filter-clauses :- mbql.s/Filter
  "Combine two filter clauses into a single clause in a way that minimizes slapping a bunch of `:and`s together if
  possible."
  [filter-clause & more-filter-clauses]
  (simplify-compound-filter (cons :and (cons filter-clause more-filter-clauses))))
(mu/defn add-filter-clause-to-inner-query :- mbql.s/MBQLQuery
  "Add a additional filter clause to an *inner* MBQL query, merging with the existing filter clause with `:and` if
  needed."
  [inner-query :- mbql.s/MBQLQuery
   new-clause  :- [:maybe mbql.s/Filter]]
  (if-not new-clause
    inner-query
    (update inner-query :filter combine-filter-clauses new-clause)))
(mu/defn add-filter-clause :- mbql.s/Query
  "Add an additional filter clause to an `outer-query`. If `new-clause` is `nil` this is a no-op."
  [outer-query :- mbql.s/Query new-clause :- [:maybe mbql.s/Filter]]
  (update outer-query :query add-filter-clause-to-inner-query new-clause))

Rewrite :inside filter clauses as a pair of :between clauses.

(defn desugar-inside
  [m]
  (mbql.match/replace m
    [:inside lat-field lon-field lat-max lon-min lat-min lon-max]
    [:and
     [:between lat-field lat-min lat-max]
     [:between lon-field lon-min lon-max]]))

Rewrite :is-null and :not-null filter clauses as simpler := and :!=, respectively.

(defn desugar-is-null-and-not-null
  [m]
  (mbql.match/replace m
    [:is-null field]  [:=  field nil]
    [:not-null field] [:!= field nil]))

Rewrite :is-empty and :not-empty filter clauses as simpler := and :!=, respectively.

(defn desugar-is-empty-and-not-empty
  [m]
  (mbql.match/replace m
    [:is-empty field]  [:or  [:=  field nil] [:=  field ""]]
    [:not-empty field] [:and [:!= field nil] [:!= field ""]]))

Replace a field or expression inside :time-interval

(defn- replace-field-or-expression
  [m unit]
  (mbql.match/replace m
    [:field id-or-name opts] [:field id-or-name (assoc opts :temporal-unit unit)]
    [:expression expression-name] [:expression expression-name]))

Rewrite :time-interval filter clauses as simpler ones like := or :between.

(defn desugar-time-interval
  [m]
  (mbql.match/replace m
    [:time-interval field-or-expression n unit] (recur [:time-interval field-or-expression n unit nil])
    ;; replace current/last/next with corresponding value of n and recur
    [:time-interval field-or-expression :current unit options] (recur [:time-interval field-or-expression  0 unit options])
    [:time-interval field-or-expression :last    unit options] (recur [:time-interval field-or-expression -1 unit options])
    [:time-interval field-or-expression :next    unit options] (recur [:time-interval field-or-expression  1 unit options])
    [:time-interval field-or-expression (n :guard #{-1}) unit (_ :guard :include-current)]
    [:between
     (replace-field-or-expression field-or-expression unit)
     [:relative-datetime n unit]
     [:relative-datetime 0 unit]]
    [:time-interval field-or-expression (n :guard #{1}) unit (_ :guard :include-current)]
    [:between
     (replace-field-or-expression field-or-expression unit)
     [:relative-datetime 0 unit]
     [:relative-datetime n unit]]
    [:time-interval field-or-expression (n :guard #{-1 0 1}) unit _]
    [:= (replace-field-or-expression field-or-expression unit) [:relative-datetime n unit]]
    [:time-interval field-or-expression (n :guard neg?) unit (_ :guard :include-current)]
    [:between
     (replace-field-or-expression field-or-expression unit)
     [:relative-datetime n unit]
     [:relative-datetime 0 unit]]
    [:time-interval field-or-expression (n :guard neg?) unit _]
    [:between
     (replace-field-or-expression field-or-expression unit)
     [:relative-datetime n unit]
     [:relative-datetime -1 unit]]
    [:time-interval field-or-expression n unit (_ :guard :include-current)]
    [:between
     (replace-field-or-expression field-or-expression unit)
     [:relative-datetime 0 unit]
     [:relative-datetime n unit]]
    [:time-interval field-or-expression n unit _]
    [:between
     (replace-field-or-expression field-or-expression unit)
     [:relative-datetime 1 unit]
     [:relative-datetime n unit]]))

Rewrite :does-not-contain filter clauses as simpler :not clauses.

(defn desugar-does-not-contain
  [m]
  (mbql.match/replace m
    [:does-not-contain & args]
    [:not (into [:contains] args)]))

:= and != clauses with more than 2 args automatically get rewritten as compound filters.

[:= field x y] -> [:or [:= field x] [:= field y]] [:!= field x y] -> [:and [:!= field x] [:!= field y]]

(defn desugar-equals-and-not-equals-with-extra-args
  [m]
  (mbql.match/replace m
    [:= field x y & more]
    (apply vector :or (for [x (concat [x y] more)]
                        [:= field x]))
    [:!= field x y & more]
    (apply vector :and (for [x (concat [x y] more)]
                         [:!= field x]))))

Replace relative-datetime clauses like [:relative-datetime :current] with [:relative-datetime 0 <unit>]. <unit> is inferred from the :field the clause is being compared to (if any), otherwise falls back to default.

(defn desugar-current-relative-datetime
  [m]
  (mbql.match/replace m
    [clause field & (args :guard (partial some (partial = [:relative-datetime :current])))]
    (let [temporal-unit (or (mbql.match/match-one field [:field _ {:temporal-unit temporal-unit}] temporal-unit)
                            :default)]
      (into [clause field] (mbql.match/replace args
                             [:relative-datetime :current]
                             [:relative-datetime 0 temporal-unit])))))

Mapping from the sugar syntax to extract datetime to the unit.

(def temporal-extract-ops->unit
  {[:get-year        nil]       :year-of-era
   [:get-quarter     nil]       :quarter-of-year
   [:get-month       nil]       :month-of-year
   ;; default get-week mode is iso
   [:get-week        nil]       :week-of-year-iso
   [:get-week        :iso]      :week-of-year-iso
   [:get-week        :us]       :week-of-year-us
   [:get-week        :instance] :week-of-year-instance
   [:get-day         nil]       :day-of-month
   [:get-day-of-week nil]       :day-of-week
   [:get-hour        nil]       :hour-of-day
   [:get-minute      nil]       :minute-of-hour
   [:get-second      nil]       :second-of-minute})
(def ^:private temporal-extract-ops
  (->> (keys temporal-extract-ops->unit)
       (map first)
       set))

Replace datetime extractions clauses like [:get-year field] with [:temporal-extract field :year].

(defn desugar-temporal-extract
  [m]
  (mbql.match/replace m
    [(op :guard temporal-extract-ops) field & args]
    [:temporal-extract field (temporal-extract-ops->unit [op (first args)])]))
(defn- desugar-divide-with-extra-args [expression]
  (mbql.match/replace expression
    [:/ x y z & more]
    (recur (into [:/ [:/ x y]] (cons z more)))))
(mu/defn desugar-expression :- mbql.s/FieldOrExpressionDef
  "Rewrite various 'syntactic sugar' expressions like `:/` with more than two args into something simpler for drivers
  to compile."
  [expression :- mbql.s/FieldOrExpressionDef]
  (-> expression
      desugar-divide-with-extra-args))
(defn- maybe-desugar-expression [clause]
  (cond-> clause
    (mbql.preds/FieldOrExpressionDef? clause) desugar-expression))
(mu/defn desugar-filter-clause :- mbql.s/Filter
  "Rewrite various 'syntatic sugar' filter clauses like `:time-interval` and `:inside` as simpler, logically
  equivalent clauses. This can be used to simplify the number of filter clauses that need to be supported by anything
  that needs to enumerate all the possible filter types (such as driver query processor implementations, or the
  implementation [[negate-filter-clause]] below.)"
  [filter-clause :- mbql.s/Filter]
  (-> filter-clause
      desugar-current-relative-datetime
      desugar-equals-and-not-equals-with-extra-args
      desugar-does-not-contain
      desugar-time-interval
      desugar-is-null-and-not-null
      desugar-is-empty-and-not-empty
      desugar-inside
      simplify-compound-filter
      desugar-temporal-extract
      maybe-desugar-expression))
(defmulti ^:private negate* first)
(defmethod negate* :not [[_ subclause]]    subclause)
(defmethod negate* :and [[_ & subclauses]] (into [:or]  (map negate* subclauses)))
(defmethod negate* :or  [[_ & subclauses]] (into [:and] (map negate* subclauses)))
(defmethod negate* :=   [[_ field value]]  [:!= field value])
(defmethod negate* :!=  [[_ field value]]  [:=  field value])
(defmethod negate* :>   [[_ field value]]  [:<= field value])
(defmethod negate* :<   [[_ field value]]  [:>= field value])
(defmethod negate* :>=  [[_ field value]]  [:<  field value])
(defmethod negate* :<=  [[_ field value]]  [:>  field value])
(defmethod negate* :between [[_ field min max]] [:or [:< field min] [:> field max]])
(defmethod negate* :contains    [clause] [:not clause])
(defmethod negate* :starts-with [clause] [:not clause])
(defmethod negate* :ends-with   [clause] [:not clause])
(mu/defn negate-filter-clause :- mbql.s/Filter
  "Return the logical compliment of an MBQL filter clause, generally without using `:not` (except for the string
  filter clause types). Useful for generating highly optimized filter clauses and for drivers that do not support
  top-level `:not` filter clauses."
  [filter-clause :- mbql.s/Filter]
  (-> filter-clause desugar-filter-clause negate* simplify-compound-filter))
(mu/defn query->source-table-id :- [:maybe ::lib.schema.common/positive-int]
  "Return the source Table ID associated with `query`, if applicable; handles nested queries as well. If `query` is
  `nil`, returns `nil`.
  Throws an Exception when it encounters a unresolved source query (i.e., the `:source-table \"card__id\"`
  form), because it cannot return an accurate result for a query that has not yet been preprocessed."
  {:arglists '([outer-query])}
  [{{source-table-id :source-table, source-query :source-query} :query, query-type :type, :as query} :- [:maybe :map]]
  (cond
    ;; for native queries, there's no source table to resolve
    (not= query-type :query)
    nil
    ;; for MBQL queries with a *native* source query, it's the same story
    (and (nil? source-table-id) source-query (:native source-query))
    nil
    ;; for MBQL queries with an MBQL source query, recurse on the source query and try again
    (and (nil? source-table-id) source-query)
    (recur (assoc query :query source-query))
    ;; if ID is a `card__id` form that can only mean we haven't preprocessed the query and resolved the source query.
    ;; This is almost certainly an accident, so throw an Exception so we can make the proper fixes
    ((every-pred string? (partial re-matches mbql.s/source-table-card-id-regex)) source-table-id)
    (throw
     (ex-info
      (i18n/tru "Error: query''s source query has not been resolved. You probably need to `preprocess` the query first.")
      {}))
    ;; otherwise resolve the source Table
    :else
    source-table-id))
(mu/defn join->source-table-id :- [:maybe ::lib.schema.common/positive-int]
  "Like `query->source-table-id`, but for a join."
  [join]
  (query->source-table-id {:type :query, :query join}))
(mu/defn add-order-by-clause :- mbql.s/MBQLQuery
  "Add a new `:order-by` clause to an MBQL `inner-query`. If the new order-by clause references a Field that is
  already being used in another order-by clause, this function does nothing."
  [inner-query                                        :- mbql.s/MBQLQuery
   [_ [_ id-or-name :as _field], :as order-by-clause] :- mbql.s/OrderBy]
  (let [existing-fields (set (for [[_ [_ id-or-name]] (:order-by inner-query)]
                               id-or-name))]
    (if (existing-fields id-or-name)
      ;; Field already referenced, nothing to do
      inner-query
      ;; otherwise add new clause at the end
      (update inner-query :order-by (comp vec distinct conj) order-by-clause))))

Dispatch function perfect for use with multimethods that dispatch off elements of an MBQL query. If x is an MBQL clause, dispatches off the clause name; otherwise dispatches off x's class.

(defn dispatch-by-clause-name-or-class
  ([x]
   (letfn [(clause-type [x]
             (when (mbql-clause? x)
               (first x)))
           (mlv2-lib-type [x]
             (when (map? x)
               (:lib/type x)))
           (model-type [#?(:clj x :cljs _x)]
             #?(:clj (models.dispatch/model x)
                :cljs nil))]
     (or
      (clause-type x)
      (mlv2-lib-type x)
      (model-type x)
      (type x))))
  ([x _]
   (dispatch-by-clause-name-or-class x)))
(mu/defn expression-with-name :- mbql.s/FieldOrExpressionDef
  "Return the `Expression` referenced by a given `expression-name`."
  [inner-query expression-name :- [:or :keyword ::lib.schema.common/non-blank-string]]
  (let [allowed-names [(qualified-name expression-name) (keyword expression-name)]]
    (loop [{:keys [expressions source-query]} inner-query, found #{}]
      (or
       ;; look for either string or keyword version of `expression-name` in `expressions`
       (some (partial get expressions) allowed-names)
       ;; otherwise, if we have a source query recursively look in that (do we allow that??)
       (let [found (into found (keys expressions))]
         (if source-query
           (recur source-query found)
           ;; failing that throw an Exception with detailed info about what we tried and what the actual expressions
           ;; were
           (throw (ex-info (i18n/tru "No expression named ''{0}''" (qualified-name expression-name))
                           {:type            :invalid-query
                            :expression-name expression-name
                            :tried           allowed-names
                            :found           found}))))))))
(mu/defn aggregation-at-index :- mbql.s/Aggregation
  "Fetch the aggregation at index. This is intended to power aggregate field references (e.g. [:aggregation 0]).
   This also handles nested queries, which could be potentially ambiguous if multiple levels had aggregations. To
   support nested queries, you'll need to keep tract of how many `:source-query`s deep you've traveled; pass in this
   number to as optional arg `nesting-level` to make sure you reference aggregations at the right level of nesting."
  ([query index]
   (aggregation-at-index query index 0))
  ([query         :- mbql.s/Query
    index         :- ::lib.schema.common/int-greater-than-or-equal-to-zero
    nesting-level :- ::lib.schema.common/int-greater-than-or-equal-to-zero]
   (if (zero? nesting-level)
     (or (nth (get-in query [:query :aggregation]) index)
         (throw (ex-info (i18n/tru "No aggregation at index: {0}" index) {:index index})))
     ;; keep recursing deeper into the query until we get to the same level the aggregation reference was defined at
     (recur {:query (get-in query [:query :source-query])} index (dec nesting-level)))))

Is this ID (presumably of a Metric or Segment) a GA one?

(defn ga-id?
  [id]
  (boolean
   (when ((some-fn string? keyword?) id)
     (re-find #"^ga(id)?:" (name id)))))

Is this metric or segment clause not a Metabase Metric or Segment, but rather a GA one? E.g. something like `[:metric ga:users]`. We want to ignore those because they're not the same thing at all as MB Metrics/Segments and don't correspond to objects in our application DB.

(defn ga-metric-or-segment?
  [[_ id]]
  (ga-id? id))

--------------------------------- Unique names & transforming ags to have names ----------------------------------

Return a function that can be used to uniquify string names. Function maintains an internal counter that will suffix any names passed to it as needed so all results will be unique.

(let [unique-name (unique-name-generator)] [(unique-name "A") (unique-name "B") (unique-name "A")]) ;; -> ["A" "B" "A_2"]

By default, unique aliases are generated for each unique [id original-name] key pair. By default, a unique id is generated for every call, meaning repeated calls to [[unique-name-generator]] with the same original-name will return different unique aliases. If idempotence is desired, the function returned by the generator also has a 2 airity version with the signature

(unique-name-fn id original-name)

for example:

(let [unique-name (unique-name-generator)] [(unique-name :x "A") (unique-name :x "B") (unique-name :x "A") (unique-name :y "A")]) ;; -> ["A" "B" "A" "A_2"]

Finally, [[unique-name-generator]] accepts the following options to further customize behavior:

`:name-key-fn`

Generated aliases are unique by the value of [id (name-key-fn original-name)]; the default is identity, so by default aliases are unique by [id name-key-fn]. Specify something custom here if you want to make the unique aliases unique by some other value, for example to make them unique without regards to case:

(let [f (unique-name-generator :name-key-fn str/lower-case)] [(f "x") (f "X") (f "X")]) ;; -> ["x" "X2" "X3"]

This is useful for databases that treat column aliases as case-insensitive (see #19618 for some examples of this).

`:unique-alias-fn`

The function used to generate a potentially-unique alias given an original alias and unique suffix with the signature

(unique-alias-fn original suffix)

By default, combines them like original_suffix, but you can supply a custom function if you need to change this behavior:

(let [f (unique-name-generator :unique-alias-fn (fn [x y] (format "%s~~%s" y x)))] [(f "x") (f "x")]) ;; -> ["x" "2~~x"]

This is useful if you need to constrain the generated suffix in some way, for example by limiting its length or escaping characters disallowed in a column alias.

Values generated by this function are recursively checked for uniqueness, and will keep trying values a unique value is generated; for this reason the function must return a unique value for every unique input. Use caution when limiting the length of the identifier generated (consider appending a hash in cases like these).

(defn unique-name-generator
  [& {:keys [name-key-fn unique-alias-fn]
      :or   {name-key-fn     identity
             unique-alias-fn (fn [original suffix]
                               (str original \_ suffix))}}]
  (let [id+original->unique (atom {})   ; map of [id original-alias] -> unique-alias
        original->count     (atom {})]  ; map of original-alias -> count
    (fn generate-name
      ([alias]
       (generate-name (gensym) alias))
      ([id original]
       (let [name-key (name-key-fn original)]
         (or
          ;; if we already have generated an alias for this key (e.g. `[id original]`), return it as-is.
          (@id+original->unique [id name-key])
          ;; otherwise generate a new unique alias.
          ;; see if we're the first to try to use this candidate alias. Update the usage count in `original->count`
          (let [total-count (get (swap! original->count update name-key (fnil inc 0)) name-key)]
            (if (= total-count 1)
              ;; if we are the first to do it, record it in `id+original->unique` and return it.
              (do
                (swap! id+original->unique assoc [id name-key] original)
                original)
              ;; otherwise prefix the alias by the current total count (e.g. `id` becomes `id_2`) and recur. If `id_2`
              ;; is unused, it will get returned. Otherwise we'll recursively try `id_2_2`, and so forth.
              (let [candidate (unique-alias-fn original (str total-count))]
                ;; double-check that `unique-alias-fn` isn't doing something silly like truncating the generated alias
                ;; to aggressively or forgetting to include the `suffix` -- otherwise we could end up with an infinite
                ;; loop
                (assert (not= candidate original)
                        (str "unique-alias-fn must return a different string than its input. Input: "
                             (pr-str candidate)))
                (recur id candidate))))))))))
(mu/defn uniquify-names :- [:and
                            [:sequential :string]
                            [:fn
                             {:error/message "sequence of unique strings"}
                             distinct?]]
  "Make the names in a sequence of string names unique by adding suffixes such as `_2`.
     (uniquify-names [\"count\" \"sum\" \"count\" \"count_2\"])
     ;; -> [\"count\" \"sum\" \"count_2\" \"count_2_2\"]"
  [names :- [:sequential :string]]
  (map (unique-name-generator) names))
(def ^:private NamedAggregation
  [:and
   mbql.s/aggregation-options
   [:fn
    {:error/message "`:aggregation-options` with a `:name`"}
    #(:name (nth % 2))]])
(def ^:private UniquelyNamedAggregations
  [:and
   [:sequential NamedAggregation]
   [:fn
    {:error/message "sequence of named aggregations with unique names"}
    (fn [clauses]
      (apply distinct? (for [[_tag _wrapped {ag-name :name}] clauses]
                         ag-name)))]])
(mu/defn uniquify-named-aggregations :- UniquelyNamedAggregations
  "Make the names of a sequence of named aggregations unique by adding suffixes such as `_2`."
  [named-aggregations :- [:sequential NamedAggregation]]
  (let [unique-names (uniquify-names
                      (for [[_ _wrapped-ag {ag-name :name}] named-aggregations]
                        ag-name))]
    (map
     (fn [[_ wrapped-ag options] unique-name]
       [:aggregation-options wrapped-ag (assoc options :name unique-name)])
     named-aggregations
     unique-names)))
(mu/defn pre-alias-aggregations :- [:sequential NamedAggregation]
  "Wrap every aggregation clause in an `:aggregation-options` clause, using the name returned
  by `(aggregation->name-fn ag-clause)` as names for any clauses that do not already have a `:name` in
  `:aggregation-options`.
    (pre-alias-aggregations annotate/aggregation-name
     [[:count] [:count] [:aggregation-options [:sum [:field 1 nil] {:name \"Sum-41\"}]])
    ;; -> [[:aggregation-options [:count] {:name \"count\"}]
           [:aggregation-options [:count] {:name \"count\"}]
           [:aggregation-options [:sum [:field 1 nil]] {:name \"Sum-41\"}]]
  Most often, `aggregation->name-fn` will be something like `annotate/aggregation-name`, but for purposes of keeping
  the `metabase.mbql` module seperate from the `metabase.query-processor` code we'll let you pass that in yourself."
  {:style/indent 1}
  [aggregation->name-fn :- fn?
   aggregations         :- [:sequential mbql.s/Aggregation]]
  (mbql.match/replace aggregations
    [:aggregation-options _ (_ :guard :name)]
    &match
    [:aggregation-options wrapped-ag options]
    [:aggregation-options wrapped-ag (assoc options :name (aggregation->name-fn wrapped-ag))]
    [(_ :guard keyword?) & _]
    [:aggregation-options &match {:name (aggregation->name-fn &match)}]))
(mu/defn pre-alias-and-uniquify-aggregations :- UniquelyNamedAggregations
  "Wrap every aggregation clause in a `:named` clause with a unique name. Combines `pre-alias-aggregations` with
  `uniquify-named-aggregations`."
  {:style/indent 1}
  [aggregation->name-fn :- fn?
   aggregations         :- [:sequential mbql.s/Aggregation]]
  (-> (pre-alias-aggregations aggregation->name-fn aggregations)
      uniquify-named-aggregations))
(defn- safe-min [& args]
  (transduce
   (filter some?)
   (completing
    (fn [acc n]
      (if acc
        (min acc n)
        n)))
   nil
   args))

Calculate the absolute maximum number of results that should be returned by this query (MBQL or native), useful for doing the equivalent of

java.sql.Statement statement = ...; statement.setMaxRows().

to ensure the DB cursor or equivalent doesn't fetch more rows than will be consumed.

This is calculated as follows:

  • If query is MBQL and has a :limit or :page clause, returns appropriate number
  • If query has :constraints with :max-results-bare-rows or :max-results, returns the appropriate number
    • :max-results-bare-rows is returned if set and Query does not have any aggregations
    • :max-results is returned otherwise
  • If none of the above are set, returns nil. In this case, you should use something like the Metabase QP's max-rows-limit
(defn query->max-rows-limit
  [{{:keys [max-results max-results-bare-rows]}                      :constraints
    {limit :limit, aggregations :aggregation, {:keys [items]} :page} :query
    query-type                                                       :type}]
  (let [mbql-limit        (when (= query-type :query)
                            (safe-min items limit))
        constraints-limit (or
                           (when-not aggregations
                             max-results-bare-rows)
                           max-results)]
    (safe-min mbql-limit constraints-limit)))
(defn- remove-empty [x]
  (cond
    (map? x)
    (not-empty (into {} (for [[k v] x
                              :let  [v (remove-empty v)]
                              :when (some? v)]
                          [k v])))
    (sequential? x)
    (not-empty (into (empty x) (filter some? (map remove-empty x))))
    :else
    x))
(mu/defn update-field-options :- mbql.s/Reference
  "Like [[clojure.core/update]], but for the options in a `:field`, `:expression`, or `:aggregation` clause."
  {:arglists '([field-or-ag-ref-or-expression-ref f & args])}
  [[clause-type id-or-name opts] :- mbql.s/Reference f & args]
  (let [opts (not-empty (remove-empty (apply f opts args)))]
    ;; `:field` clauses should have a `nil` options map if there are no options. `:aggregation` and `:expression`
    ;; should get the arg removed if it's `nil` or empty. (For now. In the future we may change this if we make the
    ;; 3-arg versions the "official" normalized versions.)
    (cond
      opts                   [clause-type id-or-name opts]
      (= clause-type :field) [clause-type id-or-name nil]
      :else                  [clause-type id-or-name])))

Like [[clojure.core/assoc]], but for the options in a :field, :expression, or :aggregation clause.

(defn assoc-field-options
  [clause & kvs]
  (apply update-field-options clause assoc kvs))

Set the :temporal-unit of a :field clause to unit.

(defn with-temporal-unit
  [[_ _ {:keys [base-type]} :as clause] unit]
  ;; it doesn't make sense to call this on an `:expression` or `:aggregation`.
  (assert (is-clause? :field clause))
  (if (or (not base-type)
          (mbql.s/valid-temporal-unit-for-base-type? base-type unit))
    (assoc-field-options clause :temporal-unit unit)
    (do
      (log/warn (i18n/tru "{0} is not a valid temporal unit for {1}; not adding to clause {2}"
                          unit base-type (pr-str clause)))
      clause)))

Update a :field, :expression reference, or :aggregation reference clause by removing all namespaced keys in the options map. This is mainly for clause equality comparison purposes -- in current usage namespaced keys are used by individual pieces of middleware or driver implementations for tracking little bits of information that should not be considered relevant when comparing clauses for equality.

(defn remove-namespaced-options
  [field-or-ref]
  (update-field-options field-or-ref (partial into {} (remove (fn [[k _]]
                                                                (qualified-keyword? k))))))

Find all the :field references with integer IDs in coll, which can be a full MBQL query, a snippet of MBQL, or a sequence of those things; return a set of Field IDs. Includes Fields referenced indirectly via :source-field. Returns nil if no IDs are found.

(defn referenced-field-ids
  [coll]
  (not-empty
   (into #{}
         (comp cat (filter some?))
         (mbql.match/match coll
           [:field (id :guard integer?) opts]
           [id (:source-field opts)]))))

Find the forms matching pred, returns a list of tuples of location (as used in get-in) and the match.

(defn matching-locations
  [form pred]
  (loop [stack [[[] form]], matches []]
    (if-let [[loc form :as top] (peek stack)]
      (let [stack (pop stack)
            onto-stack #(into stack (map (fn [[k v]] [(conj loc k) v])) %)]
        (cond
          (pred form)        (recur stack                                  (conj matches top))
          (map? form)        (recur (onto-stack form)                      matches)
          (sequential? form) (recur (onto-stack (map-indexed vector form)) matches)
          :else              (recur stack                                  matches)))
      matches)))
#?(:clj
   (p/import-vars
    [mbql.match
     match
     match-one
     replace
     replace-in]))
 

Common utility functions useful throughout the codebase.

(ns metabase.util
  (:require
   [camel-snake-kebab.internals.macros :as csk.macros]
   [clojure.data :refer [diff]]
   [clojure.pprint :as pprint]
   [clojure.set :as set]
   [clojure.string :as str]
   [clojure.walk :as walk]
   [flatland.ordered.map :refer [ordered-map]]
   [medley.core :as m]
   [metabase.shared.util.i18n :refer [tru] :as i18n]
   [metabase.shared.util.namespaces :as u.ns]
   [metabase.util.format :as u.format]
   [metabase.util.log :as log]
   [metabase.util.memoize :as memoize]
   [net.cgrand.macrovich :as macros]
   [weavejester.dependency :as dep]
   #?@(:clj  ([clojure.math.numeric-tower :as math]
              [me.flowthing.pp :as pp]
              [metabase.config :as config]
              #_{:clj-kondo/ignore [:discouraged-namespace]}
              [metabase.util.jvm :as u.jvm]
              [metabase.util.string :as u.str]
              [potemkin :as p]
              [ring.util.codec :as codec])))
  #?(:clj (:import
           (java.text Normalizer Normalizer$Form)
           (java.util Locale)
           (org.apache.commons.validator.routines RegexValidator UrlValidator)))
  #?(:cljs (:require-macros [camel-snake-kebab.internals.macros :as csk.macros]
                            [metabase.util])))
(u.ns/import-fns
  [u.format colorize format-bytes format-color format-milliseconds format-nanoseconds format-seconds])
#?(:clj (p/import-vars [u.jvm
                        all-ex-data
                        auto-retry
                        decode-base64
                        decode-base64-to-bytes
                        deref-with-timeout
                        encode-base64
                        filtered-stacktrace
                        full-exception-chain
                        generate-nano-id
                        host-port-up?
                        host-up?
                        ip-address?
                        metabase-namespace-symbols
                        sorted-take
                        varargs
                        with-timeout
                        with-us-locale]
                       [u.str
                        build-sentence]))

Like or, but determines truthiness with pred.

(defmacro or-with
  {:style/indent 1}
  [pred & more]
  (reduce (fn [inner value]
            `(let [value# ~value]
               (if (~pred value#)
                 value#
                 ~inner)))
          nil
          (reverse more)))

Simple macro which wraps the given expression in a try/catch block and ignores the exception if caught.

(defmacro ignore-exceptions
  {:style/indent 0}
  [& body]
  `(try ~@body (catch ~(macros/case
                         :cljs 'js/Error
                         :clj  'Throwable)
                      ~'_)))

Execute first-form, then any other expressions in body, presumably for side-effects; return the result of first-form.

(def numbers (atom []))

(defn find-or-add [n] (or (first-index-satisfying (partial = n) @numbers) (prog1 (count @numbers) (swap! numbers conj n))))

(find-or-add 100) -> 0 (find-or-add 200) -> 1 (find-or-add 100) -> 0

The result of first-form is bound to the anaphor <>, which is convenient for logging:

(prog1 (some-expression) (println "RESULTS:" <>))

prog1 is an anaphoric version of the traditional macro of the same name in Emacs Lisp and Common Lisp.

Style note: Prefer doto when appropriate, e.g. when dealing with Java objects.

TODO -- maybe renaming this to adoto or doto<> or something would be a little clearer.

(defmacro prog1
  {:style/indent :defn}
  [first-form & body]
  `(let [~'<> ~first-form]
     ~@body
     ~'<>))

Takes a message string and returns a basic exception: [[java.lang.Exception]] on JVM and [[Error]] in JS.

(defn error
  [^String msg]
  #?(:clj  (Exception. msg)
     :cljs (js/Error. msg)))

Return k as a string, qualified by its namespace, if any (unlike name). Handles nil values gracefully as well (also unlike name).

(u/qualified-name :type/FK) -> "type/FK"

(defn qualified-name
  [k]
  (when (some? k)
    (if-let [namespac (when #?(:clj  (instance? clojure.lang.Named k)
                               :cljs (satisfies? INamed k))
                        (namespace k))]
      (str namespac "/" (name k))
      (name k))))

Given a map, returns a new map with all nil values removed.

(defn remove-nils
  [m]
  (m/filter-vals some? m))

Recursively replace the keys in a map with the value of (f key).

(defn recursive-map-keys
  [f m]
  (walk/postwalk
   #(if (map? %)
      (m/map-keys f %)
      %)
   m))

Fixes strings that don't terminate in a period; also accounts for strings that end in :. Used for formatting docs.

(defn add-period
  [s]
  (let [text (str s)]
    (if (or (str/blank? text)
            (#{\. \? \!} (last text)))
      text
      (if (str/ends-with? text ":")
        (str (subs text 0 (- (count text) 1)) ".")
        (str text ".")))))

Locale-agnostic version of [[clojure.string/lower-case]]. [[clojure.string/lower-case]] uses the default locale in conversions, turning ID into ıd, in the Turkish locale. This function always uses the en-US locale.

(defn lower-case-en
  ^String [s]
  (when s
    #?(:clj  (.toLowerCase (str s) (Locale/US))
       :cljs (.toLowerCase (str s)))))

Locale-agnostic version of clojure.string/upper-case. clojure.string/upper-case uses the default locale in conversions, turning id into İD, in the Turkish locale. This function always uses the en-US locale.

(defn upper-case-en
  ^String [s]
  (when s
    #?(:clj  (.toUpperCase (str s) (Locale/US))
       :cljs (.toUpperCase (str s)))))

Locale-agnostic version of [[clojure.string/capitalize]].

(defn capitalize-en
  ^String [^CharSequence s]
  (when-let [s (some-> s str)]
    (if (< (count s) 2)
      (upper-case-en s)
      (str (upper-case-en (subs s 0 1))
           (lower-case-en (subs s 1))))))

define custom CSK conversion functions so we don't run into problems if the system locale is Turkish

so Kondo doesn't complain

(declare ^:private ->kebab-case-en*)
(declare ^:private ->camelCaseEn*)
(declare ^:private ->snake_case_en*)
(declare ^:private ->SCREAMING_SNAKE_CASE_EN*)
(csk.macros/defconversion "kebab-case-en*"           lower-case-en lower-case-en "-")
(csk.macros/defconversion "camelCaseEn*"             lower-case-en capitalize-en "")
(csk.macros/defconversion "snake_case_en*"           lower-case-en lower-case-en "_")
(csk.macros/defconversion "SCREAMING_SNAKE_CASE_EN*" upper-case-en upper-case-en "_")

Wrap a CSK defconversion function so that it handles nil and namespaced keywords, which it doesn't support out of the box for whatever reason.

(defn- wrap-csk-conversion-fn-to-handle-nil-and-namespaced-keywords
  [f]
  (fn [x]
    (when x
      (if (qualified-keyword? x)
        (keyword (f (namespace x)) (f (name x)))
        (f x)))))

Like [[camel-snake-kebab.core/->kebab-case]], but always uses English for lower-casing, supports keywords with namespaces, and returns nil when passed nil (rather than throwing an exception).

(def ^{:arglists '([x])} ->kebab-case-en
  (memoize/lru (wrap-csk-conversion-fn-to-handle-nil-and-namespaced-keywords ->kebab-case-en*) :lru/threshold 256))

Like [[camel-snake-kebab.core/->snake_case]], but always uses English for lower-casing, supports keywords with namespaces, and returns nil when passed nil (rather than throwing an exception).

(def ^{:arglists '([x])} ->snake_case_en
  (memoize/lru (wrap-csk-conversion-fn-to-handle-nil-and-namespaced-keywords ->snake_case_en*) :lru/threshold 256))

Like [[camel-snake-kebab.core/->camelCase]], but always uses English for upper- and lower-casing, supports keywords with namespaces, and returns nil when passed nil (rather than throwing an exception).

(def ^{:arglists '([x])} ->camelCaseEn
  (memoize/lru (wrap-csk-conversion-fn-to-handle-nil-and-namespaced-keywords ->camelCaseEn*) :lru/threshold 256))

Like [[camel-snake-kebab.core/->SCREAMINGSNAKECASE]], but always uses English for upper- and lower-casing, supports keywords with namespaces, and returns nil when passed nil (rather than throwing an exception).

(def ^{:arglists '([x])} ->SCREAMING_SNAKE_CASE_EN
  (memoize/lru (wrap-csk-conversion-fn-to-handle-nil-and-namespaced-keywords ->SCREAMING_SNAKE_CASE_EN*)
               :lru/threshold 256))

Like string/capitalize, only it ignores the rest of the string to retain case-sensitive capitalization, e.g., PostgreSQL.

(defn capitalize-first-char
  [s]
  (if (< (count s) 2)
    (upper-case-en s)
    (str (upper-case-en (subs s 0 1))
         (subs s 1))))

Convert the keys in a map from kebab-case to snake_case.

(defn snake-keys
  [m]
  (recursive-map-keys ->snake_case_en m))

Given any map-like object, return it as a Clojure map with :kebab-case keyword keys. The input map can be a: - Clojure map with string or keyword keys, - JS object (with string keys) The keys are converted to kebab-case from camelCase or snake_case as necessary, and turned into keywords.

Returns an empty map if nil is input (like [[update-keys]]).

(defn normalize-map
  [m]
  (let [base #?(:clj  m
                ;; If we're running in CLJS, convert to a ClojureScript map as needed.
                :cljs (if (object? m)
                        (js->clj m)
                        m))]
    (update-keys base (comp keyword ->kebab-case-en))))

Log the maximum memory available to the JVM at launch time as well since it is very handy for debugging things

#?(:clj
   (when-not *compile-files*
     (log/info (i18n/trs "Maximum memory available to JVM: {0}" (u.format/format-bytes (.maxMemory (Runtime/getRuntime)))))))

Set the default width for pprinting to 120 instead of 72. The default width is too narrow and wastes a lot of space

#?(:clj  (alter-var-root #'pprint/*print-right-margin* (constantly 120))
   :cljs (set! pprint/*print-right-margin* (constantly 120)))

Is s a valid email address string?

(defn email?
  ^Boolean [^String s]
  (boolean (when (string? s)
             (re-matches #"[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?"
                         (lower-case-en s)))))

Is s a state string?

(defn state?
  ^Boolean [s]
  (boolean
   (when (string? s)
     (contains? #{"alabama" "alaska" "arizona" "arkansas" "california" "colorado" "connecticut" "delaware"
                  "florida" "georgia" "hawaii" "idaho" "illinois" "indiana" "iowa" "kansas" "kentucky" "louisiana"
                  "maine" "maryland" "massachusetts" "michigan" "minnesota" "mississippi" "missouri" "montana"
                  "nebraska" "nevada" "new hampshire" "new jersey" "new mexico" "new york" "north carolina"
                  "north dakota" "ohio" "oklahoma" "oregon" "pennsylvania" "rhode island" "south carolina"
                  "south dakota" "tennessee" "texas" "utah" "vermont" "virginia" "washington" "west virginia"
                  "wisconsin" "wyoming"
                  "ak" "al" "ar" "az" "ca" "co" "ct" "de" "fl" "ga" "hi" "ia" "id" "il" "in" "ks" "ky" "la"
                  "ma" "md" "me" "mi" "mn" "mo" "ms" "mt" "nc" "nd" "ne" "nh" "nj" "nm" "nv" "ny" "oh" "ok"
                  "or" "pa" "ri" "sc" "sd" "tn" "tx" "ut" "va" "vt" "wa" "wi" "wv" "wy"}
                (lower-case-en s)))))
(def ^:private ^String url-regex-pattern
  (let [alpha #?(:clj "IsAlphabetic" :cljs "Alphabetic")]
    (str "^[\\p{" alpha "}\\d_\\-]+(\\.[\\p{" alpha "}\\d_\\-]+)*(:\\d*)?")))

Is s a valid HTTP/HTTPS URL string?

(defn url?
  ^Boolean [s]
  #?(:clj  (let [validator (UrlValidator. (u.jvm/varargs String ["http" "https"])
                                          (RegexValidator. url-regex-pattern)
                                          UrlValidator/ALLOW_LOCAL_URLS)]
             (.isValid validator (str s)))
     :cljs (try
             (let [url (js/URL. (str s))]
               (boolean (and (re-matches (js/RegExp. url-regex-pattern "u")
                                         (.-host url))
                             (#{"http:" "https:"} (.-protocol url)))))
             (catch js/Error _
               false))))

Returns true if X is nil, otherwise calls (F X). This can be used to see something is either nil or statisfies a predicate function:

(string? nil) -> false (string? "A") -> true (maybe? string? nil) -> true (maybe? string? "A") -> true

It can also be used to make sure a given function won't throw a NullPointerException:

(str/lower-case nil) -> NullPointerException (str/lower-case "ABC") -> "abc" (maybe? str/lower-case nil) -> true (maybe? str/lower-case "ABC") -> "abc"

The latter use-case can be useful for things like sorting where some values in a collection might be nil:

(sort-by (partial maybe? s/lower-case) some-collection)

(defn maybe?
  [f x]
  (or (nil? x)
      (f x)))

Returns the emoji-string passed in if emoji in logs are enabled, otherwise always returns an empty string.

(def ^String ^{:arglists '([emoji-string])} emoji
  #?(:clj  (if (config/config-bool :mb-emoji-in-logs)
             identity
             (constantly ""))
     :cljs (constantly "")))

Round (presumabily floating-point) number to decimal-place. Returns a Double.

Rounds by decimal places, no matter how many significant figures the number has. See [[round-to-precision]].

(round-to-decimals 2 35.5058998M) -> 35.51

(defn round-to-decimals
  ^Double [^Integer decimal-place, ^Number number]
  {:pre [(integer? decimal-place) (number? number)]}
  #?(:clj  (double (.setScale (bigdec number) decimal-place BigDecimal/ROUND_HALF_UP))
     :cljs (parse-double (.toFixed number decimal-place))))

Is x a real number (i.e. not a NaN or an Infinity)?

(defn real-number?
  [x]
  (and (number? x)
       (not (NaN? x))
       (not (infinite? x))))

Return a version of s with diacritical marks removed.

(defn remove-diacritical-marks
  ^String [^String s]
  (when (seq s)
    #?(:clj  (str/replace
               ;; First, "decompose" the characters. e.g. replace 'LATIN CAPITAL LETTER A WITH ACUTE' with
               ;; 'LATIN CAPITAL LETTER A' + 'COMBINING ACUTE ACCENT'
               ;; See http://docs.oracle.com/javase/8/docs/api/java/text/Normalizer.html
              (Normalizer/normalize s Normalizer$Form/NFD)
               ;; next, remove the combining diacritical marks -- this SO answer explains what's going on here best:
               ;; http://stackoverflow.com/a/5697575/1198455 The closest thing to a relevant JavaDoc I could find was
               ;; http://docs.oracle.com/javase/7/docs/api/java/lang/Character.UnicodeBlock.html#COMBINING_DIACRITICAL_MARKS
              #"\p{Block=CombiningDiacriticalMarks}+"
              "")
       :cljs (-> s
                 (.normalize "NFKD")  ;; Renders accented characters as base + accent.
                 (.replace (js/RegExp. "[\u0300-\u036f]" "gu") ""))))) ;; Drops all the accents.

Drops all the accents.

Valid ASCII characters for URL slugs generated by slugify.

(def ^:private slugify-valid-chars
  #{\a \b \c \d \e \f \g \h \i \j \k \l \m \n \o \p \q \r \s \t \u \v \w \x \y \z
    \0 \1 \2 \3 \4 \5 \6 \7 \8 \9
    \_})

unfortunately it seems that this doesn't fully-support Emoji :(, they get encoded as "??"

(defn- slugify-char [^Character c url-encode?]
  (if (< #?(:clj (int c) :cljs (.charCodeAt c 0))
         128)
    ;; ASCII characters must be in the valid list, or they get replaced with underscores.
    (if (contains? slugify-valid-chars c)
      c
      \_)
    ;; Non-ASCII characters are URL-encoded or preserved, based on the option.
    (if url-encode?
      #?(:clj  (codec/url-encode c)
         :cljs (js/encodeURIComponent c))
      c)))

Return a version of String s appropriate for use as a URL slug. Downcase the name and remove diacritcal marks, and replace non-alphanumeric ASCII characters with underscores.

If unicode? is falsy (the default), URL-encode non-ASCII characters. With unicode? truthy, non-ASCII characters are preserved. (Even when we want full ASCII output for eg. URL slugs, non-ASCII characters should be encoded rather than replaced with underscores in order to support languages that don't use the Latin alphabet; see metabase#3818).

Optionally specify :max-length which will truncate the slug after that many characters.

(defn slugify
  (^String [^String s]
   (slugify s {}))
  (^String [s {:keys [max-length unicode?]}]
   (when (seq s)
     (let [slug (str/join (for [c (remove-diacritical-marks (lower-case-en s))]
                            (slugify-char c (not unicode?))))]
       (if max-length
         (str/join (take max-length slug))
         slug)))))

If passed an integer ID, returns it. If passed a map containing an :id key, returns the value if it is an integer. Otherwise returns nil.

Provided as a convenience to allow model-layer functions to easily accept either an object or raw ID. Use this in cases where the ID/object is allowed to be nil. Use the-id below in cases where you would also like to guarantee it is non-nil.

(defn id
  ^Integer [object-or-id]
  (cond
    (map? object-or-id)     (recur (:id object-or-id))
    (integer? object-or-id) object-or-id))

If passed an integer ID, returns it. If passed a map containing an :id key, returns the value if it is an integer. Otherwise, throws an Exception.

Provided as a convenience to allow model-layer functions to easily accept either an object or raw ID, and to assert that you have a valid ID.

(defn the-id
  ;; TODO - lots of functions can be rewritten to use this, which would make them more flexible
  ^Integer [object-or-id]
  (or (id object-or-id)
      (throw (error (tru "Not something with an ID: {0}" (pr-str object-or-id))))))

A regular expression for matching canonical string representations of UUIDs.

(def ^java.util.regex.Pattern uuid-regex
  #"[a-f0-9]{8}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{12}")

Wraps a single element in a sequence; returns sequences as-is. In lots of situations we'd like to accept either a single value or a collection of values as an argument to a function, and then loop over them; rather than repeat logic to check whether something is a collection and wrap if not everywhere, this utility function is provided for your convenience.

(u/one-or-many 1) ; -> [1] (u/one-or-many [1 2]) ; -> [1 2]

(defn one-or-many
  [arg]
  (if ((some-fn sequential? set? nil?) arg)
    arg
    [arg]))

Returns coll if it has multiple elements, or else returns its only element

(defn many-or-one
  [coll]
  (if (next coll)
    coll
    (first coll)))

Like select-keys, but can also handle nested keypaths:

(select-nested-keys {:a 100, :b {:c 200, :d 300}} [:a [:b :d] :c]) ;; -> {:a 100, :b {:d 300}}

The values of keyseq can be either regular keys, which work the same way as select-keys, or vectors of the form [k & nested-keys], which call select-nested-keys recursively on the value of k.

(defn select-nested-keys
  [m keyseq]
  ;; TODO - use (empty m) once supported by model instances
  (into {} (for [k     keyseq
                 :let  [[k & nested-keys] (one-or-many k)
                        v                 (get m k)]
                 :when (contains? m k)]
             {k (if-not (seq nested-keys)
                  v
                  (select-nested-keys v nested-keys))})))

Is s a Base-64 encoded string?

(defn base64-string?
  ^Boolean [s]
  (boolean (when (string? s)
             (as-> s s
               (str/replace s #"\s" "")
               (re-matches #"^(?:[A-Za-z0-9+/]{4})*(?:[A-Za-z0-9+/]{2}==|[A-Za-z0-9+/]{3}=)?$" s)))))

Returns coll split into seqs of up to n items

(defn batches-of
  [n coll]
  (partition n n nil coll))

Increment n if it is non-nil, otherwise return 1 (e.g. as if incrementing 0).

(def ^{:arglists '([n])} safe-inc
  (fnil inc 0))

Like select-keys, but returns a map only containing keys in KS that are present and non-nil in M.

(select-non-nil-keys {:a 100, :b nil} #{:a :b :c}) ;; -> {:a 100}

(defn select-non-nil-keys
  [m ks]
  (into {} (for [k     ks
                 :when (some? (get m k))]
             {k (get m k)})))

Returns a map that only contains keys that are either :present or :non-nil. Combines behavior of select-keys and select-non-nil-keys. This is useful for API endpoints that update a model, which often have complex rules about what gets updated (some keys are updated if nil, others only if non-nil).

(select-keys-when {:a 100, :b nil, :d 200, :e nil} :present #{:a :b :c} :non-nil #{:d :e :f}) ;; -> {:a 100, :b nil, :d 200}

(defn select-keys-when
  {:style/indent 1}
  [m & {:keys [present non-nil], :as options}]
  {:pre [(every? #{:present :non-nil} (keys options))]}
  (merge (select-keys m present)
         (select-non-nil-keys m non-nil)))

Return the order of magnitude as a power of 10 of a given number.

(defn order-of-magnitude
  [x]
  (if (zero? x)
    0
    #?(:clj  (long (math/floor (/ (Math/log (math/abs x))
                                  (Math/log 10))))
       :cljs (js/Math.floor (/ (js/Math.log (abs x))
                               (js/Math.log 10))))))

Like clojure.core/update but does not create a new key if it does not exist. Useful when you don't want to create cruft.

(defn update-if-exists
  [m k f & args]
  (if (contains? m k)
    (apply update m k f args)
    m))

Like clojure.core/update-in but does not create new keys if they do not exist. Useful when you don't want to create cruft.

(defn update-in-if-exists
  [m ks f & args]
  (if (not= ::not-found (get-in m ks ::not-found))
    (apply update-in m ks f args)
    m))

Return index of the first element in coll for which pred reutrns true.

(defn index-of
  [pred coll]
  (first (keep-indexed (fn [i x]
                         (when (pred x) i))
                       coll)))

Returns truthy if new-value is a hexadecimal-string

(defn hexadecimal-string?
  [new-value]
  (and (string? new-value)
       (re-matches #"[0-9a-f]{64}" new-value)))

Topologically sorts vertexs in graph g. Graph is a map of vertexs to edges. Optionally takes an additional argument edges-fn, a function used to extract edges. Returns data in the same shape (a graph), only sorted.

Say you have a graph shaped like:

a b | \ | c | | \ | / d | e

(u/topological-sort identity {:b [] :c [:a] :e [:d] :d [:a :b :c] :a []})

=> (ordered-map :a [] :b [] :c [:a] :d [:a :b :c] :e [:d])

If the graph has cycles, throws an exception.

https://en.wikipedia.org/wiki/Topological_sorting

(defn topological-sort
  "Topologically sorts vertexs in graph g. Graph is a map of vertexs to edges. Optionally takes an
   additional argument `edges-fn`, a function used to extract edges. Returns data in the same shape
   (a graph), only sorted.
   Say you have a graph shaped like:
     a     b
     | \\  |
     c  |  |
     \\ | /
        d
        |
        e
   (u/topological-sort identity {:b []
                                 :c [:a]
                                 :e [:d]
                                 :d [:a :b :c]
                                 :a []})
   => (ordered-map :a [] :b [] :c [:a] :d [:a :b :c] :e [:d])
   If the graph has cycles, throws an exception.
   https://en.wikipedia.org/wiki/Topological_sorting"
  ([g] (topological-sort identity g))
  ([edges-fn g]
   (transduce (map (juxt key (comp edges-fn val)))
              (fn
                ([] (dep/graph))
                ([acc [vertex edges]]
                 (reduce (fn [acc edge]
                           (dep/depend acc vertex edge))
                         acc
                         edges))
                ([acc]
                 (let [sorted      (filter g (dep/topo-sort acc))
                       independent (set/difference (set (keys g)) (set sorted))]
                   (not-empty
                    (into (ordered-map)
                          (map (fn [vertex]
                                 [vertex (g vertex)]))
                          (concat independent sorted))))))
              g)))

Changes the keys of a given map to lower case.

(defn lower-case-map-keys
  [m]
  (update-keys m #(-> % name lower-case-en keyword)))

Returns the output of pretty-printing x as a string. Optionally accepts color-symb, which colorizes the output (JVM only, it's ignored in CLJS).

(pprint-to-str 'green some-obj)

(defn pprint-to-str
  (^String [x]
   (#?@
    (:clj
     (with-out-str
       #_{:clj-kondo/ignore [:discouraged-var]}
       (pp/pprint x {:max-width 120}))
     :cljs
     ;; we try to set this permanently above, but it doesn't seem to work in Cljs, so just bind it every time. The
     ;; default value wastes too much space, 120 is a little easier to read actually.
     (binding [pprint/*print-right-margin* 120]
       (with-out-str
         #_{:clj-kondo/ignore [:discouraged-var]}
         (pprint/pprint x))))))
  (^String [color-symb x]
   (u.format/colorize color-symb (pprint-to-str x))))

Impl for profile macro -- don't use this directly. Nesting-level for the profile macro e.g. 0 for a top-level profile form or 1 for a form inside that.

(def ^:dynamic *profile-level*
  0)

Impl for [[profile]] macro -- don't use this directly. Prints the ___ took ___ message at the conclusion of a [[profile]]d form.

#_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]}
(defn -profile-print-time
  [message-thunk start-time]
  ;; indent the message according to [[*profile-level*]] and add a little down-left arrow so it (hopefully) points to
  ;; the parent form
  (log/info (u.format/format-color
             (case (int (mod *profile-level* 4))
               0 :green
               1 :cyan
               2 :magenta
               3 :yellow) "%s%s took %s"
             (if (pos? *profile-level*)
               (str (str/join (repeat (dec *profile-level*) "  ")) " ⮦ ")
               "")
             (message-thunk)
             (u.format/format-nanoseconds (- #?(:cljs (* 1000000 (js/performance.now))
                                                :clj  (System/nanoTime))
                                             start-time)))))

Like [[clojure.core/time]], but lets you specify a message that gets printed with the total time, formats the time nicely using u/format-nanoseconds, and indents nested calls to profile.

(profile "top-level" (Thread/sleep 500) (profile "nested" (Thread/sleep 100))) ;; -> ↙ nested took 100.1 ms top-level took 602.8 ms

(defmacro profile
  {:style/indent 1}
  ([form]
   `(profile ~(str form) ~form))
  ([message & body]
   ;; message is wrapped in a thunk so we don't incur the overhead of calculating it if the log level does not include
   ;; INFO
   `(let [message#    (fn [] ~message)
          start-time# ~(if (:ns &env)
                         `(* 1000000 (js/performance.now)) ;; CLJS
                         `(System/nanoTime))               ;; CLJ
          result#     (binding [*profile-level* (inc *profile-level*)]
                        ~@body)]
      (-profile-print-time message# start-time#)
      result#)))

Convert seconds to milliseconds. More readable than doing this math inline.

(defn seconds->ms
  [seconds]
  (* seconds 1000))

Convert minutes to seconds. More readable than doing this math inline.

(defn minutes->seconds
  [minutes]
  (* 60 minutes))

Convert minutes to milliseconds. More readable than doing this math inline.

(defn minutes->ms
  [minutes]
  (-> minutes minutes->seconds seconds->ms))

Convert hours to milliseconds. More readable than doing this math inline.

(defn hours->ms
  [hours]
  (-> (* 60 hours) minutes->seconds seconds->ms))

Parse a currency String to a BigDecimal. Handles a variety of different formats, such as:

$1,000.00 -£127.54 -127,54 € kr-127,54 € 127,54- ¥200

(defn parse-currency
  ^java.math.BigDecimal [^String s]
  (when-not (str/blank? s)
    (#?(:clj bigdec :cljs js/parseFloat)
     (reduce
      (partial apply str/replace)
      s
      [;; strip out any current symbols
       [#"[^\d,.-]+"          ""]
       ;; now strip out any thousands separators
       [#"(?<=\d)[,.](\d{3})" "$1"]
       ;; now replace a comma decimal seperator with a period
       [#","                  "."]
       ;; move minus sign at end to front
       [#"(^[^-]+)-$"         "-$1"]]))))

Extract the domain portion of an email-address.

(email->domain "cam@toucan.farm") ; -> "toucan.farm"

(defn email->domain
  ^String [email-address]
  (when (string? email-address)
    (last (re-find #"^.*@(.*$)" email-address))))

Is email-address in domain?

(email-in-domain? "cam@toucan.farm" "toucan.farm") ; -> true (email-in-domain? "cam@toucan.farm" "metabase.com") ; -> false

(defn email-in-domain?
  [email-address domain]
  {:pre [(email? email-address)]}
  (= (email->domain email-address) domain))

Returns a pair [match others] where match is the first element of coll for which pred returns a truthy value and others is a sequence of the other elements of coll with the order preserved. Returns nil if no element satisfies pred.

(defn pick-first
  [pred coll]
  (loop [xs (seq coll), prefix []]
    (when-let [[x & xs] xs]
      (if (pred x)
        [x (concat prefix xs)]
        (recur xs (conj prefix x))))))

Clj doesn't have regexp?, but Cljs does

#?(:clj (defn- regexp? [x]
          (instance? java.util.regex.Pattern x)))
(derive :dispatch-type/nil        :dispatch-type/*)
(derive :dispatch-type/boolean    :dispatch-type/*)
(derive :dispatch-type/string     :dispatch-type/*)
(derive :dispatch-type/keyword    :dispatch-type/*)
(derive :dispatch-type/number     :dispatch-type/*)
(derive :dispatch-type/integer    :dispatch-type/number)
(derive :dispatch-type/map        :dispatch-type/*)
(derive :dispatch-type/sequential :dispatch-type/*)
(derive :dispatch-type/set        :dispatch-type/*)
(derive :dispatch-type/symbol     :dispatch-type/*)
(derive :dispatch-type/fn         :dispatch-type/*)
(derive :dispatch-type/regex      :dispatch-type/*)

In Cljs (type 1) isjs/Number, but(isa? 1 js/Number)` isn't truthy, so dispatching off of [[clojure.core/type]] doesn't really work the way we'd want. Also, type names are different between Clojure and ClojureScript.

This function exists as a workaround: use it as a multimethod dispatch function for Cljc multimethods that would have dispatched on type if they were written in pure Clojure.

Returns :dispatch-type/* if there is no mapping for the current type, but you can add more as needed if appropriate. All type keywords returned by this method also derive from :dispatch-type/*, meaning you can write an implementation for :dispatch-type/* and use it as a fallback method.

Think of :dispatch-type/* as similar to how you would use Object if you were dispatching off of type in pure Clojure.

(defn dispatch-type-keyword
  [x]
  (cond
    (nil? x)        :dispatch-type/nil
    (boolean? x)    :dispatch-type/boolean
    (string? x)     :dispatch-type/string
    (keyword? x)    :dispatch-type/keyword
    (integer? x)    :dispatch-type/integer
    (number? x)     :dispatch-type/number
    (map? x)        :dispatch-type/map
    (sequential? x) :dispatch-type/sequential
    (set? x)        :dispatch-type/set
    (symbol? x)     :dispatch-type/symbol
    (fn? x)         :dispatch-type/fn
    (regexp? x)     :dispatch-type/regex
    ;; we should add more mappings here as needed
    :else           :dispatch-type/*))

Called like (assoc m k v), this does [[assoc]] if (some? v), and [[dissoc]] if not.

Put another way: k will either be set to v, or removed.

Note that if v is false, it will be handled with [[assoc]]; only nil causes a [[dissoc]].

(defn assoc-dissoc
  [m k v]
  (if (some? v)
    (assoc m k v)
    (dissoc m k)))

Called like (assoc m k v), this does [[assoc]] iff m does not contain k and v is not nil. Can be called with multiple key value pairs. If a key occurs more than once, only the first occurrence with a non-nil value is used.

(defn assoc-default
  ([m k v]
   (if (or (nil? v) (contains? m k))
     m
     (assoc m k v)))
  ([m k v & kvs]
   (let [ret (assoc-default m k v)]
     (if kvs
       (if (next kvs)
         (recur ret (first kvs) (second kvs) (nnext kvs))
         (throw (ex-info "assoc-default expects an even number of key-values"
                         {:kvs kvs})))
       ret))))

Given 2 lists of seq maps of changes, where each map an has an id key, return a map of 3 keys: :to-create, :to-update, :to-delete.

Where: :to-create is a list of maps that ids in new-items :to-update is a list of maps that has ids in both current-items and new-items :to delete is a list of maps that has ids only in current-items

(defn classify-changes
  [current-items new-items]
  (let [[delete-ids create-ids update-ids] (diff (set (map :id current-items))
                                                 (set (map :id new-items)))]
    {:to-create (when (seq create-ids) (filter #(create-ids (:id %)) new-items))
     :to-delete (when (seq delete-ids) (filter #(delete-ids (:id %)) current-items))
     :to-update (when (seq update-ids) (filter #(update-ids (:id %)) new-items))}))

True if collection xs is either [[empty?]] or all values are [[distinct?]].

(defn empty-or-distinct?
  [xs]
  (or (empty? xs)
      (apply distinct? xs)))

Traverses a graph of nodes using a user-defined function.

nodes: A collection of initial nodes to start the traversal from. traverse-fn: A function that, given a node, returns its directly connected nodes.

The function performs a breadth-first traversal starting from the initial nodes, applying traverse-fn to each node to find connected nodes, and continues until all reachable nodes have been visited. Returns a set of all traversed nodes.

(defn traverse
  [nodes traverse-fn]
  (loop [to-traverse (set nodes)
         traversed   #{}]
    (let [item        (first to-traverse)
          found       (traverse-fn item)
          traversed   (conj traversed item)
          to-traverse (set/union (disj to-traverse item) (set/difference found traversed))]
      (if (empty? to-traverse)
        traversed
        (recur to-traverse traversed)))))
 
(ns metabase.lib.util
  (:refer-clojure :exclude [format])
  (:require
   #?@(:clj
       ([potemkin :as p]))
   #?@(:cljs
       (["crc-32" :as CRC32]
        [goog.string :as gstring]
        [goog.string.format :as gstring.format]))
   [clojure.set :as set]
   [clojure.string :as str]
   [medley.core :as m]
   [metabase.lib.common :as lib.common]
   [metabase.lib.dispatch :as lib.dispatch]
   [metabase.lib.hierarchy :as lib.hierarchy]
   [metabase.lib.options :as lib.options]
   [metabase.lib.schema :as lib.schema]
   [metabase.lib.schema.common :as lib.schema.common]
   [metabase.lib.schema.expression :as lib.schema.expression]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.lib.schema.ref :as lib.schema.ref]
   [metabase.mbql.util :as mbql.u]
   [metabase.shared.util.i18n :as i18n]
   [metabase.util :as u]
   [metabase.util.malli :as mu]))
#?(:clj
   (set! *warn-on-reflection* true))

The formatting functionality is only loaded if you depend on goog.string.format.

#?(:cljs (comment gstring.format/keep-me))

;;; For convenience: [[metabase.lib.util/format]] maps to [[clojure.core/format]] in Clj and [[goog.string/format]] in
;;; Cljs. They both work like [[clojure.core/format]], but since that doesn't exist in Cljs, you can use this instead.
#?(:clj
   (p/import-vars [clojure.core format])

   :cljs
   (def format "Exactly like [[clojure.core/format]] but ClojureScript-friendly." gstring/format))

Returns true if this is a clause.

(defn clause?
  [clause]
  (and (vector? clause)
       (keyword? (first clause))
       (let [opts (get clause 1)]
         (and (map? opts)
              (contains? opts :lib/uuid)))))

Returns true if this is a clause.

(defn clause-of-type?
  [clause clause-type]
  (and (clause? clause)
       (= (first clause) clause-type)))

Returns true if this is a field clause.

(defn field-clause?
  [clause]
  (clause-of-type? clause :field))

Returns true if this is any sort of reference clause

(defn ref-clause?
  [clause]
  (and (clause? clause)
       (lib.hierarchy/isa? (first clause) ::lib.schema.ref/ref)))

Returns whether the type of expression isa? typ. If the expression has an original-effective-type due to bucketing, check that.

(defn original-isa?
  [expression typ]
  (isa?
    (or (and (clause? expression)
             (:metabase.lib.field/original-effective-type (second expression)))
        (lib.schema.expression/type-of expression))
    typ))

Returns the :lib/expression-name of clause. Returns nil if clause is not a clause.

(defn expression-name
  [clause]
  (when (clause? clause)
    (:lib/expression-name (lib.options/options clause))))

Top level expressions must be clauses with :lib/expression-name, so if we get a literal, wrap it in :value.

(defn top-level-expression-clause
  [clause a-name]
  (-> (if (clause? clause)
        clause
        [:value {:lib/uuid (str (random-uuid))
                 :effective-type (lib.schema.expression/type-of clause)}
         clause])
      (lib.options/update-options (fn [opts]
                                    (-> opts
                                        (assoc :lib/expression-name a-name)
                                        (dissoc :name :display-name))))))

Implementation for [[custom-name]].

(defmulti custom-name-method
  {:arglists '([x])}
  lib.dispatch/dispatch-value
  :hierarchy lib.hierarchy/hierarchy)

Return the user supplied name of x, if any.

(defn custom-name
  [x]
  (custom-name-method x))
(defmethod custom-name-method :default
  [x]
  ;; We assume that clauses only get a :display-name option if the user explicitly specifies it.
  ;; Expressions from the :expressions clause of pMBQL queries have custom names by default.
  (when (clause? x)
    ((some-fn :display-name :lib/expression-name) (lib.options/options x))))

Replace the target-clause in stage location with new-clause. If a clause has :lib/uuid equal to the target-clause it is swapped with new-clause. If location contains no clause with target-clause no replacement happens.

(defn replace-clause
  [stage location target-clause new-clause]
  {:pre [((some-fn clause? #(= (:lib/type %) :mbql/join)) target-clause)]}
  (let [new-clause (if (= :expressions (first location))
                     (top-level-expression-clause new-clause (or (custom-name new-clause)
                                                             (expression-name target-clause)))
                     new-clause)]
    (m/update-existing-in
     stage
     location
     (fn [clause-or-clauses]
       (->> (for [clause clause-or-clauses]
              (if (= (lib.options/uuid clause) (lib.options/uuid target-clause))
                new-clause
                clause))
            vec)))))

Remove the target-clause in stage location. If a clause has :lib/uuid equal to the target-clause it is removed. If location contains no clause with target-clause no removal happens. If the the location is empty, dissoc it from stage. For the [:fields] location if only expressions remain, dissoc from stage.

(defn remove-clause
  [stage location target-clause stage-number]
  {:pre [(clause? target-clause)]}
  (if-let [target (get-in stage location)]
    (let [target-uuid (lib.options/uuid target-clause)
          [first-loc last-loc] [(first location) (last location)]
          result (into [] (remove (comp #{target-uuid} lib.options/uuid)) target)
          result (when-not (and (= location [:fields])
                                (every? #(clause-of-type? % :expression) result))
                   result)]
      (cond
        (seq result)
        (assoc-in stage location result)
        (= [:joins :conditions] [first-loc last-loc])
        (throw (ex-info (i18n/tru "Cannot remove the final join condition")
                        {:error ::cannot-remove-final-join-condition
                         :conditions (get-in stage location)
                         :join (get-in stage (pop location))
                         :stage-number stage-number
                         :stage stage}))
        (= [:joins :fields] [first-loc last-loc])
        (update-in stage (pop location) dissoc last-loc)
        :else
        (m/dissoc-in stage location)))
    stage))

TODO -- all of this ->pipeline stuff should probably be merged into [[metabase.lib.convert]] at some point in the near future.

Convert a :type :native QP MBQL query to a pMBQL query. See docstring for [[mbql-query->pipeline]] for an explanation of what this means.

(defn- native-query->pipeline
  [query]
  (merge {:lib/type :mbql/query
          ;; we're using `merge` here instead of threading stuff so the `:lib/` keys are the first part of the map for
          ;; readability in the REPL.
          :stages   [(merge {:lib/type :mbql.stage/native}
                            (set/rename-keys (:native query) {:query :native}))]}
         (dissoc query :type :native)))
(declare inner-query->stages)

Updates m with a legacy boolean expression at legacy-key into a list with an implied and for pMBQL at pMBQL-key

(defn- update-legacy-boolean-expression->list
  [m legacy-key pMBQL-key]
  (cond-> m
    (contains? m legacy-key) (update legacy-key #(if (and (vector? %)
                                                       (= (first %) :and))
                                                   (vec (drop 1 %))
                                                   [%]))
    (contains? m legacy-key) (set/rename-keys {legacy-key pMBQL-key})))
(defn- join->pipeline [join]
  (let [source (select-keys join [:source-table :source-query])
        stages (inner-query->stages source)]
    (-> join
        (dissoc :source-table :source-query)
        (update-legacy-boolean-expression->list :condition :conditions)
        (assoc :lib/type :mbql/join
               :stages stages)
        lib.options/ensure-uuid)))
(defn- joins->pipeline [joins]
  (mapv join->pipeline joins))

Convert legacy :source-metadata to [[metabase.lib.metadata/StageMetadata]].

(defn ->stage-metadata
  [source-metadata]
  (when source-metadata
    (-> (if (seqable? source-metadata)
          {:columns source-metadata}
          source-metadata)
        (update :columns (fn [columns]
                           (mapv (fn [column]
                                   (-> column
                                       (update-keys u/->kebab-case-en)
                                       (assoc :lib/type :metadata/column)))
                                 columns)))
        (assoc :lib/type :metadata/results))))
(defn- inner-query->stages [{:keys [source-query source-metadata], :as inner-query}]
  (let [previous-stages (if source-query
                          (inner-query->stages source-query)
                          [])
        source-metadata (->stage-metadata source-metadata)
        previous-stage  (dec (count previous-stages))
        previous-stages (cond-> previous-stages
                          (and source-metadata
                               (not (neg? previous-stage))) (assoc-in [previous-stage :lib/stage-metadata] source-metadata))
        stage-type      (if (:native inner-query)
                          :mbql.stage/native
                          :mbql.stage/mbql)
        ;; we're using `merge` here instead of threading stuff so the `:lib/` keys are the first part of the map for
        ;; readability in the REPL.
        this-stage      (merge {:lib/type stage-type}
                               (dissoc inner-query :source-query :source-metadata))
        this-stage      (cond-> this-stage
                          (seq (:joins this-stage)) (update :joins joins->pipeline)
                          :always (update-legacy-boolean-expression->list :filter :filters))]
    (conj previous-stages this-stage)))

Convert a :type :query QP MBQL (i.e., MBQL as currently understood by the Query Processor, or the JS MLv1) to a pMBQL query. The key difference is that instead of having a :query with a :source-query with a :source-query and so forth, you have a vector of :stages where each stage serves as the source query for the next stage. Initially this was an implementation detail of a few functions, but it's easier to visualize and manipulate, so now all of MLv2 deals with pMBQL. See this Slack thread https://metaboat.slack.com/archives/C04DN5VRQM6/p1677118410961169?thread_ts=1677112778.742589&cid=C04DN5VRQM6 for more information.

(defn- mbql-query->pipeline
  [query]
  (merge {:lib/type :mbql/query
          :stages   (inner-query->stages (:query query))}
         (dissoc query :type :query)))

Schema for a map that is either a legacy query OR a pMBQL query.

(def LegacyOrPMBQLQuery
  [:or
   [:map
    {:error/message "legacy query"}
    [:type [:enum :native :query]]]
   [:map
    {:error/message "pMBQL query"}
    [:lib/type [:= :mbql/query]]]])

Ensure that a query is in the general shape of a pMBQL query. This doesn't walk the query and fix everything! The goal here is just to make sure we have :stages in the correct place and the like. See [[metabase.lib.convert]] for functions that actually ensure all parts of the query match the pMBQL schema (they use this function as part of that process.)

(mu/defn pipeline
  [query :- LegacyOrPMBQLQuery]
  (if (= (:lib/type query) :mbql/query)
    query
    (case (:type query)
      :native (native-query->pipeline query)
      :query  (mbql-query->pipeline query))))
(mu/defn canonical-stage-index :- [:int {:min 0}]
  "If `stage-number` index is a negative number e.g. `-1` convert it to a positive index so we can use `nth` on
  `stages`. `-1` = the last stage, `-2` = the penultimate stage, etc."
  [{:keys [stages], :as _query} :- :map
   stage-number                 :- :int]
  (let [stage-number' (if (neg? stage-number)
                        (+ (count stages) stage-number)
                        stage-number)]
    (when (or (>= stage-number' (count stages))
              (neg? stage-number'))
      (throw (ex-info (i18n/tru "Stage {0} does not exist" stage-number)
                      {:num-stages (count stages)})))
    stage-number'))
(mu/defn previous-stage-number :- [:maybe [:int {:min 0}]]
  "The index of the previous stage, if there is one. `nil` if there is no previous stage."
  [query        :- :map
   stage-number :- :int]
  (let [stage-number (canonical-stage-index query stage-number)]
    (when (pos? stage-number)
      (dec stage-number))))

Whether a stage-number is referring to the first stage of a query or not.

(defn first-stage?
  [query stage-number]
  (not (previous-stage-number query stage-number)))
(mu/defn next-stage-number :- [:maybe :int]
  "The index of the next stage, if there is one. `nil` if there is no next stage."
  [{:keys [stages], :as _query} :- :map
   stage-number                 :- :int]
  (let [stage-number (if (neg? stage-number)
                       (+ (count stages) stage-number)
                       stage-number)]
    (when (< (inc stage-number) (count stages))
      (inc stage-number))))
(mu/defn query-stage :- [:maybe ::lib.schema/stage]
  "Fetch a specific `stage` of a query. This handles negative indices as well, e.g. `-1` will return the last stage of
  the query."
  [query        :- LegacyOrPMBQLQuery
   stage-number :- :int]
  (let [{:keys [stages], :as query} (pipeline query)]
    (get (vec stages) (canonical-stage-index query stage-number))))
(mu/defn previous-stage :- [:maybe ::lib.schema/stage]
  "Return the previous stage of the query, if there is one; otherwise return `nil`."
  [query stage-number :- :int]
  (when-let [stage-num (previous-stage-number query stage-number)]
    (query-stage query stage-num)))
(mu/defn update-query-stage :- ::lib.schema/query
  "Update a specific `stage-number` of a `query` by doing
    (apply f stage args)
  `stage-number` can be a negative index, e.g. `-1` will update the last stage of the query."
  [query        :- LegacyOrPMBQLQuery
   stage-number :- :int
   f & args]
  (let [{:keys [stages], :as query} (pipeline query)
        stage-number'               (canonical-stage-index query stage-number)
        stages'                     (apply update (vec stages) stage-number' f args)]
    (assoc query :stages stages')))
(mu/defn ensure-mbql-final-stage :- ::lib.schema/query
  "Convert query to a pMBQL (pipeline) query, and make sure the final stage is an `:mbql` one."
  [query]
  (let [query (pipeline query)]
    (cond-> query
      (= (:lib/type (query-stage query -1)) :mbql.stage/native)
      (update :stages conj {:lib/type :mbql.stage/mbql}))))

This is basically [[clojure.string/join]] but uses commas to join everything but the last two args, which are joined by a string conjunction. Uses Oxford commas for > 2 args.

(join-strings-with-conjunction "and" ["X" "Y" "Z"]) ;; => "X, Y, and Z"

(defn join-strings-with-conjunction
  [conjunction coll]
  (when (seq coll)
    (if (= (count coll) 1)
      (first coll)
      (let [conjunction (str \space (str/trim conjunction) \space)]
        (if (= (count coll) 2)
          ;; exactly 2 args: X and Y
          (str (first coll) conjunction (second coll))
          ;; > 2 args: X, Y, and Z
          (str
           (str/join ", " (butlast coll))
           ","
           conjunction
           (last coll)))))))
(mu/defn ^:private string-byte-count :- [:int {:min 0}]
  "Number of bytes in a string using UTF-8 encoding."
  [s :- :string]
  #?(:clj (count (.getBytes (str s) "UTF-8"))
     :cljs (.. (js/TextEncoder.) (encode s) -length)))
#?(:clj
   (mu/defn ^:private string-character-at :- [:string {:min 0, :max 1}]
     [s :- :string
      i :-[:int {:min 0}]]
     (str (.charAt ^String s i))))
(mu/defn ^:private truncate-string-to-byte-count :- :string
  "Truncate string `s` to `max-length-bytes` UTF-8 bytes (as opposed to truncating to some number of
  *characters*)."
  [s                :- :string
   max-length-bytes :- [:int {:min 1}]]
  #?(:clj
     (loop [i 0, cumulative-byte-count 0]
       (cond
         (= cumulative-byte-count max-length-bytes) (subs s 0 i)
         (> cumulative-byte-count max-length-bytes) (subs s 0 (dec i))
         (>= i (count s))                           s
         :else                                      (recur (inc i)
                                                           (long (+
                                                                  cumulative-byte-count
                                                                  (string-byte-count (string-character-at s i)))))))
     :cljs
     (let [buf (js/Uint8Array. max-length-bytes)
           result (.encodeInto (js/TextEncoder.) s buf)] ;; JS obj {read: chars_converted, write: bytes_written}
       (subs s 0 (.-read result)))))

Length to truncate column and table identifiers to. See [[metabase.driver.impl/default-alias-max-length-bytes]] for reasoning.

(def ^:private truncate-alias-max-length-bytes
  60)

Length of the hash suffixed to truncated strings by [[truncate-alias]].

(def ^:private truncated-alias-hash-suffix-length
  ;; 8 bytes for the CRC32 plus one for the underscore
  9)
(mu/defn ^:private crc32-checksum :- [:string {:min 8, :max 8}]
  "Return a 4-byte CRC-32 checksum of string `s`, encoded as an 8-character hex string."
  [s :- :string]
  (let [s #?(:clj (Long/toHexString (.getValue (doto (java.util.zip.CRC32.)
                                                 (.update (.getBytes ^String s "UTF-8")))))
             :cljs (-> (CRC32/str s 0)
                       (unsigned-bit-shift-right 0) ; see https://github.com/SheetJS/js-crc32#signed-integers
                       (.toString 16)))]
    ;; pad to 8 characters if needed. Might come out as less than 8 if the first byte is `00` or `0x` or something.
    (loop [s s]
      (if (< (count s) 8)
        (recur (str \0 s))
        s))))
(mu/defn truncate-alias :- [:string {:min 1, :max 60}]
  "Truncate string `s` if it is longer than [[truncate-alias-max-length-bytes]] and append a hex-encoded CRC-32
  checksum of the original string. Truncated string is truncated to [[truncate-alias-max-length-bytes]]
  minus [[truncated-alias-hash-suffix-length]] characters so the resulting string is
  exactly [[truncate-alias-max-length-bytes]]. The goal here is that two really long strings that only differ at the
  end will still have different resulting values.
    (truncate-alias \"some_really_long_string\" 15) ;   -> \"some_r_8e0f9bc2\"
    (truncate-alias \"some_really_long_string_2\" 15) ; -> \"some_r_2a3c73eb\
  ([s]
   (truncate-alias s truncate-alias-max-length-bytes))
  ([s         :- ::lib.schema.common/non-blank-string
    max-bytes :- [:int {:min 0}]]
   (if (<= (string-byte-count s) max-bytes)
     s
     (let [checksum  (crc32-checksum s)
           truncated (truncate-string-to-byte-count s (- max-bytes truncated-alias-hash-suffix-length))]
       (str truncated \_ checksum)))))
(mu/defn legacy-string-table-id->card-id :- [:maybe ::lib.schema.id/card]
  "If `table-id` is a legacy `card__<id>`-style string, parse the `<id>` part to an integer Card ID. Only for legacy
  queries! You don't need to use this in pMBQL since this is converted automatically by [[metabase.lib.convert]] to
  `:source-card`."
  [table-id]
  (when (string? table-id)
    (when-let [[_match card-id-str] (re-find #"^card__(\d+)$" table-id)]
      (parse-long card-id-str))))
(mu/defn source-table-id :- [:maybe ::lib.schema.id/table]
  "If this query has a `:source-table` ID, return it."
  [query]
  (-> query :stages first :source-table))
(mu/defn source-card-id :- [:maybe ::lib.schema.id/card]
  "If this query has a `:source-card` ID, return it."
  [query]
  (-> query :stages first :source-card))
(mu/defn unique-name-generator :- [:=>
                                   [:cat ::lib.schema.common/non-blank-string]
                                   ::lib.schema.common/non-blank-string]
  "Create a new function with the signature
    (f str) => str
  That takes any sort of string identifier (e.g. a column alias or table/join alias) and returns a guaranteed-unique
  name truncated to 60 characters (actually 51 characters plus a hash)."
  []
  (comp truncate-alias
        (mbql.u/unique-name-generator
         ;; unique by lower-case name, e.g. `NAME` and `name` => `NAME` and `name_2`
         :name-key-fn     u/lower-case-en
         ;; truncate alias to 60 characters (actually 51 characters plus a hash).
         :unique-alias-fn (fn [original suffix]
                            (truncate-alias (str original \_ suffix))))))
(def ^:private strip-id-regex
  #?(:cljs (js/RegExp. " id$" "i")
     ;; `(?i)` is JVM-specific magic to turn on the `i` case-insensitive flag.
     :clj  #"(?i) id$"))
(mu/defn strip-id :- :string
  "Given a display name string like \"Product ID\", this will drop the trailing \"ID\" and trim whitespace.
  Used to turn a FK field's name into a pseudo table name when implicitly joining."
  [display-name :- :string]
  (-> display-name
      (str/replace strip-id-regex )
      str/trim))
(mu/defn add-summary-clause :- ::lib.schema/query
  "If the given stage has no summary, it will drop :fields, :order-by, and :join :fields from it,
   as well as any subsequent stages."
  [query :- ::lib.schema/query
   stage-number :- :int
   location :- [:enum :breakout :aggregation]
   a-summary-clause]
  (let [query (pipeline query)
        stage-number (or stage-number -1)
        stage (query-stage query stage-number)
        new-summary? (not (or (seq (:aggregation stage)) (seq (:breakout stage))))
        new-query (update-query-stage
                    query stage-number
                    update location
                    (fn [summary-clauses]
                      (conj (vec summary-clauses) (lib.common/->op-arg a-summary-clause))))]
    (if new-summary?
      (-> new-query
          (update-query-stage
            stage-number
            (fn [stage]
              (-> stage
                  (dissoc :order-by :fields)
                  (m/update-existing :joins (fn [joins] (mapv #(dissoc % :fields) joins))))))
          ;; subvec holds onto references, so create a new vector
          (update :stages (comp #(into [] %) subvec) 0 (inc (canonical-stage-index query stage-number))))
      new-query)))
 

Utility code for dealing with visualization settings, from cards, dashboard cards, etc.

There are two ways of representing the same data, DB form and normalized form. DB form is the "legacy" form, which uses unqualified keywords, which map directly to column names via Toucan. Normalized form, on the other hand, uses namespaced keywords and generally "unwraps" the semantic structures as much as possible.

In general, operations/manipulations should happen on the normalized form, and when the DB form is needed again (ex: for updating the database), the map can be converted back. This can be done fairly easily with the threading macro, ex:

``` (-> (mb.viz/db->norm (:visualization_settings my-card)) tweak-viz-settings tweak-more-viz-settings mb.viz/norm->db) ```

In general, conversion functions in this namespace (i.e. those that convert various pieces from one form to the other) will be prefixed with either db->norm or norm->db, depending on which direction they implement.

(ns metabase.shared.models.visualization-settings
  #?@
   (:clj
    [(:require
      [cheshire.core :as json]
      [clojure.set :as set]
      [clojure.spec.alpha :as s]
      [medley.core :as m]
      [metabase.mbql.normalize :as mbql.normalize])]
    :cljs
    [(:require
      [clojure.set :as set]
      [clojure.spec.alpha :as s]
      [medley.core :as m]
      [metabase.mbql.normalize :as mbql.normalize])]))

-------------------------------------------------- Main API --------------------------------------------------

-------------------------------------------------- Specs --------------------------------------------------

(s/def ::field-id integer?)
(s/def ::column-name string?)

a field reference that is a string, which could be a reference to some named field (ex: output of an aggregation) or to a fully qualified field name (in the context of serialization); we won't attempt to interpret it here, only report that it's a string and set it in the ref map appropriately

(s/def ::field-str string?)
(s/def ::field-metadata (s/or :nil? nil? :map? map?))
(s/def ::column-ref (s/keys :opt [::field-id ::column-name ::field-str ::field-metadata]))
(s/def ::column-settings (s/keys))
(s/def ::click-behavior (s/keys))
(s/def ::visualization-settings (s/keys :opt [::column-settings ::click-behavior]))
(s/def ::field-id-vec (s/tuple #{"ref"}
                               (s/tuple #{"field"}
                                        (s/or :field-id int? :field-str string?)
                                        (s/or :field-metadata map? :nil nil?))))
(s/def ::expression-vec (s/tuple #{"ref"} (s/tuple #{"expression"} string?)))
(s/def ::db-column-ref-vec (s/or :field ::field-id-vec
                                 :expression ::expression-vec
                                 :column-name (s/tuple (partial = "name") string?)))
(s/def ::click-behavior-type keyword? #_(s/or :cross-filter ::cross-filter
                                              :link         ::link))
(s/def ::click-behavior (s/keys :req [::click-behavior-type]
                                :opt [::link-type ::parameter-mapping ::link-template ::link-text ::link-target-id]))

TODO: add more specific shape for this one

(s/def ::parameter-mapping (s/or :nil? nil? :map? map?))

target ID can be the auto generated ID or fully qualified name for serialization

(s/def ::link-target-id (s/or :int int? :fully-qualified-name string?))
(s/def ::link-template string?)
(s/def ::link-text-template string?)
(s/def ::column-title string?)
(s/def ::date-style #{"M/D/YYYY" "D/M/YYYY" "YYYY/M/D" "MMMM D, YYYY" "D MMMM, YYYY" "dddd, MMMM D, YYYY"})
(s/def ::date-abbreviate boolean?)
(s/def ::date-separator #{"/" "-" "."})
(s/def ::time-style #{"HH:mm" "h:mm A" "h A"})
(s/def ::time-enabled #{nil "minutes" "seconds" "milliseconds"})
(s/def ::decimals pos-int?)
(s/def ::number-separators #(or nil? (and string? (= 2 (count %)))))
(s/def ::number-style #{"decimal" "percent" "scientific" "currency"})
(s/def ::prefix string?)
(s/def ::suffix string?)
(s/def ::view-as string?)
(s/def ::link-text string?)
(s/def ::param-mapping-id string?)
(s/def ::param-ref-type #{"column" "dimension" "variable" "parameter"})
(s/def ::param-ref-id string?)
(s/def ::param-ref-name string?)
(s/def ::param-mapping-source (s/keys :req [::param-ref-id ::param-ref-type] :opt [::param-ref-name]))
(s/def ::param-mapping-target ::param-mapping-source)
(s/def ::db-column-ref (s/or :string? string? :vector? vector? :keyword? keyword?))
(s/def ::entity-type #{::card ::dashboard})

----------------------------------------------- Parsing fns -----------------------------------------------

Creates a normalized column ref map for the given field ID. This becomes a key in the ::column-settings map.

If passed, field-metadata is also included in the map (but not interpreted).

(defn field-id->column-ref
  {:added "0.40.0"}
  [field-id & [field-metadata]]
  (cond-> {::field-id field-id}
    (some? field-metadata) (assoc ::field-metadata field-metadata)))
(s/fdef field-id->column-ref
  :args (s/cat :field-id int? :field-metadata (s/? ::field-metadata))
  :ret  ::column-ref)

Creates a normalized column ref map for the given col-name. This becomes a key in the ::column-settings map.

(defn column-name->column-ref
  {:added "0.40.0"}
  [col-name]
  {::column-name col-name})
(s/fdef column-name->column-ref
  :args (s/cat :col-name string?)
  :ret  ::column-ref)

Creates a normalized column ref map for the given field string (which could be the name of a "synthetic" field, such as the output of an aggregation, or a fully qualified field name in the context of serialization. The visualization settings code will not make any attempt to interpret this string. It becomes the key in the ::column-settings map.

If passed, field-metadata is also included in the map (but not interpreted).

(defn field-str->column-ref
  {:added "0.40.0"}
  [field-qualified-name & [field-metadata]]
  (cond-> {::field-str field-qualified-name}
    (some? field-metadata) (assoc ::field-metadata field-metadata)))
(s/fdef field-str->column-ref
        :args (s/cat :field-qualified-name string? :field-metadata (s/? ::field-metadata))
        :ret ::column-ref)

Returns the full string name of the keyword kw, including any "namespace" portion followed by forward slash.

From https://clojuredocs.org/clojure.core/name#example-58264f85e4b0782b632278bf Clojure interprets slashes as keyword/name separators, so we need to do something hacky to get the "full" name here because our "keyword value" (as parsed from JSON/YAML/etc.) might actually look like the string version of a Clojure vector, which itself can contain a fully qualified name for serialization

(defn- keyname
  {:added "0.40.0"}
  [kw]
  (str (when-let [kw-ns (namespace kw)] (str kw-ns "/")) (name kw)))
(s/fdef keyname
  :args (s/cat :kw keyword?)
  :ret  string?)

Parse the given json-str to a map. In Clojure, this uses Cheshire. In Clojurescript, it calls .parse with js/JSON and threads that to js->clj.

(defn- parse-json-string
  [json-str]
  #?(:clj  (json/parse-string json-str)
     :cljs (-> (.parse js/JSON json-str)
               js->clj)))
(s/fdef parse-json-string
  :args (s/cat :json-str string?)
  :ret  (s/or :map map? :seq seqable?))

Encode the given obj map as a JSON string. In Clojure, this uses Cheshire. In Clojurescript, it uses cljs.core.clj->js in conjunction with cljs.js.

(defn- encode-json-string
  [obj]
  #?(:clj  (json/encode obj)
     :cljs (.stringify js/JSON (clj->js obj))))
(s/fdef encode-json-string
  :args (s/cat :obj (s/or :map map? :seq seqable?))
  :ret  string?)

Converts a (parsed, vectorized) DB-form column ref to the equivalent normal form.

Does the opposite of norm->db-column-ref

(defn db->norm-column-ref
  [column-ref-vec]
  (let [parsed (s/conform ::db-column-ref-vec column-ref-vec)]
    (if (s/invalid? parsed)
      (throw (ex-info "Invalid input" (s/explain-data ::db-column-ref-vec column-ref-vec)))
      (let [[m parts] parsed]
        (case m
          :field
          (let [[_ [_ [_ [id-or-str v] [_ field-md]]]] parsed]
            (cond-> (case id-or-str
                      :field-id {::field-id v}
                      :field-str {::field-str v})
                    (some? field-md) (assoc ::field-metadata field-md)))
          :column-name
          {::column-name (nth parts 1)}
          :expression
          (let [[_expression [_ref [_expression column-name]]] parsed]
           {::column-name column-name}))))))
(s/fdef db->norm-column-ref
  :args (s/cat :column-ref ::db-column-ref-vec)
  :ret  ::column-ref)

Parses the DB representation of a column reference, and returns the equivalent normal form.

The column-ref parameter can be a string, a vector, or keyword.

If a string, it is parsed as JSON, and the value is passed to db->norm-column-ref for conversion.

If a keyword (which is produced by YAML parsing, for instance), it will first be converted to its full name. "Full" means that the portions before and after any slashes will be included verbatim (via the keyname helper fn). This is necessary because our serialization code considers a forward slash to be a legitimate portion of a fully qualified name, whereas Clojure considers it to be a namespace/local name separator. Once converted thusly, that resulting string value will be passed to db->norm-column-ref for conversion, just as in the case above.

If a vector, it is assumed that vector is already in DB normalized form, so it is passed directly to db->norm-column-ref for conversion.

Returns a map representing the column reference (conforming to the normal form ::column-ref spec), by delegating to db->norm-column-ref.

(defn parse-db-column-ref
  {:added "0.40.0"}
  [column-ref]
  (let [parsed (s/conform ::db-column-ref column-ref)]
    (if (s/invalid? parsed)
      (throw (ex-info "Invalid input" (s/explain-data ::db-column-ref column-ref)))
      (let [[k v]    parsed
            ref->vec (case k
                        :string?  (comp vec parse-json-string)
                        :keyword? (comp vec parse-json-string keyname)
                        :vector?  identity)]
        (db->norm-column-ref (ref->vec v))))))
(s/fdef parse-db-column-ref
  :args (s/cat :column-ref ::db-column-ref)
  :ret ::column-ref)

------------------------------------------------ Builder fns ------------------------------------------------

Creates an empty visualization settings map. Intended for use in the context of a threading macro (ex: with click-action or a similar function following as the next form).

(defn visualization-settings
  {:added "0.40.0"}
  []
  {})
(defn- with-col-settings [settings]
  (if (contains? settings ::column-settings)
    settings
    (assoc settings ::column-settings {})))
(s/fdef with-col-settings
  :args (s/cat :settings ::visualization-settings)
  :ret  ::visualization-settings)

Creates a crossfilter click action with the given param-mapping, in the normalized form.

(defn crossfilter-click-action
  {:added "0.40.0"}
  [param-mapping]
  {::click-behavior-type ::cross-filter
   ::parameter-mapping   param-mapping})
(s/fdef crossfilter-click-action
  :args (s/cat :param-mapping ::parameter-mapping)
  :ret  ::click-behavior)

Creates a URL click action linking to a url-template, in the normalized form.

(defn url-click-action
  {:added "0.40.0"}
  [url-template]
  {::click-behavior-type ::link
   ::link-type           ::url
   ::link-template       url-template})
(s/fdef url-click-action
  :args (s/cat :url-template string?)
  :ret  ::click-behavior)

Creates a click action linking to an entity having entity-type with ID entity-id, in the normalized form. parameter-mapping is an optional argument.

(defn entity-click-action
  {:added "0.40.0"}
  [entity-type entity-id & [parameter-mapping]]
  (cond-> {::click-behavior-type ::link
           ::link-type           entity-type
           ::link-target-id      entity-id}
          (some? parameter-mapping) (assoc ::parameter-mapping parameter-mapping)))
(s/fdef entity-click-action
  :args (s/cat :entity-type ::entity-type :entity-id int? :parameter-mapping ::parameter-mapping)
  :ret  ::click-behavior)

Creates a click action from a given from-field-id Field identifier to the given to-entity-type having ID to-entity-id, and adds it to the given settings. This happens in the normalized form, and hence this should be passed the output of another fn (including, currently, visualization-settings). If the given from-field-id already has a click action, it will be replaced.

(defn with-click-action
  {:added "0.40.0"}
  [settings col-key action]
  (-> settings
      with-col-settings
      (update ::column-settings assoc col-key {::click-behavior action})))
(s/fdef with-click-action
  :args (s/cat :settings map? :col-key ::column-ref :action ::click-behavior)
  :ret  ::click-behavior)

Creates a click action from a given from-field-id Field identifier to the given to-entity-type having ID to-entity-id. This happens in the normalized form, and hence this should be passed the output of another fn (including, currently, visualization-settings). If the given from-field-id already has a click action, it will be replaced.

(defn with-entity-click-action
  {:added "0.40.0"}
  [settings from-field-id to-entity-type to-entity-id & [parameter-mapping]]
  (with-click-action settings (field-id->column-ref from-field-id) (entity-click-action
                                                                    to-entity-type
                                                                    to-entity-id
                                                                    parameter-mapping)))
(s/fdef with-entity-click-action
  :args (s/cat :settings          map?
               :from-field-id     int?
               :to-entity-type    ::entity-type
               :to-entity-id      int?
               :parameter-mapping (s/? ::parameter-mapping))
  :ret  ::click-behavior)

Creates a parameter mapping for source-col-name (source-field-id) to target-field-id in normalized form.

(defn fk-parameter-mapping
  {:added "0.40.0"}
  [source-col-name source-field-id target-field-id]
  (let [id         [:dimension [:fk-> [:field source-field-id nil] [:field target-field-id nil]]]
        dimension  {:dimension [:field target-field-id {:source-field source-field-id}]}]
    {id #::{:param-mapping-id     id
            :param-mapping-source #::{:param-ref-type "column"
                                      :param-ref-id   source-col-name
                                      :param-ref-name source-col-name}
            :param-mapping-target #::{:param-ref-type "dimension"
                                      :param-ref-id    id
                                      :param-dimension dimension}}}))
(s/fdef fk-parameter-mapping
  :args (s/cat :source-col-name string? :source-field-id int? :target-field-id int?)
  :ret  map?)

---------------------------------------------- Conversion fns ----------------------------------------------

(def ^:private db->norm-click-action-type
  {"link"        ::link
   "crossfilter" ::cross-filter})
(def ^:private norm->db-click-action-type
  (set/map-invert db->norm-click-action-type))
(def ^:private db->norm-link-type
  {"question"    ::card
   "dashboard"   ::dashboard
   "url"         ::url})
(def ^:private norm->db-link-type
  (set/map-invert db->norm-link-type))
(def ^:private db->norm-click-behavior-keys
  {:targetId         ::link-target-id
   :linkTemplate     ::link-template
   :linkTextTemplate ::link-text-template
   :type             ::click-behavior-type
   :linkType         ::link-type})
(def ^:private norm->db-click-behavior-keys
  (set/map-invert db->norm-click-behavior-keys))
(def ^:private db->norm-column-settings-keys
  {:column_title       ::column-title
   :date_style         ::date-style
   :date_separator     ::date-separator
   :date_abbreviate    ::date-abbreviate
   :time_enabled       ::time-enabled
   :time_style         ::time-style
   :number_style       ::number-style
   :currency           ::currency
   :currency_style     ::currency-style
   :currency_in_header ::currency-in-header
   :number_separators  ::number-separators
   :decimals           ::decimals
   :scale              ::scale
   :prefix             ::prefix
   :suffix             ::suffix
   :view_as            ::view-as
   :link_text          ::link-text
   :link_url           ::link-url
   :show_mini_bar      ::show-mini-bar})
(def ^:private norm->db-column-settings-keys
  (set/map-invert db->norm-column-settings-keys))
(def ^:private db->norm-param-mapping-val-keys
  {:id      ::param-mapping-id
   :source  ::param-mapping-source
   :target  ::param-mapping-target})
(def ^:private norm->db-param-mapping-val-keys
  (set/map-invert db->norm-param-mapping-val-keys))
(def ^:private db->norm-param-ref-keys
  {:type      ::param-ref-type
   :id        ::param-ref-id
   :name      ::param-ref-name
   :dimension ::param-dimension})
(def ^:private norm->db-param-ref-keys
  (set/map-invert db->norm-param-ref-keys))
(def ^:private db->norm-table-columns-keys
  {:name      ::table-column-name
   ; for now, do not translate the value of this key (the field vector)
   :fieldref  ::table-column-field-ref
   :field_ref ::table-column-field-ref
   :fieldRef  ::table-column-field-ref
   :enabled   ::table-column-enabled})
(def ^:private norm->db-table-columns-keys
  (set/map-invert db->norm-table-columns-keys))
(s/def ::table-column-field-ref ::field-id-vec)
(defn- db->norm-param-ref [parsed-id param-ref]
  (cond-> (set/rename-keys param-ref db->norm-param-ref-keys)
    (= "dimension" (:type param-ref)) (assoc ::param-ref-id parsed-id)))
(defn- norm->db-param-ref [id-str param-ref]
  (cond-> (set/rename-keys param-ref norm->db-param-ref-keys)
    (= "dimension" (::param-ref-type param-ref)) (assoc :id id-str)))

Is this a parameter mapping for a dimension? Like when link refers a card getting data from another card.

(defn dimension-param-mapping?
  [mapping]
  (= "dimension" (get-in mapping [:target :type])))

Converts a parameter-mapping (i.e. value of :parameterMapping) from DB to normalized form

(defn db->norm-param-mapping
  {:added "0.40.0"}
  [parameter-mapping]
  (if (nil? parameter-mapping)
    nil
    ;; k is "[\"dimension\",[\"fk->\",[\"field-id\",%d],[\"field-id\",%d]]]"
    ;; v is {:id <same long string> :source <param-ref> :target <param-ref>}
    (reduce-kv (fn [acc k v]
                 (let [[new-k new-v]
                       (if (dimension-param-mapping? v)
                         (let [parsed-id (-> (if (keyword? k) (keyname k) k)
                                             parse-json-string
                                             mbql.normalize/normalize-tokens)]
                           [parsed-id (cond-> v
                                        (:source v) (assoc ::param-mapping-source
                                                           (db->norm-param-ref parsed-id (:source v)))
                                        (:target v) (assoc ::param-mapping-target
                                                           (db->norm-param-ref parsed-id (:target v)))
                                        :always     (-> ; from outer cond->
                                                        (assoc ::param-mapping-id parsed-id)
                                                        (dissoc :source :target :id)))])
                         [k (-> v
                                (m/update-existing :source (partial db->norm-param-ref nil))
                                (m/update-existing :target (partial db->norm-param-ref nil))
                                (set/rename-keys db->norm-param-mapping-val-keys))])]
                   (assoc acc new-k new-v))) {} parameter-mapping)))
(defn- norm->db-dimension-param-mapping [k v]
  (let [str-id (encode-json-string k)]
    [str-id (cond-> v
                    (::param-mapping-source v) (assoc :source
                                                      (norm->db-param-ref
                                                       str-id
                                                       (::param-mapping-source v)))
                    (::param-mapping-target v) (assoc :target
                                                      (norm->db-param-ref
                                                       str-id
                                                       (::param-mapping-target v)))
                    :always                    (->
                                                (assoc :id str-id)
                                                (dissoc ::param-mapping-id
                                                        ::param-mapping-source
                                                        ::param-mapping-target)))]))
(defn- norm->db-generic-param-mapping [pm-k pm-v]
  (let [new-v (into {} (remove (fn [[k v]]
                                 ;; don't keep source or target unless not nil
                                 (and (nil? v)
                                      (contains? #{::param-mapping-source ::param-mapping-target} k)))) pm-v)]
    [pm-k (-> new-v
              (m/update-existing ::param-mapping-source (partial norm->db-param-ref nil))
              (m/update-existing ::param-mapping-target (partial norm->db-param-ref nil))
              (set/rename-keys norm->db-param-mapping-val-keys))]))

Converts a parameter-mapping (i.e. value of ::parameter-mapping) from normalized to DB form.

(defn norm->db-param-mapping
  {:added "0.40.0"}
  [parameter-mapping]
  (if (nil? parameter-mapping)
    nil
    (reduce-kv (fn [acc k v]
                 (let [[new-k new-v]
                       (if (= "dimension" (get-in v [::param-mapping-target ::param-ref-type]))
                         (norm->db-dimension-param-mapping k v)
                         (norm->db-generic-param-mapping k v))]
                   (assoc acc new-k new-v))) {} parameter-mapping)))
(defn- db->norm-click-behavior [v]
  (-> v
      (assoc
        ::click-behavior-type
        (db->norm-click-action-type (:type v)))
      (dissoc :type)
      (assoc ::link-type (db->norm-link-type (:linkType v)))
      (dissoc :linkType)
      (cond-> ; from outer ->
        (some? (:parameterMapping v)) (assoc ::parameter-mapping (db->norm-param-mapping (:parameterMapping v))))
      (dissoc :parameterMapping)
      (set/rename-keys db->norm-click-behavior-keys)))

Converts the deprecated k:mm format to HH:mm (#18112)

(defn- db->norm-time-style
  [v]
  (if (= v "k:mm")
    "HH:mm"
    v))
(defn- db->norm-table-columns [v]
  (-> v
    (assoc ::table-columns (mapv (fn [tbl-col]
                                   (set/rename-keys tbl-col db->norm-table-columns-keys))
                             (:table.columns v)))
    (dissoc :table.columns)))

Converts the DB form of a :column_settings entry value to its normalized form. Does the opposite of norm->db-column-settings-entry.

(defn- db->norm-column-settings-entry
  [m k v]
  (case k
    :click_behavior
    (assoc m ::click-behavior (db->norm-click-behavior v))
    :time_style
    (assoc m ::time-style (db->norm-time-style v))
    (assoc m (db->norm-column-settings-keys k) v)))

Converts the DB form of a map of :column_settings entries to its normalized form.

(defn db->norm-column-settings-entries
  [entries]
  (reduce-kv db->norm-column-settings-entry {} entries))

Converts a :column_settings DB form to its normalized form. Drops any columns that fail to be parsed.

(defn db->norm-column-settings
  [settings]
  (reduce-kv (fn [m k v]
               (try
                 (let [k1 (parse-db-column-ref k)
                       v1 (db->norm-column-settings-entries v)]
                   (assoc m k1 v1))
                 (catch #?(:clj Throwable :cljs js/Error) _e
                   m)))
             {}
             settings))

Converts a DB form of visualization settings (i.e. map with key :visualization_settings) into the equivalent normalized form (i.e. map with keys ::column-settings, ::click-behavior, etc.).

Does the opposite of norm->db.

(defn db->norm
  {:added "0.40.0"}
  [vs]
  (cond-> vs
          ;; column_settings at top level; ex: table card
          (:column_settings vs)
          (assoc ::column-settings (->> (:column_settings vs)
                                        db->norm-column-settings))
          ;; click behavior key at top level; ex: non-table card
          (:click_behavior vs)
          (assoc ::click-behavior (db->norm-click-behavior (:click_behavior vs)))
          (:table.columns vs)
          db->norm-table-columns
          :always
          (dissoc :column_settings :click_behavior)))
(defn- norm->db-click-behavior-value [v]
  (-> v
      (assoc
        :type
        (norm->db-click-action-type (::click-behavior-type v)))
      (dissoc ::click-behavior-type)
      (cond-> ; from outer ->
        (some? (::parameter-mapping v)) (assoc :parameterMapping (norm->db-param-mapping (::parameter-mapping v))))
      (dissoc ::parameter-mapping)
      (assoc :linkType (norm->db-link-type (::link-type v)))
      (dissoc ::link-type)
      (set/rename-keys norm->db-click-behavior-keys)))
(defn- norm->db-click-behavior [click-behavior]
  (cond-> click-behavior
    (some? (::parameter-mapping click-behavior))
    (-> (assoc :parameterMapping (norm->db-param-mapping (::parameter-mapping click-behavior)))
        (dissoc ::parameter-mapping))
    :always (-> (assoc :type (norm->db-click-action-type (::click-behavior-type click-behavior)))
                (m/assoc-some :linkType (norm->db-link-type (::link-type click-behavior)))
                (dissoc ::link-type ::click-behavior-type ::parameter-mapping)
                (set/rename-keys norm->db-click-behavior-keys))))

Converts a ::column-settings entry from qualified form to DB form. Does the opposite of db->norm-column-settings-entry.

(defn- norm->db-column-settings-entry
  [m k v]
  (case k
    ::click-behavior (assoc m :click_behavior (norm->db-click-behavior v))
    (assoc m (norm->db-column-settings-keys k) v)))

Creates the DB form of a column ref (i.e. the key in the column settings map) for the given normalized args. Either ::field-id or ::field-str keys will be checked in the arg map to build the corresponding column ref map.

(defn norm->db-column-ref
  {:added "0.40.0"}
  [{::keys [field-id field-str column-name field-metadata]}]
  (-> (cond
        (some? field-id) ["ref" ["field" field-id field-metadata]]
        (some? field-str) ["ref" ["field" field-str field-metadata]]
        (some? column-name) ["name" column-name])
      encode-json-string))

Converts an entire column settings map from normalized to DB form.

(defn- norm->db-column-settings
  [col-settings]
  (->> col-settings
       (m/map-kv (fn [k v]
                   [(norm->db-column-ref k) (reduce-kv norm->db-column-settings-entry {} v)]))))
(defn- norm->db-table-columns [v]
  (cond-> v
    (some? (::table-columns v))
    (assoc :table.columns (mapv (fn [tbl-col]
                                  (set/rename-keys tbl-col norm->db-table-columns-keys))
                            (::table-columns v)))
    :always
    (dissoc ::table-columns)))

Converts the normalized form of visualization settings (i.e. a map having ::column-settings into the equivalent DB form (i.e. a map having :column_settings).

Does The opposite of db->norm.

(defn norm->db
  {:added "0.40.0"}
  [settings]
  (cond-> settings
    (::column-settings settings) (-> ; from cond->
                                     (assoc :column_settings (norm->db-column-settings (::column-settings settings)))
                                     (dissoc ::column-settings))
    (::click-behavior settings)  (-> ; from cond->
                                     (assoc :click_behavior (norm->db-click-behavior-value (::click-behavior settings)))
                                     (dissoc ::click-behavior))
    (::table-columns settings)   norm->db-table-columns))
 

/api/logs endpoints.

These endpoints are meant to be used by admins to download logs before entries are auto-removed after the day limit.

For example, the query_execution table will have entries removed after 30 days by default, and admins may wish to keep logs externally for longer than this retention period.

(ns metabase-enterprise.advanced-config.api.logs
  (:require
   [clojure.string :as str]
   [compojure.core :refer [GET]]
   [malli.core :as mc]
   [malli.transform :as mtx]
   [metabase.api.common :as api]
   [metabase.db.connection :as mdb.connection]
   [metabase.util.i18n :refer [deferred-tru]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

Query to fetch the rows within the specified month of year from the query_execution table.

(mu/defn query-execution-logs
  [year :- ms/PositiveInt
   month :- ms/PositiveInt]
  (let [date-part (fn [part-key part-value]
                    (if (= (mdb.connection/db-type) :postgres)
                      [:= [:date_part [:inline (name part-key)] :started_at] [:inline part-value]]
                      [:= [part-key :started_at] [:inline part-value]]))
        results   (t2/select :query_execution
                             {:order-by [[:started_at :desc]]
                              :where    [:and
                                         (date-part :year year)
                                         (date-part :month month)]})]
    results))

/query_execution/:yyyy-mm

(api/defendpoint GET 
  "Fetch rows for the month specified by `:yyyy-mm` from the query_execution logs table.
  Must be a superuser."
  [yyyy-mm]
  {yyyy-mm (mu/with-api-error-message [:re #"\d{4}-\d{2}"]
             (deferred-tru "Must be a string like 2020-04 or 2222-11."))}
  (let [[year month] (mc/coerce [:tuple
                                 [:int {:title "year" :min 0 :max 9999}]
                                 [:int {:title "month" :min 0 :max 12}]]
                                (str/split yyyy-mm #"\-")
                                (mtx/string-transformer))]
    (api/check-superuser)
    (query-execution-logs year month)))
(api/define-routes)
 
(ns metabase-enterprise.advanced-config.caching
  (:require
   [metabase.public-settings.premium-features :refer [defenterprise]]))

Returns the granular cache ttl (in seconds) for a card. On EE, this first checking whether there is a stored value for the card, dashboard, or database (in that order of decreasing preference). Returns nil on OSS.

(defenterprise granular-ttl
  :feature :cache-granular-controls
  [card dashboard database]
  (let [ttls              [(:cache_ttl card) (:cache_ttl dashboard) (:cache_ttl database)]
        most-granular-ttl (first (filter some? ttls))]
    (when most-granular-ttl ; stored TTLs are in hours; convert to seconds
      (* most-granular-ttl 3600))))

States of persisted_info records which can be refreshed.

(defenterprise refreshable-states
  :feature :cache-granular-controls
  []
  #{"creating" "persisted" "error"})

States of persisted_info records which can be pruned.

(defenterprise prunable-states
  :feature :cache-granular-controls
  []
  #{"deletable" "off"})
 

Support for initializing Metabase with configuration from a config.yml file located in the current working directory. See https://github.com/metabase/metabase/issues/2052 for more information.

This logic is meant to be executed after the application database is set up and driver plugins have been initialized.

The config file itself is a YAML file containing a map where each key corresponds to a different init section. For example, it might look something like this:

version: 1 config: users: - first_name: Cam last_name: Saul password: 2cans email: cam@example.com - first_name: Cam last_name: Era password: 2cans email: cam.era@example.com databases: - type: postgres host: localhost port: 5432 name: test-data password: {{ env MYPOSTGRESPASSWORD }} settings: my-setting: 1234

Each section is handled by its corresponding [[initialize-section!]] method; the shape of each section may vary.

VERSIONING

Config files are required to have a version key; each version of Metabase that supports config files (i.e., 45 and above) can support a range of config file versions, specified in [[supported-versions]].

These are not semantic versions! They're just simple floating point version numbers. That should be enough for our purposes.

The idea here is that if we want to make changes to the config file shape in the future we'll be able to do so without having older Metabase code suddenly break in mysterious ways because it doesn't understand the new config shape, or newer Metabase code breaking if you try to use a config file using the older shape.

For the time being, the minimum version we'll support is 1.0, which is the initial version of the config spec that we're shipping with Metabase 45. We'll support all the way up to 1.999 (basically anything less than 2.0). This will give us some room to define new backwards-compatible versions going forward.

For example in Metabase 46 if we want to add some extra required keys that Metabase 45 can safely ignore, we can define a new version 1.1 of the spec and specify Metabase 46 works with config versions 1.1 to 1.999.

If we want to introduce a breaking change that should not be backwards-compatible, such as introducing a new template type, we can increment the major version to 2.0.

Spec validation

The contents of each section are automatically validated against the [[section-spec]] for that section. This validation is done before template expansion to avoid leaking sensitive values in the error messages that get logged.

Templates

After spec validation, the config map is walked and {{template}} forms are expanded. This uses the same code used to parse template tags in SQL queries, i.e. [[metabase.driver.common.parameters.parse]], which means that [[optional {{templates}}]] work as well, if there is some reason you might need them.

A template form like {{env MY_ENV_VAR}} is wrapped in parens and parsed as EDN, and then the result is passed to [[expand-parsed-template-form]], which dispatches off of the first form, as a symbol. e.g.

``` {{env BIRDTYPE}} => (expand-parsed-template-form '(env BIRDTYPE)) => "toucan" ```

At the time of this writing, env is the only supported template type; more can be added in the future as the need arises.

`env`

```yaml {{env MYENVVAR}} ```

Replaces the template with the value of an environment variable. The template consisting of two parts: the word env and then the name of an environment variable. It uses [[environ.core/env]] under the hood, after passing the symbol thru [[csk/->kebab-case-keyword]]. This means it is case-insensitive and lisp-case/snake_case insensitive, and Java system properties are supported as well, provided you replace dots in their names with slashes or underscores. In other words, this works as well:

```yaml

Java system property user.dir

{{env user-dir}} ```

(ns ^{:added "0.45.0"} metabase-enterprise.advanced-config.file
  (:require
   [clojure.edn :as edn]
   [clojure.spec.alpha :as s]
   [clojure.string :as str]
   [clojure.walk :as walk]
   [environ.core :as env]
   [metabase-enterprise.advanced-config.file.databases]
   [metabase-enterprise.advanced-config.file.interface
    :as advanced-config.file.i]
   [metabase-enterprise.advanced-config.file.settings]
   [metabase-enterprise.advanced-config.file.users]
   [metabase.driver.common.parameters]
   [metabase.driver.common.parameters.parse :as params.parse]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.util :as u]
   [metabase.util.files :as u.files]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [metabase.util.yaml :as yaml]))
(comment
  ;; for parameter parsing
  metabase.driver.common.parameters/keep-me
  ;; for `settings:` section code
  metabase-enterprise.advanced-config.file.settings/keep-me
  ;; for `databases:` section code
  metabase-enterprise.advanced-config.file.databases/keep-me
  ;; for `users:` section code
  metabase-enterprise.advanced-config.file.users/keep-me)
(set! *warn-on-reflection* true)
(s/def :metabase.config.file.config/config
  (s/and
   map?
   (fn validate-section-configs [m]
     (doseq [[section-name section-config] m
             :let [spec (advanced-config.file.i/section-spec section-name)]]
       (s/assert* spec section-config))
     true)))

Range of config file versions (inclusive) that we'll support. If the version is out of this range, spec validation will fail and trigger an error. See ns documentation for [[metabase.config.file]] for more details.

(def ^:private ^:dynamic *supported-versions*
  {:min 1.0, :max 1.999})
(defn- supported-version? [n]
  (<= (:min *supported-versions*) n (:max *supported-versions*)))
(s/def :metabase.config.file.config/version
  (s/and number? supported-version?))
(s/def ::config
  (s/keys :req-un [:metabase.config.file.config/version
                   :metabase.config.file.config/config]))

Environment variables and system properties used in this namespace. This is a dynamic version of [[environ.core/env]]; it is dynamic for test mocking purposes.

Yes, [[metabase.test/with-temp-env-var-value]] exists, but it is not allowed inside parallel tests. This is an experiment that I may adapt into a new pattern in the future to allow further test parallelization.

(def ^:private ^:dynamic *env*
  env/env)

Path for the YAML config file Metabase should use for initialization and Settings values.

(defn- path
  ^java.nio.file.Path []
  (let [path* (or (some-> (get *env* :mb-config-file-path) u.files/get-path)
                  (u.files/get-path (System/getProperty "user.dir") "config.yml"))]
    (if (u.files/exists? path*)
      (log/info (u/colorize :magenta
                            (trs "Found config file at path {0}; Metabase will be initialized with values from this file"
                                 (pr-str (str path*))))
                (u/emoji "🗄️"))
      (log/info (u/colorize :yellow (trs "No config file found at path {0}" (pr-str (str path*))))))
    path*))

Override the config contents as returned by [[config]], for test mocking purposes.

(def ^:private ^:dynamic *config*
  nil)
(defmulti ^:private expand-parsed-template-form
  {:arglists '([form])}
  (fn [form]
    (symbol (first form))))
(defmethod expand-parsed-template-form :default
  [form]
  (throw (ex-info (trs "Don''t know how to expand template form: {0}" (pr-str form))
                  {:form form})))
(defmethod expand-parsed-template-form 'env
  [[_template-type env-var-name]]
  (get *env* (keyword (u/->kebab-case-en env-var-name))))
(defmulti ^:private expand-template-str-part
  {:arglists '([part])}
  type)
(defmethod expand-template-str-part String
  [s]
  s)
(defn- valid-template-type? [symb]
  (and (symbol? symb)
       (get (methods expand-parsed-template-form) symb)))
(s/def ::template-form
  (s/or :env (s/cat :template-type (s/and symbol? valid-template-type?)
                    :env-var-name  symbol?)))
(defmethod expand-template-str-part metabase.driver.common.parameters.Param
  [{s :k}]
  {:pre [(string? s)]}
  (when (seq s)
    (when-let [obj (try
                     (not-empty (edn/read-string (str "( " s " )")))
                     (catch Throwable e
                       (throw (ex-info (trs "Error parsing template string {0}: {1}" (pr-str s) (ex-message e))
                                       {:template-string s}))))]
      (s/assert* ::template-form obj)
      (expand-parsed-template-form obj))))
(defmethod expand-template-str-part metabase.driver.common.parameters.Optional
  [{:keys [args]}]
  (let [parts (map expand-template-str-part args)]
    (when (every? seq parts)
      (str/join parts))))
(defn- expand-templates-in-str [s]
  (str/join (map expand-template-str-part (params.parse/parse s))))
(defn- expand-templates [m]
  (walk/postwalk
   (fn [form]
     (cond-> form
       (string? form) expand-templates-in-str))
   m))

Contents of the config file if it exists, otherwise nil. If config exists, it will be returned as a map.

(defn- config
  []
  (when-let [m (or *config*
                   (yaml/from-file (str (path))))]
    (s/assert* ::config m)
    (expand-templates m)))

Sort the various config sections. The :settings section should always be applied first (important, since it can affect the other sections).

(defn- sort-by-initialization-order
  [config-sections]
  (let [{settings-sections true, other-sections false} (group-by (fn [[section-name]]
                                                                   (= section-name :settings))
                                                                 config-sections)]
    (concat settings-sections other-sections)))

Initialize Metabase according to the directives in the config file, if it exists.

(defn ^{:added "0.45.0"} initialize!
  []
  ;; TODO -- this should only do anything if we have an appropriate token (we should get a token for testing this before
  ;; enabling that check tho)
  (when-let [m (config)]
    (doseq [[section-name section-config] (sort-by-initialization-order (:config m))]
      ;; you can only use the config-from-file stuff with an EE/Pro token with the `:config-text-file` feature. Since you
      ;; might have to use the `:settings` section to set the token, skip the check for Settings. But check it for the
      ;; other sections.
      (when-not (= section-name :settings)
        (when-not (premium-features/enable-config-text-file?)
          (throw (ex-info (tru "Metabase config files require a Premium token with the :config-text-file feature.")
                          {}))))
      (log/info (u/colorize :magenta (trs "Initializing {0} from config file..." section-name)) (u/emoji "🗄️"))
      (advanced-config.file.i/initialize-section! section-name section-config))
    (log/info (u/colorize :magenta (trs "Done initializing from file.")) (u/emoji "🗄️")))
  :ok)
 
(ns metabase-enterprise.advanced-config.file.databases
  (:require
   [clojure.spec.alpha :as s]
   [metabase-enterprise.advanced-config.file.interface :as advanced-config.file.i]
   [metabase.driver.util :as driver.u]
   [metabase.models.database :refer [Database]]
   [metabase.models.setting :refer [defsetting]]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [toucan2.core :as t2]))

Whether to sync newly created Databases during config-from-file initialization. By default, true, but you can disable this behavior if you want to sync it manually or use SerDes to populate its data model.

(defsetting config-from-file-sync-databases
  :visibility :internal
  :type       :boolean
  :default    true
  :audit      :getter)
(s/def :metabase-enterprise.advanced-config.file.databases.config-file-spec/name
  string?)
(s/def :metabase-enterprise.advanced-config.file.databases.config-file-spec/engine
  string?)
(s/def :metabase-enterprise.advanced-config.file.databases.config-file-spec/details
  map?)
(s/def ::config-file-spec
  (s/keys :req-un [:metabase-enterprise.advanced-config.file.databases.config-file-spec/engine
                   :metabase-enterprise.advanced-config.file.databases.config-file-spec/name
                   :metabase-enterprise.advanced-config.file.databases.config-file-spec/details]))
(defmethod advanced-config.file.i/section-spec :databases
  [_section]
  (s/spec (s/* ::config-file-spec)))
(defn- init-from-config-file!
  [database]
  ;; assert that we are able to connect to this Database. Otherwise, throw an Exception.
  (driver.u/can-connect-with-details? (keyword (:engine database)) (:details database) :throw-exceptions)
  (if-let [existing-database-id (t2/select-one-pk Database :engine (:engine database), :name (:name database))]
    (do
      (log/info (u/colorize :blue (trs "Updating Database {0} {1}" (:engine database) (pr-str (:name database)))))
      (t2/update! Database existing-database-id database))
    (do
      (log/info (u/colorize :green (trs "Creating new {0} Database {1}" (:engine database) (pr-str (:name database)))))
      (let [db (first (t2/insert-returning-instances! Database database))]
        (if (config-from-file-sync-databases)
          ((requiring-resolve 'metabase.sync/sync-database!) db)
          (log/info (trs "Sync on database creation when initializing from file is disabled. Skipping sync.")))))))
(defmethod advanced-config.file.i/initialize-section! :databases
  [_section-name databases]
  (doseq [database databases]
    (init-from-config-file! database)))
 
(ns metabase-enterprise.advanced-config.file.interface
  (:require
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]))

Spec that should be used to validate the config section with section-name, e.g. :users. Default spec is [[any?]].

Sections are validated BEFORE template expansion, so as to avoid leaking any sensitive values in spec errors. Write your specs accordingly!

Implementations of this method live in other namespaces. For example, the section spec for the :users section lives in [[metabase.models.user]].

(defmulti section-spec
  {:arglists '([section-name])}
  keyword)
(defmethod section-spec :default
  [_section-name]
  any?)

Execute initialization code for the section of the init config file with the key section-name and value section-config.

Implementations of this method live in other namespaces, for example the method for the :users section (to initialize Users) lives in [[metabase.models.user]].

(defmulti initialize-section!
  {:arglists '([section-name section-config])}
  (fn [section-name _section-config]
    (keyword section-name)))

if we don't know how to initialize a particular section, just log a warning and proceed. This way we can be forward-compatible and handle sections that might be unknown in a particular version of Metabase.

(defmethod initialize-section! :default
  [section-name _section-config]
  (log/warn (u/colorize :yellow (trs "Ignoring unknown config section {0}." (pr-str section-name)))))
 
(ns metabase-enterprise.advanced-config.file.settings
  (:require
   [clojure.spec.alpha :as s]
   [metabase-enterprise.advanced-config.file.interface :as advanced-config.file.i]
   [metabase.models.setting :as setting]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]))
(defmethod advanced-config.file.i/section-spec :settings
  [_section-name]
  (s/map-of keyword? any?))
(defmethod advanced-config.file.i/initialize-section! :settings
  [_section-name settings]
  (log/info (trs "Setting setting values from config file"))
  (doseq [[setting-name setting-value] settings]
    (log/info (trs "Setting value for Setting {0}" setting-name))
    (setting/set! setting-name setting-value)))
 
(ns metabase-enterprise.advanced-config.file.users
  (:require
   [clojure.spec.alpha :as s]
   [metabase-enterprise.advanced-config.file.interface :as advanced-config.file.i]
   [metabase.models.user :refer [User]]
   [metabase.util :as u]
   [metabase.util.i18n :as i18n :refer [trs]]
   [metabase.util.log :as log]
   [toucan2.core :as t2]))
(s/def :metabase-enterprise.advanced-config.file.users.config-file-spec/first_name
  string?)
(s/def :metabase-enterprise.advanced-config.file.users.config-file-spec/last_name
  string?)
(s/def :metabase-enterprise.advanced-config.file.users.config-file-spec/password
  string?)
(s/def :metabase-enterprise.advanced-config.file.users.config-file-spec/email
  string?)
(s/def ::config-file-spec
  (s/keys :req-un [:metabase-enterprise.advanced-config.file.users.config-file-spec/first_name
                   :metabase-enterprise.advanced-config.file.users.config-file-spec/last_name
                   :metabase-enterprise.advanced-config.file.users.config-file-spec/password
                   :metabase-enterprise.advanced-config.file.users.config-file-spec/email]))
(defmethod advanced-config.file.i/section-spec :users
  [_section]
  (s/spec (s/* ::config-file-spec)))

For [[init-from-config-file!]]: true if this the first User being created for this instance. If so, we will ALWAYS create that User as a superuser, regardless of what is specified in the config file. (It doesn't make sense to create the first User as anything other than a superuser).

(defn- init-from-config-file-is-first-user?
  []
  (zero? (t2/count User)))
(defn- init-from-config-file!
  [user]
  ;; TODO -- if this is the FIRST user, we should probably make them a superuser, right?
  (if-let [existing-user-id (t2/select-one-pk User :email (:email user))]
    (do
      (log/info (u/colorize :blue (trs "Updating User with email {0}" (pr-str (:email user)))))
      (t2/update! User existing-user-id user))
    ;; create a new user. If they are the first User, force them to be an admin.
    (let [user (cond-> user
                 (init-from-config-file-is-first-user?) (assoc :is_superuser true))]
      (log/info (u/colorize :green (trs "Creating the first User for this instance. The first user is always created as an admin.")))
      (log/info (u/colorize :green (trs "Creating new User {0} with email {1}"
                                        (pr-str (str (:first_name user) \space (:last_name user)))
                                        (pr-str (:email user)))))
      (t2/insert! User user))))
(defmethod advanced-config.file.i/initialize-section! :users
  [_section-name users]
  (doseq [user users]
    (init-from-config-file! user)))
 
(ns metabase-enterprise.advanced-config.models.pulse-channel
  (:require
   [clojure.string :as str]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru tru]]))
(defsetting subscription-allowed-domains
  (deferred-tru "Allowed email address domain(s) for new Dashboard Subscriptions and Alerts. To specify multiple domains, separate each domain with a comma, with no space in between. To allow all domains, leave the field empty. This setting doesn’t affect existing subscriptions.")
  :visibility :public
  :feature    :email-allow-list
  ;; this is a comma-separated string but we're not using `:csv` because it gets serialized to an array which makes it
  ;; inconvenient to use on the frontend.
  :type       :string
  :audit      :getter)

Parse [[subscription-allowed-domains]] into a set. nil if the Setting is not set or empty.

(defn- allowed-domains-set
  []
  (some-> (subscription-allowed-domains)
          (str/split  #",")
          set
          not-empty))

Check that email-addresses associated with a [[metabase.models.pulse-channel]] are allowed based on the value of the [[subscription-allowed-domains]] Setting, if set. This function no-ops if subscription-allowed-domains is unset or if we do not have a premium token with the :email-allow-list feature.

This function is called by [[metabase.models.pulse-channel/validate-email-domains]] when Pulses are created and updated.

(defn validate-email-domains
  [email-addresses]
  (when (premium-features/enable-email-allow-list?)
    (when-let [allowed-domains (allowed-domains-set)]
      (doseq [email email-addresses
              :let  [domain (u/email->domain email)]]
        (assert (u/email? email)
                (tru "Invalid email address: {0}" (pr-str email)))
        (when-not (contains? allowed-domains domain)
          (throw (ex-info (tru "You cannot create new subscriptions for the domain {0}. Allowed domains are: {1}"
                               (pr-str domain)
                               (str/join ", " allowed-domains))
                          {:email           email
                           :allowed-domains allowed-domains
                           :status-code     403})))))))
 

/advanced-permisisons/application Routes. Implements the Permissions routes needed for application permission - a class of permissions that control access to features like access Setting pages, access monitoring tools ... etc

(ns metabase-enterprise.advanced-permissions.api.application
  (:require
   [compojure.core :refer [GET PUT]]
   [metabase-enterprise.advanced-permissions.models.permissions.application-permissions :as a-perms]
   [metabase.api.common :as api]))
(set! *warn-on-reflection* true)

/graph

(api/defendpoint GET 
  "Fetch a graph of Application Permissions."
  []
  (api/check-superuser)
  (a-perms/graph))
(defn- dejsonify-application-permissions
  [application-permissions]
  (into {} (for [[perm-type perm-value] application-permissions]
             [perm-type (keyword perm-value)])))
(defn- dejsonify-groups
  [groups]
  (into {} (for [[group-id application-permissions] groups]
             [(Integer/parseInt (name group-id))
              (dejsonify-application-permissions application-permissions)])))

Fix the types in the graph when it comes in from the API, e.g. converting things like "yes" to :yes and parsing object keys keyword.

(defn- dejsonify-graph
  [graph]
  (update graph :groups dejsonify-groups))

/graph

(api/defendpoint PUT 
  "Do a batch update of Application Permissions by passing a modified graph."
  [:as {:keys [body]}]
  (api/check-superuser)
  (-> body
      dejsonify-graph
      a-perms/update-graph!)
  (a-perms/graph))
(api/define-routes)
 
(ns metabase-enterprise.advanced-permissions.api.impersonation
  (:require
   [compojure.core :refer [GET]]
   [metabase.api.common :as api]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

/

(api/defendpoint GET 
  "Fetch a list of all Impersonation policies currently in effect, or a single policy if both `group_id` and `db_id`
  are provided."
  [group_id db_id]
  {group_id [:maybe ms/PositiveInt]
   db_id    [:maybe ms/PositiveInt]}
  (api/check-superuser)
  (if (and group_id db_id)
    (t2/select-one :model/ConnectionImpersonation :group_id group_id :db_id db_id)
    (t2/select :model/ConnectionImpersonation {:order-by [[:id :asc]]})))

/:id

(api/defendpoint DELETE 
  "Delete a Connection Impersonation entry."
  [id]
  {id ms/PositiveInt}
  (api/check-superuser)
  (api/check-404 (t2/select-one :model/ConnectionImpersonation :id id))
  (t2/delete! :model/ConnectionImpersonation :id id)
  api/generic-204-no-content)
(api/define-routes)
 
(ns metabase-enterprise.advanced-permissions.api.routes
  (:require
   [compojure.core :as compojure]
   [metabase-enterprise.advanced-permissions.api.application
    :as application]
   [metabase-enterprise.advanced-permissions.api.impersonation
    :as impersonation]
   [metabase.api.routes.common :refer [+auth]]))

Ring routes for advanced permissions API endpoints.

(compojure/defroutes  routes
  (compojure/context "/application" [] (+auth application/routes))
  (compojure/context "/impersonation" [] (+auth impersonation/routes)))
 
(ns metabase-enterprise.advanced-permissions.api.util
  (:require
   [metabase.api.common :refer [*current-user-id* *is-superuser?*]]
   [metabase.models.permissions-group-membership
    :refer [PermissionsGroupMembership]]
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.util.i18n :refer [tru]]
   [toucan2.core :as t2]))

Returns a boolean if the current user is in a group that has a connection impersonation in place for any database. Note: this function does not check whether the impersonation is enforced for the current user, since another group's permissions may supercede it. Will throw an error if [[api/current-user-id]] is not bound.

TODO: this function should only return true if an impersonation policy is enforced for the user

(defenterprise impersonated-user?
  :feature :advanced-permissions
  []
  (boolean
   (when-not *is-superuser?*
     (if *current-user-id*
       (let [group-ids (t2/select-fn-set :group_id PermissionsGroupMembership :user_id *current-user-id*)]
         (seq
          (when (seq group-ids)
            (t2/select :model/ConnectionImpersonation :group_id [:in group-ids]))))
       ;; If no *current-user-id* is bound we can't check for impersonations, so we should throw in this case to avoid
       ;; returning `false` for users who should actually be using impersonation.
       (throw (ex-info (str (tru "No current user found"))
                       {:status-code 403}))))))
 
(ns metabase-enterprise.advanced-permissions.common
  (:require
   [metabase.api.common :as api]
   [metabase.models :refer [PermissionsGroupMembership]]
   [metabase.models.permissions :as perms]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.util :as u]
   [toucan2.core :as t2]))

Adds to user a set of boolean flag indiciate whether or not current user has access to an advanced permissions. This function is meant to be used for GET /api/user/current

(defn with-advanced-permissions
  [user]
  (let [permissions-set @api/*current-user-permissions-set*]
    (assoc user :permissions
           {:can_access_setting      (perms/set-has-application-permission-of-type? permissions-set :setting)
            :can_access_subscription (perms/set-has-application-permission-of-type? permissions-set :subscription)
            :can_access_monitoring   (perms/set-has-application-permission-of-type? permissions-set :monitoring)
            :can_access_data_model   (perms/set-has-partial-permissions? permissions-set "/data-model/")
            :can_access_db_details   (perms/set-has-partial-permissions? permissions-set "/details/")
            :is_group_manager        api/*is-group-manager?*})))

Check if *current-user* has permissions for a application permissions of type perm-type.

(defn current-user-has-application-permissions?
  [perm-type]
  (or api/*is-superuser?*
      (perms/set-has-application-permission-of-type? @api/*current-user-permissions-set* perm-type)))

Return true if current-user is a manager of group-or-id.

(defn current-user-is-manager-of-group?
  [group-or-id]
  (t2/select-one-fn :is_group_manager PermissionsGroupMembership
                       :user_id api/*current-user-id* :group_id (u/the-id group-or-id)))

Given a list of tables, removes the ones for which *current-user* does not have data model editing permissions.

(defn filter-tables-by-data-model-perms
  [tables]
  (cond
    api/*is-superuser?*
    tables
    ;; If advanced-permissions is not enabled, no non-admins have any data-model editing perms, so return an empty list
    (not (premium-features/enable-advanced-permissions?))
    (empty tables)
    :else
    (filter
     (fn [{table-id :id db-id :db_id schema :schema}]
       (perms/set-has-full-permissions? @api/*current-user-permissions-set*
                                        (perms/feature-perms-path :data-model :all db-id schema table-id)))
     tables)))

Given a list of schema, remove the ones for which *current-user* does not have data model editing permissions.

(defn filter-schema-by-data-model-perms
  [schema]
  (cond
    api/*is-superuser?*
    schema
    ;; If advanced-permissions is not enabled, no non-admins have any data-model editing perms, so return an empty list
    (not (premium-features/enable-advanced-permissions?))
    (empty schema)
    :else
    (filter
     (fn [{db-id :db_id schema :schema}]
       (perms/set-has-partial-permissions? @api/*current-user-permissions-set*
                                           (perms/feature-perms-path :data-model :all db-id schema)))
     schema)))

Given a list of databases, removes the ones for which *current-user* has no data model editing permissions. If databases are already hydrated with their tables, also removes tables for which *current-user* has no data model editing perms.

(defn filter-databases-by-data-model-perms
  [dbs]
  (cond
    api/*is-superuser?*
    dbs
    ;; If advanced-permissions is not enabled, no non-admins have any data-model editing perms, so return an empty list
    (not (premium-features/enable-advanced-permissions?))
    (empty dbs)
    :else
    (reduce
     (fn [result {db-id :id tables :tables :as db}]
       (if (perms/set-has-partial-permissions? @api/*current-user-permissions-set*
                                               (perms/feature-perms-path :data-model :all db-id))
         (if tables
           (conj result (update db :tables filter-tables-by-data-model-perms))
           (conj result db))
         result))
     []
     dbs)))
 
(ns metabase-enterprise.advanced-permissions.driver.impersonation
  (:require
   [clojure.set :as set]
   [clojure.string :as str]
   [metabase.api.common :as api]
   [metabase.driver :as driver]
   [metabase.driver.sql :as driver.sql]
   [metabase.models.field :as field]
   [metabase.models.permissions :as perms :refer [Permissions]]
   [metabase.models.permissions-group-membership
    :refer [PermissionsGroupMembership]]
   [metabase.public-settings.premium-features :as premium-features :refer [defenterprise]]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   [toucan2.core :as t2])
  (:import
   (java.sql Connection)))
(set! *warn-on-reflection* true)

Takes the permission set for each group a user is in, and an impersonation policy, and determines whether the policy should be enforced. This is done by checking whether the union of permissions in all other groups provides full data access to the database. If so, we don't enforce the policy, because theo ther groups' permissions supercede it.

(defn- enforce-impersonation?
  [group-id->perms-set {db-id :db_id}]
  (let [perms-set (apply set/union (vals group-id->perms-set))]
    (not (perms/set-has-full-permissions? perms-set (perms/all-schemas-path db-id)))))

Given a list of Connection Impersonation policies and a list of permission group IDs that the current user is in, filter the policies to only include ones that should be enforced for the current user. An impersonation policy is not enforced if the user is in a different permission group that grants full access to the database.

(defn- enforced-impersonations
  [impersonations group-ids]
  (let [non-impersonated-group-ids (set/difference (set group-ids)
                                                   (set (map :group_id impersonations)))
        perms                      (when (seq non-impersonated-group-ids)
                                     (t2/select Permissions {:where [:in :group_id non-impersonated-group-ids]}))
        group-id->perms-set        (-> (group-by :group_id perms)
                                       (update-vals (fn [perms] (into #{} (map :object) perms))))]
    (filter (partial enforce-impersonation? group-id->perms-set)
            impersonations)))

Is impersonation enabled for the given database, for any groups?

(defn- impersonation-enabled-for-db?
  [db-or-id]
  (boolean
   (when (and db-or-id (premium-features/enable-advanced-permissions?))
     (t2/exists? :model/ConnectionImpersonation :db_id (u/id db-or-id)))))

Fetches the database role that should be used for the current user, if connection impersonation is in effect. Returns nil if connection impersonation should not be used for the current user. Throws an exception if multiple conflicting connection impersonation policies are found.

(defn connection-impersonation-role
  [database-or-id]
  (when (and database-or-id (not api/*is-superuser?*))
    (let [group-ids           (t2/select-fn-set :group_id PermissionsGroupMembership :user_id api/*current-user-id*)
          conn-impersonations (enforced-impersonations
                               (when (seq group-ids)
                                 (t2/select :model/ConnectionImpersonation
                                            :group_id [:in group-ids]
                                            :db_id (u/the-id database-or-id)))
                               group-ids)
          role-attributes     (set (map :attribute conn-impersonations))]
      (when (> (count role-attributes) 1)
        (throw (ex-info (tru "Multiple conflicting connection impersonation policies found for current user")
                        {:user-id api/*current-user-id*
                         :conn-impersonations conn-impersonations})))
      (when (not-empty role-attributes)
        (let [conn-impersonation (first conn-impersonations)
              role-attribute     (:attribute conn-impersonation)
              user-attributes    (:login_attributes @api/*current-user*)
              role               (get user-attributes role-attribute)]
          (if (str/blank? role)
            (throw (ex-info (tru "User does not have attribute required for connection impersonation.")
                            {:user-id api/*current-user-id*
                             :conn-impersonations conn-impersonations}))
            role))))))

Returns a hash-key for FieldValues if the current user uses impersonation for the database.

(defenterprise hash-key-for-impersonation
  :feature :advanced-permissions
  [field-id]
  ;; Include the role in the hash key, so that we can cache the results of the query for each role.
  (let [db-id (field/field-id->database-id field-id)]
    (str (hash [field-id (connection-impersonation-role db-id)]))))

Executes a USE ROLE or similar statement on the given connection, if connection impersonation is enabled for the given driver. For these drivers, the role is set to either the default role, or to a specific role configured for the current user, depending on the connection impersonation settings. This is a no-op for databases that do not support connection impersonation, or for non-EE instances.

(defenterprise set-role-if-supported!
  :feature :advanced-permissions
  [driver ^Connection conn database]
  (when (driver/database-supports? driver :connection-impersonation database)
    (try
      (let [enabled?           (impersonation-enabled-for-db? database)
            default-role       (driver.sql/default-database-role driver database)
            impersonation-role (and enabled? (connection-impersonation-role database))]
        (when (and enabled? (not default-role))
          (throw (ex-info (tru "Connection impersonation is enabled for this database, but no default role is found")
                          {:user-id api/*current-user-id*
                           :database-id (u/the-id database)})))
        (when-let [role (or impersonation-role default-role)]
          ;; If impersonation is not enabled for any groups but we have a default role, we should still set it, just
          ;; in case impersonation used to be enabled and the connection still uses an impersonated role.
          (driver/set-role! driver conn role)))
      (catch Throwable e
        (log/debug e (tru "Error setting role on connection"))
        (throw e)))))
 

Model definition for Connection Impersonations, which are used to define specific database roles used by users in certain permission groups when running queries.

(ns metabase-enterprise.advanced-permissions.models.connection-impersonation
  (:require
   [medley.core :as m]
   [metabase.models.interface :as mi]
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.util.log :as log]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))
(doto :model/ConnectionImpersonation
  (derive :metabase/model)
  ;; Only admins can work with Connection Impersonation configs
  (derive ::mi/read-policy.superuser)
  (derive ::mi/write-policy.superuser))
(methodical/defmethod t2/table-name :model/ConnectionImpersonation [_model] :connection_impersonations)

Augment a provided permissions graph with active connection impersonation policies.

(defenterprise add-impersonations-to-permissions-graph
  :feature :advanced-permissions
  [graph]
  (m/deep-merge
   graph
   (let [impersonations (t2/select :model/ConnectionImpersonation)]
     (reduce (fn [acc {:keys [db_id group_id]}]
               (assoc-in acc [group_id db_id] {:data {:schemas :impersonated}}))
             {}
             impersonations))))

Create new Connection Impersonation records. Deletes any existing Connection Impersonation records for the same group and database before creating new ones.

(defenterprise insert-impersonations!
  :feature :advanced-permissions
  [impersonations]
  (doall
   (for [impersonation impersonations]
     (do
       (t2/delete! :model/ConnectionImpersonation
                   :group_id (:group_id impersonation)
                   :db_id (:db_id impersonation))
       (-> (t2/insert-returning-instances! :model/ConnectionImpersonation impersonation)
           first)))))
(defn- delete-impersonations-for-group-database! [{:keys [group-id database-id]} changes]
  (log/debugf "Deleting unneeded Connection Impersonations for Group %d for Database %d. Graph changes: %s"
              group-id database-id (pr-str changes))
  (when (not= :impersonated changes)
    (log/debugf "Group %d %s for Database %d, deleting all Connection Impersonations for this DB"
                group-id
                (case changes
                  :none  "no longer has any perms"
                  :all   "now has full data perms"
                  :block "is now BLOCKED from all non-data-perms access")
                database-id)
    (t2/delete! :model/ConnectionImpersonation :group_id group-id :db_id database-id)))
(defn- delete-impersonations-for-group! [{:keys [group-id]} changes]
  (log/debugf "Deleting unneeded Connection Impersonation policies for Group %d. Graph changes: %s" group-id (pr-str changes))
  (doseq [database-id (set (keys changes))]
    (when-let [data-perm-changes (get-in changes [database-id :data :schemas])]
      (delete-impersonations-for-group-database!
       {:group-id group-id, :database-id database-id}
       data-perm-changes))))

For use only inside metabase.models.permissions; don't call this elsewhere. Delete Connection Impersonations that are no longer needed after the permissions graph is updated. changes are the parts of the graph that have changed, i.e. the things-only-in-new returned by clojure.data/diff.

(defenterprise delete-impersonations-if-needed-after-permissions-change!
  :feature :advanced-permissions
  [changes]
  (log/debug "Permissions updated, deleting unneeded Connection Impersonations...")
  (doseq [group-id (set (keys changes))]
    (delete-impersonations-for-group! {:group-id group-id} (get changes group-id)))
  (log/debug "Done deleting unneeded Connection Impersonations."))
 
(ns metabase-enterprise.advanced-permissions.models.permissions
  (:require
   [metabase.models.permissions :as perms]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]))

+----------------------------------------------------------------------------------------------------------------+ | Shared Util Functions | +----------------------------------------------------------------------------------------------------------------+

(defn- grant-permissions!
  {:arglists '([perm-type perm-value group-id db-id]
               [perm-type perm-value group-id db-id schema-name]
               [perm-type perm-value group-id db-id schema-name table-or-id])}
  [perm-type perm-value group-id & path-components]
  (perms/grant-permissions! group-id (perms/base->feature-perms-path
                                      perm-type
                                      perm-value
                                      (apply perms/data-perms-path path-components))))
(defn- revoke-permissions!
  {:arglists '([perm-type perm-value group-id db-id]
               [perm-type perm-value group-id db-id schema-name]
               [perm-type perm-value group-id db-id schema-name table-or-id])}
  [perm-type perm-value group-id & path-components]
  (perms/delete-related-permissions! group-id
                                     (apply (partial perms/feature-perms-path perm-type perm-value) path-components)))

+----------------------------------------------------------------------------------------------------------------+ | Download permissions | +----------------------------------------------------------------------------------------------------------------+

(defn- all-schemas-path
  [perm-type perm-value db-id]
  (perms/base->feature-perms-path perm-type perm-value (perms/all-schemas-path db-id)))
(defn- grant-permissions-for-all-schemas!
  [perm-type perm-value group-id db-id]
  (perms/grant-permissions! group-id (all-schemas-path perm-type perm-value db-id)))
(defn- revoke-download-permissions!
  {:arglists '([group-id db-id]
               [group-id db-id schema-name]
               [group-id db-id schema-name table-or-id])}
  [group-id & path-components]
  (apply (partial perms/revoke-download-perms! group-id) path-components))
(defn- update-table-download-permissions!
  [group-id db-id schema table-id new-table-perms]
  (condp = new-table-perms
    :full
    (do
      (revoke-download-permissions! group-id db-id schema table-id)
      (perms/grant-permissions! group-id (perms/feature-perms-path :download :full db-id schema table-id)))
    :limited
    (do
      (revoke-download-permissions! group-id db-id schema table-id)
      (perms/grant-permissions! group-id (perms/feature-perms-path :download :limited db-id schema table-id)))
    :none
    (revoke-download-permissions! group-id db-id schema table-id)))
(defn- update-schema-download-permissions!
  [group-id db-id schema new-schema-perms]
  (condp = new-schema-perms
    :full
    (do
      (revoke-download-permissions! group-id db-id schema)
      (perms/grant-permissions! group-id (perms/feature-perms-path :download :full db-id schema)))
    :limited
    (do
      (revoke-download-permissions! group-id db-id schema)
      (perms/grant-permissions! group-id (perms/feature-perms-path :download :limited db-id schema)))
    :none
    (revoke-download-permissions! group-id db-id schema)
    (when (map? new-schema-perms)
      (doseq [[table-id table-perms] new-schema-perms]
        (update-table-download-permissions! group-id db-id schema table-id table-perms)))))

Update the download permissions graph for a database.

This mostly works similar to [[metabase.models.permission/update-db-data-access-permissions!]], with a few key differences: - Permissions have three levels: full, limited, and none. - Native query download permissions are fully inferred from the non-native download permissions. For more details, see the docstring for [[metabase.models.permissions/update-native-download-permissions!]].

(mu/defn update-db-download-permissions!
  [group-id :- ms/PositiveInt db-id :- ms/PositiveInt new-download-perms :- perms/DownloadPermissionsGraph]
  (when-not (premium-features/enable-advanced-permissions?)
    (throw (perms/ee-permissions-exception :download)))
  (when-let [schemas (:schemas new-download-perms)]
    (condp = schemas
      :full
      (do
        (revoke-download-permissions! group-id db-id)
        (grant-permissions-for-all-schemas! :download :full group-id db-id))
      :limited
      (do
        (revoke-download-permissions! group-id db-id)
        (grant-permissions-for-all-schemas! :download :limited group-id db-id))
      :none
      (revoke-download-permissions! group-id db-id)
      (when (map? schemas)
        (doseq [[schema new-schema-perms] (seq schemas)]
          (update-schema-download-permissions! group-id db-id schema new-schema-perms))))
    ;; We need to call update-native-download-permissions! whenever any download permissions are changed, but after we've
    ;; updated non-native donwload permissions. This is because native download permissions are fully computed from the
    ;; non-native download permissions.
    (perms/update-native-download-permissions! group-id db-id)))

+----------------------------------------------------------------------------------------------------------------+ | Data model permissions | +----------------------------------------------------------------------------------------------------------------+

Returns the permissions path required to edit the data model for a table specified by path-components. This is a simple wrapper around perms/feature-perms-path, but it lives in an EE namespace to ensure that data model permissions only work when EE code can be loaded.

(defn data-model-write-perms-path
  [& path-components]
  (apply (partial perms/feature-perms-path :data-model :all) path-components))
(defn- update-table-data-model-permissions!
  [group-id db-id schema table-id new-table-perms]
  (condp = new-table-perms
    :all
    (do
      (revoke-permissions! :data-model :all group-id db-id schema table-id)
      (grant-permissions! :data-model :all group-id db-id schema table-id))
    :none
    (revoke-permissions! :data-model :all group-id db-id schema table-id)))
(defn- update-schema-data-model-permissions!
  [group-id db-id schema new-schema-perms]
  (condp = new-schema-perms
    :all
    (do
      (revoke-permissions! :data-model :all group-id db-id schema)
      (grant-permissions! :data-model :all group-id db-id schema))
    :none
    (revoke-permissions! :data-model :all group-id db-id schema)
    (when (map? new-schema-perms)
      (doseq [[table-id table-perms] new-schema-perms]
        (update-table-data-model-permissions! group-id db-id schema table-id table-perms)))))

Update the data model permissions graph for a database.

(mu/defn update-db-data-model-permissions!
  [group-id :- ms/PositiveInt db-id :- ms/PositiveInt new-data-model-perms :- perms/DataModelPermissionsGraph]
  (when-not (premium-features/enable-advanced-permissions?)
    (throw (perms/ee-permissions-exception :data-model)))
  (when-let [schemas (:schemas new-data-model-perms)]
    (condp = schemas
      :all
      (do
        (revoke-permissions! :data-model :all group-id db-id)
        (grant-permissions! :data-model :all group-id db-id))
      :none
      (revoke-permissions! :data-model :all group-id db-id)
      (when (map? schemas)
        (doseq [[schema new-schema-perms] (seq schemas)]
          (update-schema-data-model-permissions! group-id db-id schema new-schema-perms))))))

+----------------------------------------------------------------------------------------------------------------+ | Data model permissions | +----------------------------------------------------------------------------------------------------------------+

Returns the permissions path required to edit the database details for the provided database ID. This is a simple wrapper around perms/feature-perms-path, but it lives in an EE namespace to ensure that database permissions only work when EE code can be loaded.

(defn db-details-write-perms-path
  [db-id]
  (perms/feature-perms-path :details :yes db-id))

Update the DB details permissions for a database.

(mu/defn update-db-details-permissions!
  [group-id :- ms/PositiveInt db-id :- ms/PositiveInt new-perms :- perms/DetailsPermissions]
  (when-not (premium-features/enable-advanced-permissions?)
    (throw (perms/ee-permissions-exception :details)))
  (case new-perms
    :yes
    (do
      (revoke-permissions! :details :yes group-id db-id)
      (grant-permissions! :details :yes group-id db-id))
    :no
    (revoke-permissions! :details :yes group-id db-id)))

Update the DB details permissions for a database.

(mu/defn update-db-execute-permissions!
  [group-id :- ms/PositiveInt db-id :- ms/PositiveInt new-perms :- perms/ExecutePermissions]
  (when-not (premium-features/enable-advanced-permissions?)
    (throw (perms/ee-permissions-exception :execute)))
  (revoke-permissions! :execute :all group-id db-id)
  (when (= new-perms :all)
    (grant-permissions! :execute :all group-id db-id)))
 

Code for generating and updating the Application Permission graph. See [[metabase.models.permissions]] for more details and for the code for generating and updating the data permissions graph.

(ns metabase-enterprise.advanced-permissions.models.permissions.application-permissions
  (:require
   [clojure.data :as data]
   [metabase.models :refer [ApplicationPermissionsRevision Permissions]]
   [metabase.models.application-permissions-revision :as a-perm-revision]
   [metabase.models.permissions :as perms]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

---------------------------------------------------- Schemas -----------------------------------------------------

(def ^:private GroupPermissionsGraph
  [:map-of
   [:enum :setting :monitoring :subscription]
   [:enum :yes :no]])
(def ^:private ApplicationPermissionsGraph
  [:map {:closed true}
   [:revision :int]
   [:groups [:map-of ms/PositiveInt GroupPermissionsGraph]]])

-------------------------------------------------- Fetch Graph ---------------------------------------------------

Returns a map of group-id -> application permissions paths. Only groups that has at least one application permission enabled will be included.

(defn- group-id->permissions-set
  []
  (let [application-permissions (t2/select Permissions
                                           {:where [:or
                                                    [:= :object "/"]
                                                    [:like :object (h2x/literal "/application/%")]]})]
    (into {} (for [[group-id perms] (group-by :group_id application-permissions)]
               {group-id (set (map :object perms))}))))
(defn- permission-for-type
  [permissions-set perm-type]
  (if (perms/set-has-full-permissions? permissions-set (perms/application-perms-path perm-type))
    :yes
    :no))
(mu/defn permissions-set->application-perms :- GroupPermissionsGraph
  "Get a map of all application permissions for a group."
  [permission-set]
  {:setting      (permission-for-type permission-set :setting)
   :monitoring   (permission-for-type permission-set :monitoring)
   :subscription (permission-for-type permission-set :subscription)})
(mu/defn graph :- ApplicationPermissionsGraph
  "Fetch a graph representing the application permissions status for groups that has at least one application permission enabled.
  This works just like the function of the same name in `metabase.models.permissions`;
  see also the documentation for that function."
  []
  {:revision (a-perm-revision/latest-id)
   :groups   (into {} (for [[group-id perms] (group-id->permissions-set)]
                        {group-id (permissions-set->application-perms perms)}))})

-------------------------------------------------- Update Graph --------------------------------------------------

Perform update application permissions for a group-id.

(defn update-application-permissions!
  [group-id changes]
  (doseq [[perm-type perm-value] changes]
    (case perm-value
      :yes
      (perms/grant-application-permissions! group-id perm-type)
      :no
      (perms/revoke-application-permissions! group-id perm-type))))

Update the application Permissions graph. This works just like [[metabase.models.permission/update-data-perms-graph!]], but for Application permissions; refer to that function's extensive documentation to get a sense for how this works.

(mu/defn update-graph!
  [new-graph :- ApplicationPermissionsGraph]
  (let [old-graph          (graph)
        old-perms          (:groups old-graph)
        new-perms          (:groups new-graph)
        [diff-old changes] (data/diff old-perms new-perms)]
    (perms/log-permissions-changes diff-old changes)
    (perms/check-revision-numbers old-graph new-graph)
    (when (seq changes)
      (t2/with-transaction [_conn]
       (doseq [[group-id changes] changes]
         (update-application-permissions! group-id changes))
       (perms/save-perms-revision! ApplicationPermissionsRevision (:revision old-graph) (:groups old-graph) changes)))))
 
(ns metabase-enterprise.advanced-permissions.models.permissions.block-permissions
  (:require
   [metabase.api.common :as api]
   [metabase.models.permissions :as perms]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.util.i18n :refer [tru]]))
(defn- current-user-has-block-permissions-for-database?
  [database-or-id]
  (contains? @api/*current-user-permissions-set* (perms/database-block-perms-path database-or-id)))

Assert that block permissions are not in effect for Database for a query that's only allowed to run because of Collection perms; throw an Exception if they are. Otherwise returns a keyword explaining why the check succeeded (this is mostly for test/debug purposes). The query is still allowed to run if the current User has appropriate data permissions from another Group. See the namespace documentation for [[metabase.models.collection]] for more details.

Note that this feature is Metabase© Enterprise Edition™ only and only enabled if we have a valid Enterprise Edition™ token. [[metabase.query-processor.middleware.permissions/check-block-permissions]] invokes this function if it exists.

(defn check-block-permissions
  [{database-id :database}]
  (cond
    (not (premium-features/enable-advanced-permissions?))
    ::advanced-permissions-not-enabled
    (not (current-user-has-block-permissions-for-database? database-id))
    ::no-block-permissions-for-db
    :else
    ;; TODO -- come up with a better error message.
    (throw (ex-info (tru "Blocked: you are not allowed to run queries against Database {0}." database-id)
                    {:type               qp.error-type/missing-required-permissions
                     :actual-permissions @api/*current-user-permissions-set*
                     :permissions-error? true}))))
 
(ns metabase-enterprise.advanced-permissions.models.permissions.group-manager
  (:require
   [clojure.data :as data]
   [clojure.set :as set]
   [metabase.api.common :as api]
   [metabase.models :refer [PermissionsGroupMembership]]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [toucan2.core :as t2]))

Return a list of group memberships a User belongs to. Group Membership is a map with 2 keys [:id :isgroupmanager].

(defn user-group-memberships
  [user-or-id]
  (when user-or-id
    (t2/select [PermissionsGroupMembership [:group_id :id] :is_group_manager] :user_id (u/the-id user-or-id))))

Transform user-group-memberships to a map in which keys are group-ids and values are maps containing membership info.

[{:id 1, :isgroupmanager true}] => {1 {:isgroupmanager true}}

We can diff this map to decide which membership to add/remove.

(defn- user-group-memberships->map
  [user-group-memberships]
  (into {} (map (fn [x] [(:id x) (dissoc x :id)]) user-group-memberships)))

Update Groups Memberships of a User when advanced-permissions is enabled. It can be used to adds/removes a user from groups and promote/demote Group Manager.

(defn set-user-group-memberships!
  [user-or-id new-user-group-memberships]
  (let [user-id                       (u/the-id user-or-id)
        old-user-group-memberships    (user-group-memberships user-id)
        old-group-id->membership-info (user-group-memberships->map old-user-group-memberships)
        new-group-id->membership-info (user-group-memberships->map new-user-group-memberships)
        [to-remove to-add]            (data/diff old-group-id->membership-info new-group-id->membership-info)
        to-remove-group-ids           (keys to-remove)
        to-add-group-ids              (keys to-add)]
    ;; TODO: Should do this check in the API layer
    (when-not api/*is-superuser?*
      ;; prevent groups manager from update membership of groups that they're not manager of
      (when-not (and api/*is-group-manager?*
                     (set/subset? (set (concat to-remove-group-ids to-add-group-ids))
                                  (t2/select-fn-set :group_id PermissionsGroupMembership
                                                    :user_id api/*current-user-id* :is_group_manager true)))
        (throw (ex-info (tru "Not allowed to edit group memberships")
                        {:status-code 403}))))
    (t2/with-transaction [_conn]
     (when (seq to-remove-group-ids)
       (t2/delete! PermissionsGroupMembership :user_id user-id, :group_id [:in to-remove-group-ids]))
     (when (seq to-add-group-ids)
       ;; do multiple single inserts because insert-many! does not call post-insert! hook
       (doseq [group-id to-add-group-ids]
         (t2/insert! PermissionsGroupMembership
                     {:user_id          user-id
                      :group_id         group-id
                      :is_group_manager (:is_group_manager (new-group-id->membership-info group-id))}))))))
 
(ns metabase-enterprise.advanced-permissions.query-processor.middleware.permissions
  (:require
   [clojure.string :as str]
   [metabase.api.common :as api]
   [metabase.models.permissions :as perms]
   [metabase.models.query.permissions :as query-perms]
   [metabase.public-settings.premium-features
    :as premium-features
    :refer [defenterprise]]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.util.i18n :refer [tru]]))
(def ^:private max-rows-in-limited-downloads 10000)

Returns true if this query is being used to generate a CSV/JSON/XLSX export.

(defn- is-download?
  [query]
  (some-> query :info :context name (str/includes? "download")))

Given a table-id referenced by a query, returns the permissions path required to download the results of the query at the level specified by download-level (either :full or :limited).

(defn- table->download-perms-path
  [db-id table-id download-level]
  (first
   (query-perms/tables->permissions-path-set
    db-id
    #{table-id}
    {:table-perms-fn (fn [& path-components] (apply perms/feature-perms-path :download download-level path-components))
     :native-perms-fn (fn [db-id] (perms/native-feature-perms-path :download download-level db-id))})))

Given a table-id referenced by a query, returns the level at which the current user can download the data in the table (:full, :limited or :none).

(defn- table-id->download-perms-level
  [db-id table-id]
  (cond (perms/set-has-full-permissions? @api/*current-user-permissions-set* (table->download-perms-path db-id table-id :full))
        :full
        (perms/set-has-full-permissions? @api/*current-user-permissions-set* (table->download-perms-path db-id table-id :limited))
        :limited
        :else
        :none))
(defmulti ^:private current-user-download-perms-level :type)
(defmethod current-user-download-perms-level :default
  [_]
  :full)
(defmethod current-user-download-perms-level :native
  [{database :database}]
  (cond
    (perms/set-has-full-permissions? @api/*current-user-permissions-set* (perms/native-feature-perms-path :download :full database))
    :full

    (perms/set-has-full-permissions? @api/*current-user-permissions-set* (perms/native-feature-perms-path :download :limited database))
    :limited

    :else
    :none))
(defmethod current-user-download-perms-level :query
  [{db-id :database, :as query}]
  ;; Remove the :native key (containing the transpiled MBQL) so that this helper function doesn't think the query is
  ;; a native query. Actual native queries are dispatched to a different method by the :type key.
  (let [table-ids (query-perms/query->source-table-ids (dissoc query :native))]
    ;; The download perm level for a query should be equal to the lowest perm level of any table referenced by the query.
    (reduce (fn [lowest-seen-perm-level table-id]
              (let [table-perm-level (table-id->download-perms-level db-id table-id)]
                (cond
                  (= table-perm-level :none)
                  (reduced :none)

                  (or (= lowest-seen-perm-level :limited)
                      (= table-perm-level :limited))
                  :limited

                  :else
                  :full)))
            :full
            table-ids)))

Pre-processing middleware to apply row limits to MBQL export queries if the user has limited download perms. This does not apply to native queries, which are instead limited by the [[limit-download-result-rows]] post-processing middleware.

(defenterprise apply-download-limit
  :feature :advanced-permissions
  [{query-type :type, {original-limit :limit} :query, :as query}]
  (if (and (is-download? query)
           (= query-type :query)
           (= (current-user-download-perms-level query) :limited))
    (assoc-in query
              [:query :limit]
              (apply min (filter some? [original-limit max-rows-in-limited-downloads])))
    query))

Post-processing middleware to limit the number of rows included in downloads if the user has limited download perms. Mainly useful for native queries, which are not modified by the [[apply-download-limit]] pre-processing middleware.

(defenterprise limit-download-result-rows
  :feature :advanced-permissions
  [query rff]
  (if (and (is-download? query)
           (= (current-user-download-perms-level query) :limited))
    (fn limit-download-result-rows* [metadata]
      ((take max-rows-in-limited-downloads) (rff metadata)))
    rff))

Middleware for queries that generate downloads, which checks that the user has permissions to download the results of the query, and aborts the query or limits the number of results if necessary.

If this query is not run to generate an export (e.g. :export-format is :api) we return user's download permissions in the query metadata so that the frontend can determine whether to show the download option on the UI.

(defenterprise check-download-permissions
  :feature :advanced-permissions
  [qp]
  (fn [query rff context]
    (let [download-perms-level (if api/*current-user-permissions-set*
                                 (current-user-download-perms-level query)
                                 ;; If no user is bound, assume full download permissions (e.g. for public questions)
                                 :full)]
      (when (and (is-download? query)
                 (= download-perms-level :none))
        (throw (ex-info (tru "You do not have permissions to download the results of this query.")
                        {:type qp.error-type/missing-required-permissions
                         :permissions-error? true})))
      (qp query
          (fn [metadata] (rff (some-> metadata (assoc :download_perms download-perms-level))))
          context))))
 

API routes that are only available when running Metabase® Enterprise Edition™. Even tho these routes are available, not all routes might work unless we have a valid premium features token to enable those features.

These routes should generally live under prefixes like /api/ee/<feature>/ -- see the enterprise/backend/README.md for more details.

(ns metabase-enterprise.api.routes
  (:require
   [compojure.core :as compojure]
   [metabase-enterprise.advanced-config.api.logs :as logs]
   [metabase-enterprise.advanced-permissions.api.routes
    :as advanced-permissions]
   [metabase-enterprise.api.routes.common :as ee.api.common]
   [metabase-enterprise.audit-app.api.routes :as audit-app]
   [metabase-enterprise.content-verification.api.routes
    :as content-verification]
   [metabase-enterprise.sandbox.api.routes :as sandbox]
   [metabase.util.i18n :refer [deferred-tru]]))

API routes only available when running Metabase® Enterprise Edition™.

(compojure/defroutes  routes
  ;; The following routes are NAUGHTY and do not follow the naming convention (i.e., they do not start with
  ;; `/ee/<feature>/`).
  ;;
  ;; TODO -- Please fix them! See #22687
  content-verification/routes
  sandbox/routes
  ;; The following routes are NICE and do follow the `/ee/<feature>/` naming convention. Please add new routes here
  ;; and follow the convention.
  (compojure/context
   "/ee" []
   (compojure/context
    "/audit-app" []
    (ee.api.common/+require-premium-feature :audit-app (deferred-tru "Audit app") audit-app/routes))
   (compojure/context
    "/advanced-permissions" []
    (ee.api.common/+require-premium-feature :advanced-permissions (deferred-tru "Advanced Permissions") advanced-permissions/routes))
   (compojure/context
    "/logs" []
    (ee.api.common/+require-premium-feature :audit-app (deferred-tru "Audit app") logs/routes))))
 

Shared stuff used by various EE-only API routes.

(ns metabase-enterprise.api.routes.common
  (:require
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.util.i18n :as i18n]))

Wraps Ring handler. Check that we have a premium token with feature (a keyword; see [[metabase.public-settings.premium-features]] for a current known features) or return a 401 if it is not.

(context "/whatever" [] (+require-premium-feature :sandboxes (deferred-tru "Sandboxes") whatever/routes))

Very important! Make sure you only wrap handlers inside [[compojure.core/context]] forms with this middleware (as in example above). Otherwise it can end up causing requests the handler would not have handled anyway to fail. Use [[when-premium-feature]] instead if you want the handler to apply if we have the premium feature but pass-thru if we do not.

(defn +require-premium-feature
  [feature feature-name handler]
  (assert (i18n/localized-string? feature-name), "`feature-name` must be i18ned")
  (fn [request respond raise]
    (premium-features/assert-has-feature feature feature-name)
    (handler request respond raise)))

Wraps Ring handler. Only applies handler if we have a premium token with feature; if not, passes thru to the next handler.

(+when-premium-feature :sandboxes (+auth table/routes))

This is typically used to replace OSS versions of API endpoints with special implementations that live in EE-land. If the endpoint only exists in EE you should use [[+require-premium-feature]] instead which will give the API user a useful error message if the endpoint is not available because they do not have the token feature in question, rather than a generic 'endpoint does not exist' 404 error.

In general, it's probably better NOT to swap out API endpoints, because it's not obvious at all that it happened, and it makes it hard for us to nicely structure our contexts in [[metabase-enterprise.api.routes/routes]]. So only do this if there's absolutely no other way (which is probably not the case).

(defn ^:deprecated +when-premium-feature
  [feature handler]
  (fn [request respond raise]
    (if-not (premium-features/has-feature? feature)
      (respond nil)
      (handler request respond raise))))
 

API endpoints that are only enabled if we have a premium token with the :audit-app feature. These live under /api/ee/audit-app/. Feature-flagging for these routes happens in [[metabase-enterprise.api.routes/routes]].

(ns metabase-enterprise.audit-app.api.routes
  (:require
   [compojure.core :as compojure]
   [metabase-enterprise.audit-app.api.user :as user]
   [metabase.api.routes.common :refer [+auth]]))

Ring routes for mt API endpoints.

(compojure/defroutes  routes
  (compojure/context "/user" [] (+auth user/routes)))
 

/api/ee/audit-app/user endpoints. These only work if you have a premium token with the :audit-app feature.

(ns metabase-enterprise.audit-app.api.user
  (:require
   [compojure.core :refer [DELETE]]
   [metabase.api.common :as api]
   [metabase.api.user :as api.user]
   [metabase.models.pulse :refer [Pulse]]
   [metabase.models.pulse-channel-recipient :refer [PulseChannelRecipient]]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

/:id/subscriptions

(api/defendpoint DELETE 
  "Delete all Alert and DashboardSubscription subscriptions for a User (i.e., so they will no longer receive them).
  Archive all Alerts and DashboardSubscriptions created by the User. Only allowed for admins or for the current user."
  [id]
  {id ms/PositiveInt}
  (api.user/check-self-or-superuser id)
  ;; delete all `PulseChannelRecipient` rows for this User, which means they will no longer receive any
  ;; Alerts/DashboardSubscriptions
  (t2/delete! PulseChannelRecipient :user_id id)
  ;; archive anything they created.
  (t2/update! Pulse {:creator_id id, :archived false} {:archived true})
  api/generic-204-no-content)
(api/define-routes)
 
(ns metabase-enterprise.audit-app.interface
  (:require
   [metabase.plugins.classloader :as classloader]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli.schema :as ms]))

Schema for the expected format for :metadata returned by an internal query function.

(def ResultsMetadata
  [:sequential
   {:min 1}
   [:tuple
    ms/KeywordOrString
    [:map
     [:base_type    ms/FieldType]
     [:display_name ms/NonBlankString]]]])

Define a new internal query type. Conventionally query-type should be a namespaced keyword with the namespace in which the method is defined. See docstring for [[metabase-enterprise.audit-app.query-processor.middleware.handle-audit-queries]] for a description of what this method should return.

(defmulti internal-query
  {:arglists '([query-type & args])}
  (fn [query-type & _]
    (keyword query-type)))
(defmethod internal-query :default
  [query-type & _]
  (throw (ex-info (str (tru "Unable to run internal query function: cannot resolve {0}" query-type))
                  {:status-code 400})))

Invoke the internal query with query-type (invokes the corresponding implementation of [[internal-query]]).

(defn resolve-internal-query
  [query-type & args]
  (let [query-type (keyword query-type)
        ns-str     (namespace query-type)]
    (when ns-str
      (classloader/require (symbol ns-str)))
    (apply internal-query query-type args)))
 
(ns metabase-enterprise.audit-app.pages.alerts
  (:require
   [clojure.string :as str]
   [metabase-enterprise.audit-app.interface :as audit.i]
   [metabase-enterprise.audit-app.pages.common :as common]
   [metabase-enterprise.audit-app.pages.common.pulses :as common.pulses]
   [metabase.util :as u]))
(def ^:private table-metadata
  (into
   [[:card_id   {:display_name "Question ID",  :base_type :type/Integer, :remapped_to :card_name}]
    [:card_name {:display_name "Question Name" :base_type :type/Text,    :remapped_from :card_id}]]
   common.pulses/table-metadata))
(def ^:private table-query-columns
  (into
   [:card_id
    :card_name]
   common.pulses/table-query-columns))
(defn- table-query [card-name]
  (-> common.pulses/table-query
      (update :select (partial into
                               [[:card.id :card_id]
                                [:card.name :card_name]]))
      (update :left-join into [:pulse_card          [:= :pulse.id :pulse_card.pulse_id]
                               [:report_card :card] [:= :pulse_card.card_id :card.id]])
      (update :where (fn [where]
                       (into
                        where
                        (filter some?)
                        ;; make sure the pulse_card actually exists.
                        [[:not= :pulse_card.card_id nil]
                         [:= :pulse.dashboard_id nil]
                         ;; if `pulse.alert_condition` is non-NULL then the Pulse is an Alert
                         [:not= :pulse.alert_condition nil]
                         (when-not (str/blank? card-name)
                           [:like [:lower :card.name] (str \% (u/lower-case-en card-name) \%)])])))
      (assoc :order-by [[[:lower :card.name] :asc]
                        ;; Newest first. ID instead of `created_at` because the column is currently only
                        ;; second-resolution for MySQL which busts our tests
                        [:channel.id :desc]])))
(def ^:private ^{:arglists '([row-map])} row-map->vec
  (apply juxt (map first table-metadata)))
(defn- post-process-row [row]
  (-> (zipmap table-query-columns row)
      common.pulses/post-process-row-map
      row-map->vec))

with optional param card-name, only show subscriptions matching card name.

(defmethod audit.i/internal-query ::table
  ([query-type]
   (audit.i/internal-query query-type nil))

  ([_ card-name]
   {:metadata table-metadata
    :results  (common/reducible-query (table-query card-name))
    :xform    (map post-process-row)}))
 

Shared functions used by audit internal queries across different namespaces.

(ns metabase-enterprise.audit-app.pages.common
  (:require
   [clojure.core.async :as a]
   [clojure.core.memoize :as memoize]
   [clojure.walk :as walk]
   [honey.sql :as sql]
   [honey.sql.helpers :as sql.helpers]
   [java-time.api :as t]
   [medley.core :as m]
   [metabase-enterprise.audit-app.query-processor.middleware.handle-audit-queries
    :as qp.middleware.audit]
   [metabase.db :as mdb]
   [metabase.db.connection :as mdb.connection]
   [metabase.db.query :as mdb.query]
   [metabase.driver.sql-jdbc.execute :as sql-jdbc.execute]
   [metabase.driver.sql-jdbc.sync :as sql-jdbc.sync]
   [metabase.driver.sql.query-processor :as sql.qp]
   [metabase.query-processor.context :as qp.context]
   [metabase.query-processor.timezone :as qp.timezone]
   [metabase.util :as u]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.urls :as urls]))
(set! *warn-on-reflection* true)
(def ^:private ^:const default-limit Integer/MAX_VALUE)
(defn- add-default-params [honeysql-query]
  (let [{:keys [limit offset]} qp.middleware.audit/*additional-query-params*]
    (if (and (nil? limit) (nil? offset))
      honeysql-query
      (-> honeysql-query
          (update :limit (fn [query-limit]
                           [:inline (or limit query-limit default-limit)]))
          (update :offset (fn [query-offset]
                            [:inline (or offset query-offset 0)]))))))
(defn- inject-cte-body-into-from
  [from ctes]
  (vec
   (for [source from]
     (if (vector? source)
       (let [[source alias] source]
         [(ctes source source) alias])
       (if (ctes source)
         [(ctes source) source]
         source)))))
(defn- inject-cte-body-into-join
  [joins ctes]
  (->> joins
       (partition 2)
       (mapcat (fn [[source condition]]
                 (if (vector? source)
                   (let [[source alias] source]
                     [(if (ctes source)
                        [(ctes source) alias]
                        [source alias])
                      condition])
                   [(if (ctes source)
                      [(ctes source) source]
                      source)
                    condition])))
       vec))
(defn- CTEs->subselects
  ([query] (CTEs->subselects query {}))
  ([{:keys [with] :as query} ctes]
   (let [ctes (reduce (fn [ctes [alias definition]]
                        (assoc ctes alias (CTEs->subselects definition ctes)))
                      ctes
                      with)]
     (walk/postwalk
      (fn [form]
        (if (map? form)
          (-> form
              (m/update-existing :from inject-cte-body-into-from ctes)
              ;; TODO -- make this work with all types of joins
              (m/update-existing :left-join inject-cte-body-into-join ctes)
              (m/update-existing :join inject-cte-body-into-join ctes))
          form))
      (dissoc query :with)))))

TODO - fixme

(def ^:private ^{:arglists '([])} application-db-default-timezone
  ;; cache the application DB's default timezone for an hour. I don't expect this information to change *ever*,
  ;; really, but it seems like it is possible that it *could* change. Determining this for every audit query seems
  ;; wasteful however.
  ;;
  ;; This is cached by db-type and the JDBC connection spec in case that gets changed/swapped out for one reason or
  ;; another
  (let [timezone (memoize/ttl
                  #_{:clj-kondo/ignore [:deprecated-var]}
                  sql-jdbc.sync/db-default-timezone
                  :ttl/threshold (u/hours->ms 1))]
    (fn []
      (timezone (mdb/db-type) {:datasource mdb.connection/*application-db*}))))
(defn- compile-honeysql [driver honeysql-query]
  (try
    (let [honeysql-query (cond-> honeysql-query
                           ;; MySQL 5.x does not support CTEs, so convert them to subselects instead
                           (= driver :mysql) CTEs->subselects)]
      (mdb.query/compile (add-default-params honeysql-query)))
    (catch Throwable e
      (throw (ex-info (tru "Error compiling audit query: {0}" (ex-message e))
                      {:driver driver, :honeysql-query honeysql-query}
                      e)))))
(defn- reduce-results* [honeysql-query context rff init]
  (let [driver         (mdb/db-type)
        [sql & params] (compile-honeysql driver honeysql-query)
        canceled-chan  (qp.context/canceled-chan context)]
    ;; MySQL driver normalizies timestamps. Setting `*results-timezone-id-override*` is a shortcut
    ;; instead of mocking up a chunk of regular QP pipeline.
    (binding [qp.timezone/*results-timezone-id-override* (application-db-default-timezone)]
      (try
        (with-open [conn (.getConnection mdb.connection/*application-db*)
                    stmt (sql-jdbc.execute/prepared-statement driver conn sql params)
                    rs   (sql-jdbc.execute/execute-prepared-statement! driver stmt)]
          (let [rsmeta   (.getMetaData rs)
                cols     (for [col (sql-jdbc.execute/column-metadata driver rsmeta)]
                           (update col :name u/lower-case-en))
                metadata {:cols cols}
                rf       (rff metadata)]
            (reduce rf init (sql-jdbc.execute/reducible-rows driver rs rsmeta canceled-chan))))
        (catch InterruptedException e
          (a/>!! canceled-chan :cancel)
          (throw e))
        (catch Throwable e
          (throw (ex-info (tru "Error running audit query: {0}" (ex-message e))
                          {:driver         driver
                           :honeysql-query honeysql-query
                           :sql            sql
                           :params         params}
                          e)))))))

Return a function with the signature

(f context) -> IReduceInit

that, when reduced, runs honeysql-query against the application DB, automatically including limits and offsets for paging.

(defn reducible-query
  [honeysql-query]
  (bound-fn reducible-query-fn [context]
    (reify clojure.lang.IReduceInit
      (reduce [_ rf init]
        (reduce-results* honeysql-query context (constantly rf) init)))))

Run a internal audit query, automatically including limits and offsets for paging. This function returns results directly as a series of maps (the 'legacy results' format as described in metabase-enterprise.audit-app.query-processor.middleware.handle-audit-queries.internal-queries)

(defn query
  [honeysql-query]
  (let [context {:canceled-chan (a/promise-chan)}
        rff     (fn [{:keys [cols]}]
                  (let [col-names (mapv (comp keyword :name) cols)]
                    ((map (partial zipmap col-names)) conj)))]
    (try
      (reduce-results* honeysql-query context rff [])
      (catch InterruptedException e
        (a/>!! (:canceled-chan context) ::cancel)
        (throw e)))))

+----------------------------------------------------------------------------------------------------------------+ | Helper Fns | +----------------------------------------------------------------------------------------------------------------+

HoneySQL to grab the full name of a User.

(user-full-name :u) ;; -> 'Cam Saul'

(defn user-full-name
  [user-table]
  (let [first-name (keyword (name user-table) "first_name")
        last-name  (keyword (name user-table) "last_name")
        email      (keyword (name user-table) "email")]
    [:case
     [:and [:= nil first-name] [:= nil last-name]]
     email
     [:or [:= nil first-name] [:= nil last-name]]
     (h2x/concat [:coalesce first-name ""] [:coalesce last-name ""])
     :else
     (h2x/concat [:coalesce first-name ""] (h2x/literal " ") [:coalesce last-name ""])]))

Map of datetime unit strings (possible params for queries that accept a datetime unit param) to the :base_type we should use for that column in the results.

(def datetime-unit-str->base-type
  {"quarter"         :type/Date
   "day"             :type/Date
   "hour"            :type/DateTime
   "week"            :type/Date
   "default"         :type/DateTime
   "day-of-week"     :type/Integer
   "hour-of-day"     :type/Integer
   "month"           :type/Date
   "month-of-year"   :type/Integer
   "day-of-month"    :type/Integer
   "year"            :type/Integer
   "day-of-year"     :type/Integer
   "week-of-year"    :type/Integer
   "quarter-of-year" :type/Integer
   "minute-of-hour"  :type/Integer
   "minute"          :type/DateTime})

Scheme for a valid QP DateTime unit as a string (the format they will come into the audit QP). E.g. something like day or day-of-week.

(def DateTimeUnitStr
  (into [:enum] (keys datetime-unit-str->base-type)))

Group a datetime expression by unit using the appropriate SQL QP date implementation for our application database.

(grouped-datetime :day :timestamp) ;; -> cast(timestamp AS date) [honeysql equivalent]

(defn grouped-datetime
  [unit expr]
  (sql.qp/date (mdb/db-type) (keyword unit) expr))

Build a CASE statement that returns the first non-NULL of exprs.

(defn first-non-null
  [& exprs]
  (into [:case]
        (mapcat (fn [expr] [[:not= expr nil] expr]))
        exprs))

Build a CASE statement that will replace results of expr with 0 when it's NULL, perfect for things like counts.

(defn zero-if-null
  [expr]
  [:case [:not= expr nil] expr :else 0])

Lowercase a SQL field, to enter into honeysql query

(defn lowercase-field
  [field]
  [:lower field])

Add an appropriate WHERE clause to limit query to 45 days

(defn add-45-days-clause
  [query date_column]
  (sql.helpers/where query [:>
                            (h2x/cast :date date_column)
                            (h2x/cast :date (h2x/literal (t/format "yyyy-MM-dd" (t/minus (t/local-date) (t/days 45)))))]))

Add an appropriate WHERE clause to query to see if any of the fields-to-search match query-string.

(add-search-clause {} "birds" :t.name :db.name)

(defn add-search-clause
  [query query-string & fields-to-search]
  (sql.helpers/where query (when (seq query-string)
                             (let [query-string (str \% (u/lower-case-en query-string) \%)]
                               (cons
                                :or
                                (for [field fields-to-search]
                                  [:like (lowercase-field field) query-string]))))))

Add an ORDER BY clause to query on sort-column and sort-direction.

Most queries will just have explicit default ORDER BY clauses

(defn add-sort-clause
  [query sort-column sort-direction]
  (sql.helpers/order-by query [(keyword sort-column) (keyword sort-direction)]))

Return HoneySQL for a CASE statement to return a Card's public URL if the public_uuid field is non-NULL.

(defn card-public-url
  [field]
  [:case
   [:not= field nil]
   (h2x/concat (urls/public-card-prefix) field)])

Return HoneySQL for a CASE statement to format the QueryExecution :native column as either Native or GUI.

(defn native-or-gui
  [query-execution-table]
  [:case [:= (keyword (name query-execution-table) "native") true] (h2x/literal "Native") :else (h2x/literal "GUI")])

HoneySQL for a CASE statement to return the name of a Card, or Ad-hoc if Card name is NULL.

(defn card-name-or-ad-hoc
  [card-table]
  (first-non-null (keyword (name card-table) "name") (h2x/literal "Ad-hoc")))

HoneySQL for a WHERE clause to restrict QueryExecution rows to downloads (i.e. executions returned in CSV/JSON/XLS format).

(defn query-execution-is-download
  [query-execution-table]
  [:in (keyword (name query-execution-table) "context") #{"csv-download" "xlsx-download" "json-download"}])
(defn- format-separator
  [_separator [x y]]
  (let [[x-sql & x-args] (sql/format-expr x {:nested true})
        [y-sql & y-args] (sql/format-expr y {:nested true})]
    (into [(format "%s SEPARATOR %s" x-sql y-sql)]
          cat
          [x-args
           y-args])))
(sql/register-fn!
 ::separator
 format-separator)

Portable MySQL group_concat/Postgres string_agg

(defn group-concat
  [expr separator]
  (if (= (mdb/db-type) :mysql)
    [:group_concat [::separator expr (h2x/literal separator)]]
    [:string_agg expr (h2x/literal separator)]))
 

Common queries used by both Card (Question) and Dashboard detail pages.

(ns metabase-enterprise.audit-app.pages.common.card-and-dashboard-detail
  (:require
   [metabase-enterprise.audit-app.pages.common :as common]
   [metabase.models.card :refer [Card]]
   [metabase.models.dashboard :refer [Dashboard]]
   [metabase.models.revision :as revision]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]))
(def ^:private ModelName
  [:enum "card" "dashboard"])

Get views of a Card or Dashboard broken out by a time unit, e.g. day or day-of-week.

SELECT {{group-fn(timestamp}} AS "date", count(*) AS views FROM view_log WHERE model = {{model}} AND model_id = {{model-id}} GROUP BY {{group-fn(timestamp}} ORDER BY {{group-fn(timestamp}} ASC

(mu/defn views-by-time
  [model    :- ModelName
   model-id :- ms/PositiveInt
   unit     :- common/DateTimeUnitStr]
  {:metadata [[:date  {:display_name "Date",  :base_type (common/datetime-unit-str->base-type unit)}]
              [:views {:display_name "Views", :base_type :type/Integer}]]
   :results (let [grouped-timestamp (common/grouped-datetime unit :timestamp)]
              (common/reducible-query
                (-> {:select   [[grouped-timestamp :date]
                                [:%count.* :views]]
                     :from     [:view_log]
                     :where    [:and
                                [:= :model (h2x/literal model)]
                                [:= :model_id model-id]]
                     :group-by [grouped-timestamp]
                     :order-by [[grouped-timestamp :asc]]}
                    (common/add-45-days-clause :timestamp))))})

Get number of views of a Card broken out by a time unit, e.g. day or day-of-week and by cache status. Still here instead of in cards because of similarity to views-by-time

(mu/defn cached-views-by-time
  [card-id :- ms/PositiveInt
   unit    :- common/DateTimeUnitStr]
  {:metadata [[:date           {:display_name "Date",
                                :base_type (common/datetime-unit-str->base-type unit)}]
              [:cached-views   {:display_name "Cached Views",
                                :base_type :type/Integer}]
              [:uncached-views {:display_name "Uncached Views",
                                :base_type :type/Integer}]]
   :results (let [grouped-timestamp (common/grouped-datetime unit :started_at)]
              (common/reducible-query
                (->
                  {:select    [[grouped-timestamp :date]
                               [[:sum [:case [:= :cache_hit true]  [:inline 1] :else [:inline 0]]] :cached_views]
                               [[:sum [:case [:= :cache_hit false] [:inline 1] :else [:inline 0]]] :uncached_views]]
                   :from      [:query_execution]
                   :where     [:and
                               [:= :card_id card-id]
                               [:not= :cache_hit nil]]
                   :group-by  [grouped-timestamp]
                   :order-by  [[grouped-timestamp :asc]]}
                  (common/add-45-days-clause :started_at))))})

Get average execution time of a Card broken out by a time unit, e.g. day or day-of-week. Still here instead of in cards because of similarity to views-by-time

(mu/defn avg-execution-time-by-time
  [card-id :- ms/PositiveInt
   unit    :- common/DateTimeUnitStr]
  {:metadata [[:date        {:display_name "Date",            :base_type (common/datetime-unit-str->base-type unit)}]
              [:avg_runtime {:display_name "Average Runtime", :base_type :type/Number}]]
   :results (let [grouped-timestamp (common/grouped-datetime unit :started_at)]
              (common/reducible-query
                (-> {:select   [[grouped-timestamp :date]
                                [[:avg :running_time] :avg_runtime]]
                     :from     [:query_execution]
                     :where    [:= :card_id card-id]
                     :group-by [grouped-timestamp]
                     :order-by [[grouped-timestamp :asc]]}
                    (common/add-45-days-clause :started_at))))})

Get a revision history table for a Card or Dashboard.

(mu/defn revision-history
  [model    :- [:enum Card Dashboard]
   model-id :- ms/PositiveInt]
  {:metadata [[:timestamp   {:display_name "Edited on",   :base_type :type/DateTime}]
              [:user_id     {:display_name "User ID",     :base_type :type/Integer, :remapped_to   :user_name}]
              [:user_name   {:display_name "Edited by",   :base_type :type/Name,    :remapped_from :user_id}]
              [:change_made {:display_name "Change made", :base_type :type/Text}]
              [:revision_id {:display_name "Revision ID", :base_type :type/Integer}]]
   :results (for [revision (revision/revisions+details model model-id)]
              {:timestamp   (-> revision :timestamp)
               :user_id     (-> revision :user :id)
               :user_name   (-> revision :user :common_name)
               :change_made (-> revision :description)
               :revision_id (-> revision :id)})})

Get a view log for a Card or Dashboard.

(mu/defn audit-log
  [model    :- ModelName
   model-id :- ms/PositiveInt]
  {:metadata [[:when    {:display_name "When",    :base_type :type/DateTime}]
              [:user_id {:display_name "User ID", :base_type :type/Integer, :remapped_to   :who}]
              [:who     {:display_name "Who",     :base_type :type/Name,    :remapped_from :user_id}]
              [:what    {:display_name "What",    :base_type :type/Text}]]
   :results (common/reducible-query
              {:select    [[:vl.timestamp :when]
                           :vl.user_id
                           [(common/user-full-name :u) :who]
                           [:vl.metadata :what]]
               :from      [[:view_log :vl]]
               :join     [[:core_user :u] [:= :vl.user_id :u.id]]
               :where     [:and
                           [:= :model (h2x/literal model)]
                           [:= :model_id model-id]]
               :order-by  [[:vl.timestamp :desc]
                           [[:lower :u.last_name] :asc]
                           [[:lower :u.first_name] :asc]]})})
 
(ns metabase-enterprise.audit-app.pages.common.cards
  (:require
   [metabase-enterprise.audit-app.pages.common :as common]
   [metabase.db.connection :as mdb.connection]
   [metabase.util.honey-sql-2 :as h2x]))

HoneySQL for a CTE to include the average execution time for each Card.

(def avg-exec-time
  [:avg_exec_time {:select   [:card_id
                              [:%avg.running_time :avg_running_time_ms]]
                   :from     [:query_execution]
                   :group-by [:card_id]}])

HoneySQL for a CTE to include the average execution time for each Card for 45 days.

(def avg-exec-time-45
  [:avg_exec_time_45 (-> {:select   [:card_id
                                     [:%avg.running_time :avg_running_time_ms]]
                          :from     [:query_execution]
                          :group-by [:card_id]}
                         (common/add-45-days-clause :started_at))])

HoneySQL for a CTE to include the total execution time for each Card for 45 days.

(def total-exec-time-45
  [:total_runtime_45 (-> {:select   [:card_id
                                     [:%sum.running_time :total_running_time_ms]]
                          :from     [:query_execution]
                          :group-by [:card_id]}
                         (common/add-45-days-clause :started_at))])

HoneySQL for a CTE to get latest QueryExecution for a Card.

(def latest-qe
  [:latest_qe {:select   [:query_execution.card_id :error :query_execution.started_at]
               :from     [:query_execution]
               :join     [[{:select [:card_id [:%max.started_at :started_at]]
                            :from [:query_execution]
                            :group-by [:card_id]} :inner_qe]
                          [:= :query_execution.started_at :inner_qe.started_at]]}])

HoneySQL for a CTE to include the total number of queries for each Card forever.

(def query-runs
  [:query_runs {:select   [:card_id
                           [:%count.* :count]]
                :from     [:query_execution]
                :group-by [:card_id]}])

HoneySQL for a CTE to include the total number of queries for each Card for 45 days.

(def query-runs-45
  [:query_runs (-> {:select   [:card_id
                               [:%count.* :count]]
                    :from     [:query_execution]
                    :group-by [:card_id]}
                   (common/add-45-days-clause :started_at))])

HoneySQL for a CTE to enumerate the dashboards for a Card.

(def dashboards-count
  [:dash_card {:select [:card_id [:%count.* :count]]
               :from [:report_dashboardcard]
               :group-by [:card_id]}])

HoneySQL for a CTE to enumerate the dashboards for a Card. We get the actual ID's

(def dashboards-ids
  [:dash_card {:select [:card_id [(common/group-concat (h2x/cast
                                                        (if (= (mdb.connection/db-type) :mysql) :char :text)
                                                        :report_dashboard.name)
                                                       "|")
                                  :name_str]]
               :from [:report_dashboardcard]
               :join [:report_dashboard [:= :report_dashboardcard.dashboard_id :report_dashboard.id]]
               :group-by [:card_id]}])

HoneySQL for a CTE to include the total view count for each Card.

(def views
  [:card_views {:select   [[:model_id :card_id]
                           [:%count.* :count]]
                :from     [:view_log]
                :where    [:= :model (h2x/literal "card")]
                :group-by [:model_id]}])
 
(ns metabase-enterprise.audit-app.pages.common.dashboards
  (:require
   [honey.sql.helpers :as sql.helpers]
   [metabase-enterprise.audit-app.pages.common :as common]
   [metabase.config :as config]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.urls :as urls]))

Dashboard table!

(defn table
  [query-string & [where-clause]]
  {:metadata [[:dashboard_id              {:display_name "Dashboard ID",         :base_type :type/Integer, :remapped_to :title}]
              [:title                     {:display_name "Title",                :base_type :type/Title,   :remapped_from :dashboard_id}]
              [:saved_by_id               {:display_name "Saved by User ID",     :base_type :type/Text,    :remapped_to :saved_by}]
              [:saved_by                  {:display_name "Saved by",             :base_type :type/Text,    :remapped_from :saved_by_id}]
              [:saved_on                  {:display_name "Saved on",             :base_type :type/DateTime}]
              [:cache_ttl                 {:display_name "Cache Duration",       :base_type :type/Integer}]
              [:last_edited_on            {:display_name "Last edited on",       :base_type :type/DateTime}]
              [:cards                     {:display_name "Cards",                :base_type :type/Integer}]
              [:public_link               {:display_name "Public Link",          :base_type :type/URL}]
              [:average_execution_time_ms {:display_name "Avg. exec. time (ms)", :base_type :type/Decimal}]
              [:total_views               {:display_name "Total views",          :base_type :type/Integer}]]
   :results  (common/reducible-query
              (->
               {:with      [[:card_count {:select   [:dashboard_id
                                                     [:%count.* :card_count]]
                                          :from     [:report_dashboardcard]
                                          :group-by [:dashboard_id]}]
                            [:card_avg_execution_time {:select   [:card_id
                                                                  [:%avg.running_time :avg_running_time]]
                                                       :from     [:query_execution]
                                                       :where    [:not= :card_id nil]
                                                       :group-by [:card_id]}]
                            [:avg_execution_time {:select    [:dc.dashboard_id
                                                              [[:avg :cxt.avg_running_time] :avg_running_time]]
                                                  :from      [[:report_dashboardcard :dc]]
                                                  :left-join [[:card_avg_execution_time :cxt] [:= :dc.card_id :cxt.card_id]]
                                                  :group-by  [:dc.dashboard_id]}]
                            [:views {:select   [[:model_id :dashboard_id]
                                                [:%count.* :view_count]]
                                     :from     [:view_log]
                                     :where    [:= :model (h2x/literal "dashboard")]
                                     :group-by [:model_id]}]]
                :select    [[:d.id :dashboard_id]
                            [:d.name :title]
                            [:u.id :saved_by_id]
                            [(common/user-full-name :u) :saved_by]
                            [:d.created_at :saved_on]
                            [:d.cache_ttl :saved_on]
                            [:d.updated_at :last_edited_on]
                            [:cc.card_count :cards]
                            [[:case
                              [:not= :d.public_uuid nil]
                              (h2x/concat (urls/public-dashboard-prefix) :d.public_uuid)]
                             :public_link]
                            [:axt.avg_running_time :average_execution_time_ms]
                            [:v.view_count :total_views]]
                :from      [[:report_dashboard :d]]
                :left-join [[:core_user :u]            [:= :d.creator_id :u.id]
                            [:card_count :cc]          [:= :d.id :cc.dashboard_id]
                            [:avg_execution_time :axt] [:= :d.id :axt.dashboard_id]
                            [:views :v]                [:= :d.id :v.dashboard_id]]
                :where     [:not= :d.creator_id config/internal-mb-user-id]
                :order-by  [[[:lower :d.name] :asc]
                            [:dashboard_id :asc]]}
               (common/add-search-clause query-string :d.name)
               (sql.helpers/where where-clause)))})
 

Shared code for [[metabase-enterprise.audit-app.pages.dashboard-subscriptions]] and [[metabase-enterprise.audit-app.pages.alerts]].

(ns metabase-enterprise.audit-app.pages.common.pulses
  (:require
   [cheshire.core :as json]
   [metabase.models.collection :as collection]
   [metabase.util.cron :as u.cron]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]))

Common Metadata for the columns returned by both the [[metabase-enterprise.audit-app.pages.dashboard-subscriptions]] and [[metabase-enterprise.audit-app.pages.alerts]] audit queries. (These respective queries also return their own additional columns.)

(def table-metadata
  [[:pulse_id          {:display_name "Pulse ID",      :base_type :type/Integer}]
   [:recipients        {:display_name "Recipients",    :base_type :type/Integer}]
   [:subscription_type {:display_name "Type",          :base_type :type/Text}]
   [:collection_id     {:display_name "Collection ID", :base_type :type/Integer,        :remapped_to :collection_name}]
   [:collection_name   {:display_name "Collection",    :base_type :type/Text,           :remapped_from :collection_id}]
   [:frequency         {:display_name "Frequency",     :base_type :type/Text}]
   [:creator_id        {:display_name "Created By ID", :base_type :type/Integer,        :remapped_to :creator_name}]
   [:creator_name      {:display_name "Created By",    :base_type :type/Text,           :remapped_from :creator_id}]
   [:created_at        {:display_name "Created At",    :base_type :type/DateTimeWithTZ}]
   [:num_filters       {:display_name "Filters",       :base_type :type/Integer}]])

Keyword names of columns returned by the queries by both the [[metabase-enterprise.audit-app.pages.dashboard-subscriptions]] and [[metabase-enterprise.audit-app.pages.alerts]] audit queries.

(def table-query-columns
  [:pulse_id
   :num_user_recipients
   :channel_id
   :channel_details
   :subscription_type
   :collection_id
   :collection_name
   :schedule_type
   :schedule_hour
   :schedule_day
   :schedule_frame
   :creator_id
   :creator_name
   :created_at
   :pulse_parameters])

Common HoneySQL base query for both the [[metabase-enterprise.audit-app.pages.dashboard-subscriptions]] and [[metabase-enterprise.audit-app.pages.alerts]] audit queries. (The respective implementations tweak this query and add additional columns, filters, and order-by clauses.)

(def table-query
  {:with      [[:user_recipients {:select   [[:recipient.pulse_channel_id :channel_id]
                                             [:%count.* :count]]
                                  :from     [[:pulse_channel_recipient :recipient]]
                                  :group-by [:channel_id]}]]
   :select    [[:pulse.id :pulse_id]
               [:user_recipients.count :num_user_recipients]
               [:channel.id :channel_id]
               [:channel.details :channel_details]
               [:channel.channel_type :subscription_type]
               [:collection.id :collection_id]
               [:collection.name :collection_name]
               :channel.schedule_type
               :channel.schedule_hour
               :channel.schedule_day
               :channel.schedule_frame
               [:creator.id :creator_id]
               [(h2x/concat :creator.first_name (h2x/literal " ") :creator.last_name) :creator_name]
               [:channel.created_at :created_at]
               [:pulse.parameters :pulse_parameters]]
   :from      [[:pulse_channel :channel]]
   :left-join [:pulse                         [:= :channel.pulse_id :pulse.id]
               :collection                    [:= :pulse.collection_id :collection.id]
               [:core_user :creator]          [:= :pulse.creator_id :creator.id]
               :user_recipients               [:= :channel.id :user_recipients.channel_id]]
   :where     [:and
               [:not= :pulse.archived true]
               [:= :channel.enabled true]]})
(defn- describe-frequency [row]
  (-> (select-keys row [:schedule_type :schedule_hour :schedule_day :schedule_frame])
      u.cron/schedule-map->cron-string
      u.cron/describe-cron-string))

Return the number of recipients for email PulseChannels. Includes both User recipients (represented by PulseChannelRecipient rows) and plain email recipients (stored directly in the PulseChannel :details). Returns nil for Slack channels.

(defn- describe-recipients
  [{subscription-type :subscription_type
    channel-details   :channel_details
    num-recipients    :num_user_recipients}]
  (let [details (json/parse-string channel-details true)]
    (when (= (keyword subscription-type) :email)
      ((fnil + 0 0) num-recipients (count (:emails details))))))
(defn- pulse-parameter-count [{pulse-parameters :pulse_parameters}]
  (if-let [params (try
                    (some-> pulse-parameters (json/parse-string true))
                    (catch Throwable e
                      (log/error e (trs "Error parsing Pulse parameters: {0}" (ex-message e)))
                      nil))]
    (count params)
    0))
(defn- root-collection-name []
  (:name (collection/root-collection-with-ui-details nil)))

Post-process a row map for the subscription and alert audit page tables. Get this map by doing something like this:

(zipmap table-query-columns row-vector)

This map should contain at least the keys in [[table-query-columns]] (provided by the common [[table-query]]). After calling this function, you'll need to convert the row map back to a vector; something like

(apply juxt (map first table-metadata))

should do the trick.

(defn post-process-row-map
  [row]
  {:pre [(map? row)]}
  (-> row
      (assoc :frequency  (describe-frequency row)
             :recipients (describe-recipients row)
             :num_filters (pulse-parameter-count row))
      (update :subscription_type (fn [subscription-type]
                                   (case (keyword subscription-type)
                                     :email (tru "Email")
                                     :slack (tru "Slack")
                                     subscription-type)))
      (update :collection_name #(or % (root-collection-name)))))
 

Detail page for a single dashboard.

(ns metabase-enterprise.audit-app.pages.dashboard-detail
  (:require
   [metabase-enterprise.audit-app.interface :as audit.i]
   [metabase-enterprise.audit-app.pages.common :as common]
   [metabase-enterprise.audit-app.pages.common.card-and-dashboard-detail
    :as card-and-dash-detail]
   [metabase-enterprise.audit-app.pages.common.cards :as cards]
   [metabase.models.dashboard :refer [Dashboard]]
   [metabase.models.permissions :as perms]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]))

Get views of a Dashboard broken out by a time unit, e.g. day or day-of-week.

(mu/defmethod audit.i/internal-query ::views-by-time
  [_query-type
   dashboard-id  :- ms/PositiveInt
   datetime-unit :- common/DateTimeUnitStr]
  (card-and-dash-detail/views-by-time "dashboard" dashboard-id datetime-unit))

Revision history for a specific Dashboard.

(mu/defmethod audit.i/internal-query ::revision-history
  [_query-type dashboard-id :- ms/PositiveInt]
  (card-and-dash-detail/revision-history Dashboard dashboard-id))

View log for a specific Dashboard.

(mu/defmethod audit.i/internal-query ::audit-log
  [_query-type dashboard-id :- ms/PositiveInt]
  (card-and-dash-detail/audit-log "dashboard" dashboard-id))

Information about the Saved Questions (Cards) in this instance.

(mu/defmethod audit.i/internal-query ::cards
  [_query-type dashboard-id :- ms/PositiveInt]
  {:metadata [[:card_id             {:display_name "Card ID",              :base_type :type/Integer, :remapped_to   :card_name}]
              [:card_name           {:display_name "Title",                :base_type :type/Name,    :remapped_from :card_id}]
              [:collection_id       {:display_name "Collection ID",        :base_type :type/Integer, :remapped_to   :collection_name}]
              [:collection_name     {:display_name "Collection",           :base_type :type/Text,    :remapped_from :collection_id}]
              [:created_at          {:display_name "Created At",           :base_type :type/DateTime}]
              [:database_id         {:display_name "Database ID",          :base_type :type/Integer, :remapped_to   :database_name}]
              [:database_name       {:display_name "Database",             :base_type :type/Text,    :remapped_from :database_id}]
              [:table_id            {:display_name "Table ID",             :base_type :type/Integer, :remapped_to   :table_name}]
              [:table_name          {:display_name "Table",                :base_type :type/Text,    :remapped_from :table_id}]
              [:avg_running_time_ms {:display_name "Avg. exec. time (ms)", :base_type :type/Number}]
              [:cache_ttl           {:display_name "Cache Duration",       :base_type :type/Number}]
              [:public_link         {:display_name "Public Link",          :base_type :type/URL}]
              [:total_views         {:display_name "Total Views",          :base_type :type/Integer}]]
   :results  (common/reducible-query
              {:with      [[:card {:select [:card.*
                                            [:dc.created_at :dashcard_created_at]]
                                   :from   [[:report_dashboardcard :dc]]
                                   :join   [[:report_card :card] [:= :card.id :dc.card_id]]
                                   :where  [:and
                                            [:= :dc.dashboard_id dashboard-id]
                                            [:not= :card.database_id perms/audit-db-id]]}]
                           cards/avg-exec-time
                           cards/views]
               :select    [[:card.id :card_id]
                           [:card.name :card_name]
                           [:coll.id :collection_id]
                           [:coll.name :collection_name]
                           [:card.dashcard_created_at :created_at]
                           :card.database_id
                           [:db.name :database_name]
                           :card.table_id
                           [:t.name :table_name]
                           :avg_exec_time.avg_running_time_ms
                           [(common/card-public-url :card.public_uuid) :public_link]
                           :card.cache_ttl
                           [:card_views.count :total_views]]
               :from      [:card]
               :left-join [:avg_exec_time           [:= :card.id :avg_exec_time.card_id]
                           [:metabase_database :db] [:= :card.database_id :db.id]
                           [:metabase_table :t]     [:= :card.table_id :t.id]
                           [:collection :coll]      [:= :card.collection_id :coll.id]
                           :card_views              [:= :card.id :card_views.card_id]]
               :order-by  [[[:lower :card.name] :asc]]})})
 
(ns metabase-enterprise.audit-app.pages.dashboard-subscriptions
  (:require
   [clojure.string :as str]
   [metabase-enterprise.audit-app.interface :as audit.i]
   [metabase-enterprise.audit-app.pages.common :as common]
   [metabase-enterprise.audit-app.pages.common.pulses :as common.pulses]
   [metabase.util :as u]))
(def ^:private table-metadata
  (into
   [[:dashboard_id   {:display_name "Dashboard ID",  :base_type :type/Integer, :remapped_to :dashboard_name}]
    [:dashboard_name {:display_name "Dashboard Name" :base_type :type/Text,    :remapped_from :dashboard_id}]]
   common.pulses/table-metadata))
(def ^:private table-query-columns
  (into
   [:dashboard_id
    :dashboard_name]
   common.pulses/table-query-columns))
(defn- table-query [dashboard-name]
  (-> common.pulses/table-query
      (update :select (partial into
                               [[:dashboard.id :dashboard_id]
                                [:dashboard.name :dashboard_name]]))
      (update :left-join into [[:report_dashboard :dashboard] [:= :pulse.dashboard_id :dashboard.id]])
      (update :where (fn [where]
                       (into
                        where
                        (filter some?)
                        [[:not= :pulse.dashboard_id nil]
                         (when-not (str/blank? dashboard-name)
                           [:like [:lower :dashboard.name] (str \% (u/lower-case-en dashboard-name) \%)])])))
      (assoc :order-by [[[:lower :dashboard.name] :asc]
                        ;; Newest first. ID instead of `created_at` because the column is currently only
                        ;; second-resolution for MySQL which busts our tests
                        [:channel.id :desc]])))
(def ^:private ^{:arglists '([row-map])} row-map->vec
  (apply juxt (map first table-metadata)))
(defn- post-process-row [row]
  (-> (zipmap table-query-columns row)
      common.pulses/post-process-row-map
      row-map->vec))

with optional param dashboard-name, only show subscriptions matching dashboard name.

(defmethod audit.i/internal-query ::table
  ([query-type]
   (audit.i/internal-query query-type nil))

  ([_ dashboard-name]
   {:metadata table-metadata
    :results  (common/reducible-query (table-query dashboard-name))
    :xform    (map post-process-row)}))
 

Dashboards overview page.

(ns metabase-enterprise.audit-app.pages.dashboards
  (:require
   [metabase-enterprise.audit-app.interface :as audit.i]
   [metabase-enterprise.audit-app.pages.common :as common]
   [metabase-enterprise.audit-app.pages.common.dashboards :as dashboards]
   [metabase.config :as config]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.malli :as mu]))

Two-series timeseries that includes total number of Dashboard views and saves broken out by a datetime-unit.

(mu/defmethod audit.i/internal-query ::views-and-saves-by-time
  [_query-type datetime-unit :- common/DateTimeUnitStr]
  {:metadata [[:date  {:display_name "Date",  :base_type (common/datetime-unit-str->base-type datetime-unit)}]
              [:views {:display_name "Views", :base_type :type/Integer}]
              [:saves {:display_name "Saves", :base_type :type/Integer}]]
   ;; this is so nice and easy to implement in a single query with FULL OUTER JOINS but unfortunately only pg supports
   ;; them(!)
   :results (let [views        (common/query
                                {:select    [[(common/grouped-datetime datetime-unit :timestamp) :date]
                                             [:%count.* :views]]
                                 :from      [[:view_log :vl]]
                                 :left-join [[:report_dashboard :d] [:= :vl.model_id :d.id]]
                                 :where     [:and
                                             [:= :model (h2x/literal "dashboard")]
                                             [:not= :d.creator_id config/internal-mb-user-id]]
                                 :group-by  [(common/grouped-datetime datetime-unit :timestamp)]})
                  date->views  (zipmap (map :date views) (map :views views))
                  saves        (common/query
                                {:select   [[(common/grouped-datetime datetime-unit :created_at) :date]
                                            [:%count.* :saves]]
                                 :from     [[:report_dashboard :d]]
                                 :where    [:not= :d.creator_id config/internal-mb-user-id]
                                 :group-by [(common/grouped-datetime datetime-unit :created_at)]})
                  date->saves  (zipmap (map :date saves) (map :saves saves))
                  all-dates    (sort (keep identity (distinct (concat (keys date->views)
                                                                      (keys date->saves)))))]
              (for [date all-dates]
                {:date date
                 :views (date->views date 0)
                 :saves (date->saves date 0)}))})

DEPRECATED Use most-popular-with-avg-speed instead.

(defmethod audit.i/internal-query ::most-popular
  [_]
  {:metadata [[:dashboard_id   {:display_name "Dashboard ID", :base_type :type/Integer, :remapped_to   :dashboard_name}]
              [:dashboard_name {:display_name "Dashboard",    :base_type :type/Title,   :remapped_from :dashboard_id}]
              [:views          {:display_name "Views",        :base_type :type/Integer}]]
   :results  (common/reducible-query
              {:select    [[:d.id :dashboard_id]
                           [:d.name :dashboard_name]
                           [:%count.* :views]]
               :from      [[:view_log :vl]]
               :left-join [[:report_dashboard :d] [:= :vl.model_id :d.id]]
               :where     [:and
                           [:= :vl.model (h2x/literal "dashboard")]
                           [:not= :d.creator_id config/internal-mb-user-id]]
               :group-by  [:d.id]
               :order-by  [[:%count.* :desc]]
               :limit     10})})

Ten most popular dashboards with their average speed.

(defmethod audit.i/internal-query ::most-popular-with-avg-speed
  [_]
  {:metadata [[:dashboard_id     {:display_name "Dashboard ID",                 :base_type :type/Integer, :remapped_to   :dashboard_name}]
              [:dashboard_name   {:display_name "Dashboard",                    :base_type :type/Title,   :remapped_from :dashboard_id}]
              [:views            {:display_name "Views",                        :base_type :type/Integer}]
              [:avg_running_time {:display_name "Avg. Question Load Time (ms)", :base_type :type/Decimal}]]
   :results  (common/reducible-query
              {:with      [[:most_popular {:select    [[:d.id :dashboard_id]
                                                       [:d.name :dashboard_name]
                                                       [:%count.* :views]
                                                       [:d.creator_id :creator_id]]
                                           :from      [[:view_log :vl]]
                                           :left-join [[:report_dashboard :d] [:= :vl.model_id :d.id]]
                                           :where     [:= :vl.model (h2x/literal "dashboard")]
                                           :group-by  [:d.id]
                                           :order-by  [[:%count.* :desc]]
                                           :limit     [:inline 10]}]
                           [:card_running_time {:select   [:qe.card_id
                                                           [[:avg :qe.running_time] :avg_running_time]]
                                                :from     [[:query_execution :qe]]
                                                :where    [:not= :qe.card_id nil]
                                                :group-by [:qe.card_id]}]
                           [:dash_avg_running_time {:select    [[:d.id :dashboard_id]
                                                                [[:avg :rt.avg_running_time] :avg_running_time]]
                                                    :from      [[:report_dashboardcard :dc]]
                                                    :left-join [[:card_running_time :rt] [:= :dc.card_id :rt.card_id]
                                                                [:report_dashboard :d]   [:= :dc.dashboard_id :d.id]]
                                                    :group-by  [:d.id]
                                                    :where     [:in :d.id {:select [:dashboard_id]
                                                                           :from   [:most_popular]}]}]]
               :select    [:mp.dashboard_id
                           :mp.dashboard_name
                           :mp.views
                           :rt.avg_running_time]
               :from      [[:most_popular :mp]]
               :left-join [[:dash_avg_running_time :rt] [:= :mp.dashboard_id :rt.dashboard_id]]
               :where     [:not= :mp.creator_id config/internal-mb-user-id]
               :order-by  [[:mp.views :desc]]
               :limit     10})})

DEPRECATED Query that returns the 10 Dashboards that have the slowest average execution times, in descending order.

(defmethod audit.i/internal-query ::slowest
  [_]
  {:metadata [[:dashboard_id     {:display_name "Dashboard ID",                 :base_type :type/Integer, :remapped_to   :dashboard_name}]
              [:dashboard_name   {:display_name "Dashboard",                    :base_type :type/Title,   :remapped_from :dashboard_id}]
              [:avg_running_time {:display_name "Avg. Question Load Time (ms)", :base_type :type/Decimal}]]
   :results  (common/reducible-query
              {:with      [[:card_running_time {:select   [:qe.card_id
                                                           [[:avg :qe.running_time] :avg_running_time]]
                                                :from     [[:query_execution :qe]]
                                                :where    [:not= :qe.card_id nil]
                                                :group-by [:qe.card_id]}]]
               :select    [[:d.id :dashboard_id]
                           [:d.name :dashboard_name]
                           [[:avg :rt.avg_running_time] :avg_running_time]]
               :from      [[:report_dashboardcard :dc]]
               :left-join [[:card_running_time :rt] [:= :dc.card_id :rt.card_id]
                           [:report_dashboard :d]   [:= :dc.dashboard_id :d.id]]
               :where     [:not= :d.creator_id config/internal-mb-user-id]
               :group-by  [:d.id]
               :order-by  [[:avg_running_time :desc]]
               :limit     10})})

DEPRECATED Query that returns the 10 Cards that appear most often in Dashboards, in descending order.

(defmethod audit.i/internal-query ::most-common-questions
  [_]
  {:metadata [[:card_id   {:display_name "Card ID", :base_type :type/Integer, :remapped_to   :card_name}]
              [:card_name {:display_name "Card",    :base_type :type/Title,   :remapped_from :card_id}]
              [:count     {:display_name "Count",   :base_type :type/Integer}]]
   :results  (common/reducible-query
              {:select   [[:c.id :card_id]
                          [:c.name :card_name]
                          [:%count.* :count]]
               :from     [[:report_dashboardcard :dc]]
               :join     [[:report_card :c] [:= :c.id :dc.card_id]]
               :where    [:not= :c.creator_id config/internal-mb-user-id]
               :group-by [:c.id]
               :order-by [[:%count.* :desc]]
               :limit    10})})

Internal audit app query powering a table of different Dashboards with lots of extra info about them.

(mu/defmethod audit.i/internal-query ::table
  ([query-type]
   (audit.i/internal-query query-type nil))
  ([_query-type query-string :- [:maybe :string]]
   (dashboards/table query-string)))
 
(ns metabase-enterprise.audit-app.pages.database-detail
  (:require
   [metabase-enterprise.audit-app.interface :as audit.i]
   [metabase-enterprise.audit-app.pages.common :as common]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [ring.util.codec :as codec]))

Query execution history for queries against this Database.

(mu/defmethod audit.i/internal-query ::audit-log
  [_query-type database-id :- ms/PositiveInt]
  {:metadata [[:started_at {:display_name "Viewed on",  :base_type :type/DateTime}]
              [:card_id    {:display_name "Card ID",    :base_type :type/Integer, :remapped_to   :query}]
              [:query_hash {:display_name "Query Hash", :base_type :type/Text}]
              [:query      {:display_name "Query",      :base_type :type/Text,    :remapped_from :card_id}]
              [:user_id    {:display_name "User ID",    :base_type :type/Integer, :remapped_to   :user}]
              [:user       {:display_name "Queried by", :base_type :type/Text,    :remapped_from :user_id}]
              [:schema     {:display_name "Schema",     :base_type :type/Text}]
              [:table_id   {:display_name "Table ID",   :base_type :type/Integer, :remapped_to   :table}]
              [:table      {:display_name "Table",      :base_type :type/Text,    :remapped_from :table_id}]]
   :results (common/reducible-query
             {:select    [:qe.started_at
                          [:card.id :card_id]
                          [:qe.hash :query_hash]
                          [(common/card-name-or-ad-hoc :card) :query]
                          [:u.id :user_id]
                          [(common/user-full-name :u) :user]
                          :t.schema
                          [:t.id :table_id]
                          [:t.name :table]]
              :from      [[:query_execution :qe]]
              :where     [:= :qe.database_id database-id]
              :join      [[:metabase_database :db] [:= :db.id :qe.database_id]
                          [:core_user :u] [:= :qe.executor_id :u.id]]
              :left-join [[:report_card :card] [:= :qe.card_id :card.id]
                          [:metabase_table :t] [:= :card.table_id :t.id]]
              :order-by  [[:qe.started_at :desc]]})
   :xform   (map #(update (vec %) 2 codec/base64-encode))})
 
(ns metabase-enterprise.audit-app.pages.databases
  (:require
   [metabase-enterprise.audit-app.interface :as audit.i]
   [metabase-enterprise.audit-app.pages.common :as common]
   [metabase.models.permissions :as perms]
   [metabase.util.cron :as u.cron]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.malli :as mu]))

SELECT db.id AS database_id, db.name AS database_name, count(*) AS queries, avg(qe.runningtime) AS avgrunning_time FROM query_execution qe JOIN reportcard card ON qe.cardid = card.id JOIN metabasetable t ON card.tableid = t.id JOIN metabasedatabase db ON t.dbid = db.id WHERE db.id != audit-db-id GROUP BY db.id ORDER BY lower(db.name) ASC

DEPRECATED Return Databases with the total number of queries ran against them and the average running time for all queries.

(defmethod audit.i/internal-query ::total-query-executions-by-db
  [_]
  {:metadata [[:database_id      {:display_name "Database ID",            :base_type :type/Integer, :remapped_to   :database_name}]
              [:database_name    {:display_name "Database",               :base_type :type/Text,    :remapped_from :database_id}]
              [:queries          {:display_name "Queries",                :base_type :type/Integer}]
              [:avg_running_time {:display_name "Avg. Running Time (ms)", :base_type :type/Decimal}]]
   :results  (common/reducible-query
              {:select   [[:db.id :database_id]
                          [:db.name :database_name]
                          [:%count.* :queries]
                          [[:avg :qe.running_time] :avg_running_time]]
               :from     [[:query_execution :qe]]
               :join     [[:report_card :card]     [:= :qe.card_id :card.id]
                          [:metabase_table :t]     [:= :card.table_id :t.id]
                          [:metabase_database :db] [:= :t.db_id :db.id]]
               :where    [:not= :db.id perms/audit-db-id]
               :group-by [:db.id]
               :order-by [[[:lower :db.name] :asc]]})})

Query that returns count of query executions grouped by Database and a datetime-unit.

(mu/defmethod audit.i/internal-query ::query-executions-by-time
  [_query-type datetime-unit :- common/DateTimeUnitStr]
  {:metadata [[:date          {:display_name "Date",          :base_type (common/datetime-unit-str->base-type datetime-unit)}]
              [:database_id   {:display_name "Database ID",   :base_type :type/Integer, :remapped_to   :database_name}]
              [:database_name {:display_name "Database Name", :base_type :type/Name,    :remapped_from :database_id}]
              [:count         {:display_name "Count",         :base_type :type/Integer}]]
   :results  (common/reducible-query
              {:with      [[:qx {:select    [[(common/grouped-datetime datetime-unit :qe.started_at) :date]
                                             :card.database_id
                                             [:%count.* :count]]
                                 :from      [[:query_execution :qe]]
                                 :left-join [[:report_card :card] [:= :qe.card_id :card.id]]
                                 :where     [:and
                                             [:not= :qe.card_id nil]
                                             [:not= :card.database_id nil]
                                             [:not= :card.database_id perms/audit-db-id]]
                                 :group-by  [(common/grouped-datetime datetime-unit :qe.started_at) :card.database_id]
                                 :order-by  [[(common/grouped-datetime datetime-unit :qe.started_at) :asc]
                                             [:card.database_id :asc]]}]]
               :select    [:qx.date
                           :qx.database_id
                           [:db.name :database_name]
                           :qx.count]
               :from      [:qx]
               :left-join [[:metabase_database :db] [:= :qx.database_id :db.id]]
               :order-by  [[:qx.date :asc]
                           [[:lower :db.name] :asc]
                           [:qx.database_id :asc]]})})

DEPRECATED Use ::query-executions-by-time instead. Query that returns count of query executions grouped by Database and day.

(defmethod audit.i/internal-query ::query-executions-per-db-per-day
  [_]
  (audit.i/internal-query ::query-executions-by-time "day"))

Table with information and statistics about all the data warehouse Databases in this Metabase instance.

(mu/defmethod audit.i/internal-query ::table
  ([query-type]
   (audit.i/internal-query query-type nil))
  ([_query-type query-string :- [:maybe :string]]
   ;; TODO - Should we convert sync_schedule from a cron string into English? Not sure that's going to be feasible for
   ;; really complicated schedules
   {:metadata [[:database_id   {:display_name "Database ID", :base_type :type/Integer, :remapped_to :title}]
               [:title         {:display_name "Title", :base_type :type/Text, :remapped_from :database_id}]
               [:added_on      {:display_name "Added On", :base_type :type/DateTime}]
               [:sync_schedule {:display_name "Sync Schedule", :base_type :type/Text}]
               [:schemas       {:display_name "Schemas", :base_type :type/Integer}]
               [:tables        {:display_name "Tables", :base_type :type/Integer}]
               [:cache_ttl     {:display_name "Cache Duration", :base_type :type/Integer}]]
    :results  (common/reducible-query
               (->
                {:with      [[:counts {:select   [[:db_id :id]
                                                  [[::h2x/distinct-count :schema] :schemas]
                                                  [:%count.* :tables]]
                                       :from     [:metabase_table]
                                       :group-by [:db_id]}]]
                 :select    [[:db.id :database_id]
                             [:db.name :title]
                             [:db.created_at :added_on]
                             [:db.metadata_sync_schedule :sync_schedule]
                             [:counts.schemas :schemas]
                             [:counts.tables :tables]
                             [:db.cache_ttl :cache_ttl]]
                 :from      [[:metabase_database :db]]
                 :left-join [:counts [:= :db.id :counts.id]]
                 :where     [:not= :db.id perms/audit-db-id]
                 :order-by  [[[:lower :db.name] :asc]
                             [:database_id :asc]]}
                (common/add-search-clause query-string :db.name)))
    :xform    (map #(update (vec %) 3 u.cron/describe-cron-string))}))
 

Audit queries returning info about query downloads. Query downloads are any query executions whose results are returned as CSV/JSON/XLS.

(ns metabase-enterprise.audit-app.pages.downloads
  (:require
   [metabase-enterprise.audit-app.interface :as audit.i]
   [metabase-enterprise.audit-app.pages.common :as common]
   [metabase.db :as mdb]
   [metabase.driver.sql.query-processor :as sql.qp]
   [metabase.models.permissions :as perms]
   [metabase.util.honey-sql-2 :as h2x]))
(set! *warn-on-reflection* true)

Pairs of count of rows downloaded and date downloaded for the 1000 largest (in terms of row count) queries over the past 30 days. Intended to power scatter plot.

(defmethod audit.i/internal-query ::per-day-by-size
  [_]
  {:metadata [[:date      {:display_name "Day",           :base_type :type/DateTime}]
              [:rows      {:display_name "Rows in Query", :base_type :type/Integer}]
              [:user_id   {:display_name "User ID",       :base_type :type/Integer, :remapped_to :user_name}]
              [:user_name {:display_name "User",          :base_type :type/Text,    :remapped_from :user_id}]]
   :results  (common/reducible-query
              {:select   [[:qe.started_at :date]
                          [:qe.result_rows :rows]
                          [:qe.executor_id :user_id]
                          [(common/user-full-name :u) :user_name]]
               :from     [[:query_execution :qe]]
               :left-join [[:core_user :u] [:= :qe.executor_id :u.id]]
               :where    [:and
                          [:> :qe.started_at (sql.qp/add-interval-honeysql-form (mdb/db-type) :%now -30 :day)]
                          (common/query-execution-is-download :qe)]
               :order-by [[:qe.result_rows :desc]]
               :limit    1000})})

Total count of query downloads broken out by user, ordered by highest total, for the top 10 users.

(defmethod audit.i/internal-query ::per-user
  [_]
  {:metadata [[:user_id   {:display_name "User ID",   :base_type :type/Integer, :remapped_to :user_name}]
              [:user_name {:display_name "User",      :base_type :type/Text,    :remapped_from :user_id}]
              [:downloads {:display_name "Downloads", :base_type :type/Integer}]]
   :results  (common/reducible-query
              {:with     [[:downloads_by_user
                           {:select   [[:qe.executor_id :user_id]
                                       [:%count.* :downloads]]
                            :from     [[:query_execution :qe]]
                            :where    (common/query-execution-is-download :qe)
                            :group-by [:qe.executor_id]
                            :order-by [[:%count.* :desc]]
                            :limit    10}]]
               :select   [[:d.user_id :user_id]
                          [(common/user-full-name :u) :user_name]
                          [:d.downloads :downloads]]
               :from     [[:downloads_by_user :d]]
               :join     [[:core_user :u] [:= :d.user_id :u.id]]
               :order-by [[:d.downloads :desc]]})})

Add/remove numbers here to adjust buckets returned by the by-size query.

(def ^:private bucket-maxes
  [     10
       100
      1000
      5000
     10000
     50000
    100000
    500000
   1000000])

CASE expression to put result_rows in appropriate buckets. Looks something like:

CASE ... result_rows <= 100 THEN 100 ...

(def ^:private rows->bucket-case-expression
  (into [:case] (concat
                 (mapcat (fn [bucket-max]
                           [[:<= :result_rows bucket-max] bucket-max])
                         bucket-maxes)
                 [:else -1])))

Pairs like [[0 10], [11 100], ...]

(def ^:private bucket-ranges
  (reduce
   (fn [acc bucket-max]
     (conj acc [(or (some-> acc last last inc) 0) ; get min from last pair in acc or 0
                bucket-max]))
   []
   bucket-maxes))

Format number to string adding commas as thousands separators.

(defn- format-number-add-commas
  [^Number n]
  (.format (java.text.DecimalFormat. "#,###") n))

Given a bucket range pair like [101 1000] return a formatted string including commas like 101-1,000.

(defn- bucket-range->literal
  [[bucket-min bucket-max]]
  (h2x/literal (format "%s-%s" (format-number-add-commas bucket-min) (format-number-add-commas bucket-max))))

CASE expression to generate range strings for each bucket. Looks something like:

CASE ... (rowsbucketmax = 1000) THEN '101-1,000' ...

(def ^:private bucket->range-str-case-expression
  (into [:case] (concat
                 (mapcat (fn [[_ bucket-max :as bucket-range]]
                           [[:= :rows_bucket_max bucket-max] (bucket-range->literal bucket-range)])
                         bucket-ranges)
                 [[:= :rows_bucket_max -1]
                  (h2x/literal (format "> %s" (format-number-add-commas (last bucket-maxes))))])))

Query download count broken out by bucketed number of rows of query. E.g. 10 downloads of queries with 0-10 rows, 15 downloads of queries with 11-100, etc. Intended to power bar chart.

(defmethod audit.i/internal-query ::by-size
  [_]
  {:metadata [[:rows      {:display_name "Rows Downloaded", :base_type :type/Text}]
              [:downloads {:display_name "Downloads",       :base_type :type/Integer}]]
   :results  (common/reducible-query
              {:with     [[:bucketed_downloads
                           {:select [[rows->bucket-case-expression :rows_bucket_max]]
                            :from   [:query_execution]
                            :where  [:and
                                     (common/query-execution-is-download :query_execution)
                                     [:not= :result_rows nil]]}]]
               :select   [[bucket->range-str-case-expression :rows]
                          [:%count.* :downloads]]
               :from     [:bucketed_downloads]
               :group-by [:rows_bucket_max]
               :order-by [[:rows_bucket_max :asc]]})})

Table showing all query downloads ordered by most recent.

(defmethod audit.i/internal-query ::table
  [_]
  {:metadata [[:downloaded_at   {:display_name "Downloaded At",   :base_type :type/DateTime}]
              [:rows_downloaded {:display_name "Rows Downloaded", :base_type :type/Integer}]
              [:card_id         {:display_name "Card ID",         :base_type :type/Integer, :remapped_to :card_name}]
              [:card_name       {:display_name "Query",           :base_type :type/Text,    :remapped_from :card_id}]
              [:query_type      {:display_name "Query Type",      :base_type :type/Text}]
              [:database_id     {:display_name "Database ID",     :base_type :type/Integer, :remapped_to :database}]
              [:database        {:display_name "Database",        :base_type :type/Text,    :remapped_from :database_id}]
              [:source_table_id {:display_name "Source Table ID", :base_type :type/Integer, :remapped_to :source_table}]
              [:source_table    {:display_name "Source Table",    :base_type :type/Text,    :remapped_from :source_table_id}]
              [:user_id         {:display_name "User ID",         :base_type :type/Integer, :remapped_to :user_name}]
              [:user_name       {:display_name "User",            :base_type :type/Text,    :remapped_from :user_id}]]
   :results  (common/reducible-query
              {:select    [[:qe.started_at :downloaded_at]
                           [:qe.result_rows :rows_downloaded]
                           [:card.id :card_id]
                           [(common/card-name-or-ad-hoc :card) :card_name]
                           [(common/native-or-gui :qe) :query_type]
                           [:db.id :database_id]
                           [:db.name :database]
                           [:t.id :source_table_id]
                           [:t.name :source_table]
                           [:qe.executor_id :user_id]
                           [(common/user-full-name :u) :user_name]]
               :from      [[:query_execution :qe]]
               :left-join [[:report_card :card] [:= :card.id :qe.card_id]
                           [:metabase_database :db] [:= :qe.database_id :db.id]
                           [:metabase_table :t] [:= :card.table_id :t.id]
                           [:core_user :u] [:= :qe.executor_id :u.id]]
               :where     [:and
                           (common/query-execution-is-download :qe)
                           [:not= :card.database_id perms/audit-db-id]]
               :order-by  [[:qe.started_at :desc]]})})
 
(ns metabase-enterprise.audit-app.pages.queries
  (:require
   [metabase-enterprise.audit-app.interface :as audit.i]
   [metabase-enterprise.audit-app.pages.common :as common]
   [metabase-enterprise.audit-app.pages.common.cards :as cards]
   [metabase.db.connection :as mdb.connection]
   [metabase.models.permissions :as perms]
   [metabase.util.honey-sql-2 :as h2x]))

DEPRECATED Query that returns data for a two-series timeseries chart with number of queries ran and average query running time broken out by day.

(defmethod audit.i/internal-query ::views-and-avg-execution-time-by-day
  [_]
  {:metadata [[:day              {:display_name "Date",                   :base_type :type/Date}]
              [:views            {:display_name "Views",                  :base_type :type/Integer}]
              [:avg_running_time {:display_name "Avg. Running Time (ms)", :base_type :type/Decimal}]]
   :results  (common/reducible-query
              {:select   [[(h2x/cast :date :started_at) :day]
                          [:%count.* :views]
                          [[:avg :running_time] :avg_running_time]]
               :from     [:query_execution]
               :group-by [(h2x/cast :date :started_at)]
               :order-by [[(h2x/cast :date :started_at) :asc]]})})

Query that returns the 10 most-popular Cards based on number of query executions, in descending order.

(defmethod audit.i/internal-query ::most-popular
  [_]
  {:metadata [[:card_id    {:display_name "Card ID",    :base_type :type/Integer, :remapped_to   :card_name}]
              [:card_name  {:display_name "Card",       :base_type :type/Title,   :remapped_from :card_id}]
              [:executions {:display_name "Executions", :base_type :type/Integer}]]
   :results  (common/reducible-query
              {:select   [[:c.id :card_id]
                          [:c.name :card_name]
                          [:%count.* :executions]]
               :from     [[:query_execution :qe]]
               :join     [[:report_card :c] [:= :qe.card_id :c.id]]
               :group-by [:c.id]
               :order-by [[:executions :desc]]
               :limit    10})})

DEPRECATED Query that returns the 10 slowest-running Cards based on average query execution time, in descending order.

(defmethod audit.i/internal-query ::slowest
  [_]
  {:metadata [[:card_id          {:display_name "Card ID",                :base_type :type/Integer, :remapped_to   :card_name}]
              [:card_name        {:display_name "Card",                   :base_type :type/Title,   :remapped_from :card_id}]
              [:avg_running_time {:display_name "Avg. Running Time (ms)", :base_type :type/Decimal}]]
   :results  (common/reducible-query
              {:select   [[:c.id :card_id]
                          [:c.name :card_name]
                          [[:avg :running_time] :avg_running_time]]
               :from     [[:query_execution :qe]]
               :join     [[:report_card :c] [:= :qe.card_id :c.id]]
               :group-by [:c.id]
               :order-by [[:avg_running_time :desc]]
               :limit    10})})

List of all failing questions

(defmethod audit.i/internal-query ::bad-table
  ([_]
   (audit.i/internal-query ::bad-table nil nil nil nil nil))
  ([_
    error-filter
    db-filter
    collection-filter
    sort-column
    sort-direction]
   {:metadata [[:card_id         {:display_name "Card ID",            :base_type :type/Integer :remapped_to   :card_name}]
               [:card_name       {:display_name "Question",           :base_type :type/Text    :remapped_from :card_id}]
               [:error_substr    {:display_name "Error",              :base_type :type/Text    :code          true}]
               [:collection_id   {:display_name "Collection ID",      :base_type :type/Integer :remapped_to   :collection_name}]
               [:collection_name {:display_name "Collection",         :base_type :type/Text    :remapped_from :collection_id}]
               [:database_id     {:display_name "Database ID",        :base_type :type/Integer :remapped_to   :database_name}]
               [:database_name   {:display_name "Database",           :base_type :type/Text    :remapped_from :database_id}]
               [:schema_name     {:display_name "Schema",             :base_type :type/Text}]
               [:table_id        {:display_name "Table ID",           :base_type :type/Integer :remapped_to   :table_name}]
               [:table_name      {:display_name "Table",              :base_type :type/Text    :remapped_from :table_id}]
               [:last_run_at     {:display_name "Last run at",        :base_type :type/DateTime}]
               [:total_runs      {:display_name "Total runs",         :base_type :type/Integer}]
               ;; if it appears a billion times each in 2 dashboards, that's 2 billion appearances
               [:num_dashboards  {:display_name "Dashboards it's in", :base_type :type/Integer}]
               [:user_id         {:display_name "Created By ID",      :base_type :type/Integer :remapped_to   :user_name}]
               [:user_name       {:display_name "Created By",         :base_type :type/Text    :remapped_from :user_id}]
               [:updated_at      {:display_name "Updated At",         :base_type :type/DateTime}]]
    :results (common/reducible-query
              (let [coll-name    [:coalesce :coll.name "Our Analytics"]
                    error-substr [:concat
                                  [:substring
                                   :latest_qe.error
                                   [:inline (if (= (mdb.connection/db-type) :mysql) 1 0)]
                                   [:inline 60]]
                                  "..."]
                    dash-count   [:coalesce :dash_card.count [:inline 0]]]
                (->
                 {:with      [cards/query-runs
                              cards/latest-qe
                              cards/dashboards-count]
                  :select    [[:card.id :card_id]
                              [:card.name :card_name]
                              [error-substr :error_substr]
                              :collection_id
                              [coll-name :collection_name]
                              :card.database_id
                              [:db.name :database_name]
                              [:t.schema :schema_name]
                              :card.table_id
                              [:t.name :table_name]
                              [:latest_qe.started_at :last_run_at]
                              [:query_runs.count :total_runs]
                              [dash-count :num_dashboards]
                              [:card.creator_id :user_id]
                              [(common/user-full-name :u) :user_name]
                              [:card.updated_at :updated_at]]
                  :from      [[:report_card :card]]
                  :left-join [[:collection :coll]                [:= :card.collection_id :coll.id]
                              [:metabase_database :db]           [:= :card.database_id :db.id]
                              [:metabase_table :t]               [:= :card.table_id :t.id]
                              [:core_user :u]                    [:= :card.creator_id :u.id]
                              :latest_qe                         [:= :card.id :latest_qe.card_id]
                              :query_runs                        [:= :card.id :query_runs.card_id]
                              :dash_card                         [:= :card.id :dash_card.card_id]]
                  :where     [:and
                              [:= :card.archived false]
                              [:<> :latest_qe.error nil]
                              [:not= :card.database_id perms/audit-db-id]]}
                 (common/add-search-clause error-filter :latest_qe.error)
                 (common/add-search-clause db-filter :db.name)
                 (common/add-search-clause collection-filter coll-name)
                 (common/add-sort-clause
                  (or sort-column "card.name")
                  (or sort-direction "asc")))))}))

A list of all questions.

Three possible argument lists. All arguments are always nullable.

  • [] : Dump them all, sort by name ascending

  • [question-filter] : Dump all filtered by the question-filter string, sort by name ascending. question-filter filters on the name column in cards table.

  • [question-filter, collection-filter, sort-column, sort-direction] : Dump all filtered by both question-filter and collection-filter, sort by the given column and sort direction. question-filter filters on the name column in cards table. collection-filter filters on the name column in collections table.

Sort column is given over in keyword form to honeysql. Default card.name

Sort direction can be asc or desc, ascending and descending respectively. Default asc.

All inputs have to be strings because that's how the magic middleware that turns these functions into clojure-backed 'datasets' works.

(defmethod audit.i/internal-query ::table
  ([query-type]
   (audit.i/internal-query query-type nil nil nil nil))

  ([query-type question-filter]
   (audit.i/internal-query query-type question-filter nil nil nil))

  ([_
    question-filter
    collection-filter
    sort-column
    sort-direction]
   {:metadata [[:card_id         {:display_name "Card ID",              :base_type :type/Integer, :remapped_to   :card_name}]
               [:card_name       {:display_name "Name",                 :base_type :type/Name,    :remapped_from :card_id}]
               [:collection_id   {:display_name "Collection ID",        :base_type :type/Integer, :remapped_to   :collection_name}]
               [:collection_name {:display_name "Collection",           :base_type :type/Text,    :remapped_from :collection_id}]
               [:database_id     {:display_name "Database ID",          :base_type :type/Integer, :remapped_to   :database_name}]
               [:database_name   {:display_name "Database",             :base_type :type/Text,    :remapped_from :database_id}]
               [:table_id        {:display_name "Table ID",             :base_type :type/Integer, :remapped_to   :table_name}]
               [:table_name      {:display_name "Table",                :base_type :type/Text,    :remapped_from :table_id}]
               [:user_id         {:display_name "Created By ID",        :base_type :type/Integer, :remapped_to   :user_name}]
               [:user_name       {:display_name "Created By",           :base_type :type/Text,    :remapped_from :user_id}]
               [:cache_ttl       {:display_name "Cache Duration",       :base_type :type/Integer}]
               [:avg_exec_time   {:display_name "Average Runtime (ms)", :base_type :type/Integer}]
               [:total_runtime   {:display_name "Total Runtime (ms)",   :base_type :type/Integer}]
               [:query_runs      {:display_name "Query Runs",           :base_type :type/Integer}]
               [:public_link     {:display_name "Public Link",          :base_type :type/URL}]]
    :results  (common/reducible-query
               (->
                {:with      [cards/avg-exec-time-45
                             cards/total-exec-time-45
                             cards/query-runs-45]
                 :select    [[:card.id :card_id]
                             [:card.name :card_name]
                             :collection_id
                             [:coll.name :collection_name]
                             :card.database_id
                             [:db.name :database_name]
                             :card.table_id
                             [:t.name :table_name]
                             [:card.creator_id :user_id]
                             [(common/user-full-name :u) :user_name]
                             :card.cache_ttl
                             [:avg_exec_time_45.avg_running_time_ms :avg_exec_time]
                             [:total_runtime_45.total_running_time_ms :total_runtime]
                             [(common/zero-if-null :query_runs.count) :query_runs]
                             [(common/card-public-url :card.public_uuid) :public_link]]
                 :from      [[:report_card :card]]
                 :left-join [[:collection :coll]      [:= :card.collection_id :coll.id]
                             [:metabase_database :db] [:= :card.database_id :db.id]
                             [:metabase_table :t]     [:= :card.table_id :t.id]
                             [:core_user :u]          [:= :card.creator_id :u.id]
                             :avg_exec_time_45        [:= :card.id :avg_exec_time_45.card_id]
                             :total_runtime_45        [:= :card.id :total_runtime_45.card_id]
                             :query_runs              [:= :card.id :query_runs.card_id]]
                 :where     [:and
                             [:= :card.archived false]
                             [:not= :card.database_id perms/audit-db-id]]}
                (common/add-search-clause question-filter :card.name)
                (common/add-search-clause collection-filter :coll.name)
                (common/add-sort-clause
                 (or sort-column "card.name")
                 (or sort-direction "asc"))))}))
 

Queries to show details about a (presumably ad-hoc) query.

(ns metabase-enterprise.audit-app.pages.query-detail
  (:require
   [cheshire.core :as json]
   [metabase-enterprise.audit-app.interface :as audit.i]
   [metabase-enterprise.audit-app.pages.common :as common]
   [metabase-enterprise.audit-app.pages.common.cards :as cards]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [ring.util.codec :as codec]))
(mu/defmethod audit.i/internal-query ::bad-card
  [_query-type card-id :- ms/PositiveInt]
  {:metadata [[:card_id         {:display_name "Question ID",        :base_type :type/Integer :remapped_from :card_name}]
              [:card_name       {:display_name "Question",           :base_type :type/Text    :remapped_from :card_id}]
              [:error_str       {:display_name "Error",              :base_type :type/Text    :code          true}]
              [:collection_id   {:display_name "Collection ID",      :base_type :type/Integer :remapped_to   :collection_name}]
              [:collection_name {:display_name "Collection",         :base_type :type/Text    :remapped_from :collection_id}]
              [:database_id     {:display_name "Database ID",        :base_type :type/Integer :remapped_to   :database_name}]
              [:database_name   {:display_name "Database",           :base_type :type/Text    :remapped_from :database_id}]
              [:schema_name     {:display_name "Schema",             :base_type :type/Text}]
              [:table_id        {:display_name "Table ID",           :base_type :type/Integer :remapped_to   :table_name}]
              [:table_name      {:display_name "Table",              :base_type :type/Text    :remapped_from :table_id}]
              [:last_run_at     {:display_name "Last run at",        :base_type :type/DateTime}]
              [:total_runs      {:display_name "Total runs",         :base_type :type/Integer}]
              ;; Denormalize by string_agg in order to avoid having to deal with complicated left join
              [:dash_name_str   {:display_name "Dashboards it's in", :base_type :type/Text}]
              [:user_id         {:display_name "Created By ID",      :base_type :type/Integer :remapped_to   :user_name}]
              [:user_name       {:display_name "Created By",         :base_type :type/Text    :remapped_from :user_id}]
              [:updated_at      {:display_name "Updated At",         :base_type :type/DateTime}]]
   :results (common/reducible-query
              {:with      [cards/query-runs
                           cards/latest-qe
                           cards/dashboards-ids]
               :select    [[:card.id :card_id]
                           [:card.name :card_name]
                           [:latest_qe.error :error_str]
                           :collection_id
                           [[:coalesce :coll.name "Our Analytics"] :collection_name]
                           :card.database_id
                           [:db.name :database_name]
                           [:t.schema :schema_name]
                           :card.table_id
                           [:t.name :table_name]
                           [:latest_qe.started_at :last_run_at]
                           [:query_runs.count :total_runs]
                           [:dash_card.name_str :dash_name_str]
                           [:card.creator_id :user_id]
                           [(common/user-full-name :u) :user_name]
                           [:card.updated_at :updated_at]]
               :from      [[:report_card :card]]
               :left-join [[:collection :coll]                [:= :card.collection_id :coll.id]
                           [:metabase_database :db]           [:= :card.database_id :db.id]
                           [:metabase_table :t]               [:= :card.table_id :t.id]
                           [:core_user :u]                    [:= :card.creator_id :u.id]
                           :latest_qe                         [:= :card.id :latest_qe.card_id]
                           :query_runs                        [:= :card.id :query_runs.card_id]
                           :dash_card                         [:= :card.id :dash_card.card_id]]
               :where     [:= :card.id card-id]})})

Details about a specific query (currently just average execution time).

(mu/defmethod audit.i/internal-query ::details
  [_query-type query-hash :- ms/NonBlankString]
  {:metadata [[:query                  {:display_name "Query",                :base_type :type/Dictionary}]
              [:average_execution_time {:display_name "Avg. Exec. Time (ms)", :base_type :type/Number}]]
   :results  (common/reducible-query
               {:select [:query
                         :average_execution_time]
                :from   [:query]
                :where  [:= :query_hash (codec/base64-decode query-hash)]
                :limit  1})
   :xform (map #(update (vec %) 0 json/parse-string))})
 

Detail page for a single Card (Question).

(ns metabase-enterprise.audit-app.pages.question-detail
  (:require
   [metabase-enterprise.audit-app.interface :as audit.i]
   [metabase-enterprise.audit-app.pages.common :as common]
   [metabase-enterprise.audit-app.pages.common.card-and-dashboard-detail
    :as card-and-dash-detail]
   [metabase.models.card :refer [Card]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]))

Get views of a Card broken out by a time unit, e.g. day or day-of-week.

(mu/defmethod audit.i/internal-query ::views-by-time
  [_query-type
   card-id       :- ms/PositiveInt
   datetime-unit :- common/DateTimeUnitStr]
  (card-and-dash-detail/views-by-time "card" card-id datetime-unit))

Get cached views of a Card broken out by a time unit, e.g. day or day-of-week.

(mu/defmethod audit.i/internal-query ::cached-views-by-time
  [_query-type
   card-id       :- ms/PositiveInt
   datetime-unit :- common/DateTimeUnitStr]
  (card-and-dash-detail/cached-views-by-time card-id datetime-unit))

Get the revision history for a Card.

(mu/defmethod audit.i/internal-query ::revision-history
  [_query-type card-id :- ms/PositiveInt]
  (card-and-dash-detail/revision-history Card card-id))

Get a view log for a Card.

(mu/defmethod audit.i/internal-query ::audit-log
  [_query-type card-id :- ms/PositiveInt]
  (card-and-dash-detail/audit-log "card" card-id))

Average execution time broken out by period

(mu/defmethod audit.i/internal-query ::avg-execution-time-by-time
  [_query-type
   card-id       :- ms/PositiveInt
   datetime-unit :- common/DateTimeUnitStr]
  (card-and-dash-detail/avg-execution-time-by-time card-id datetime-unit))
 
(ns metabase-enterprise.audit-app.pages.schemas
  (:require
   [metabase-enterprise.audit-app.interface :as audit.i]
   [metabase-enterprise.audit-app.pages.common :as common]
   [metabase.models.permissions :as perms]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.malli :as mu]))

WITH counts AS ( SELECT db."name" AS dbname, t."schema" AS dbschema FROM query_execution qe LEFT JOIN report_card card ON qe.card_id = card.id LEFT JOIN metabase_database db ON card.database_id = db.id LEFT JOIN metabase_table t ON card.table_id = t.id WHERE qe.card_id IS NOT NULL AND card.database_id IS NOT NULL AND card.table_id IS NOT NULL AND db.id != audit-db-id )

SELECT (dbname || ' ' || dbschema) AS "schema", count(*) AS executions FROM counts GROUP BY dbname, dbschema ORDER BY count(*) DESC LIMIT 10

DEPRECATED Query that returns the top 10 most-queried schemas, in descending order.

(defmethod audit.i/internal-query ::most-queried
  [_]
  {:metadata [[:schema     {:display_name "Schema",     :base_type :type/Title}]
              [:executions {:display_name "Executions", :base_type :type/Integer}]]
   :results  (common/reducible-query
              {:with     [[:counts {:select    [[:db.name :db_name]
                                                [:t.schema :db_schema]]
                                    :from      [[:query_execution :qe]]
                                    :left-join [[:report_card :card]     [:= :qe.card_id :card.id]
                                                [:metabase_database :db] [:= :card.database_id :db.id]
                                                [:metabase_table :t]     [:= :card.table_id :t.id]]
                                    :where     [:and
                                                [:not= :qe.card_id nil]
                                                [:not= :card.database_id nil]
                                                [:not= :card.table_id nil]
                                                [:not= :db.id perms/audit-db-id]]}]]
               :select   [[(h2x/concat :db_name (h2x/literal " ") :db_schema) :schema]
                          [:%count.* :executions]]
               :from     [:counts]
               :group-by [:db_name :db_schema]
               :order-by [[:%count.* :desc]]
               :limit    10})})

WITH counts AS ( SELECT db."name" AS dbname, t."schema" AS dbschema, qe.running_time FROM query_execution qe LEFT JOIN report_card card ON qe.card_id = card.id LEFT JOIN metabase_database db ON card.database_id = db.id LEFT JOIN metabase_table t ON card.table_id = t.id WHERE qe.card_id IS NOT NULL AND card.database_id IS NOT NULL AND card.table_id IS NOT NULL AND db.id != audit-db-id )

SELECT (dbname || ' ' || dbschema) AS "schema", avg(runningtime) AS avgrunning_time FROM counts GROUP BY dbname, dbschema ORDER BY avgrunningtime DESC LIMIT 10

DEPRECATED Query that returns the top 10 schemas with the slowest average query execution time in descending order.

(defmethod audit.i/internal-query ::slowest-schemas
  [_]
  {:metadata [[:schema           {:display_name "Schema",                    :base_type :type/Title}]
              [:avg_running_time {:display_name "Average Running Time (ms)", :base_type :type/Decimal}]]
   :results  (common/reducible-query
              {:with     [[:counts {:select    [[:db.name :db_name]
                                                [:t.schema :db_schema]
                                                :qe.running_time]
                                    :from      [[:query_execution :qe]]
                                    :left-join [[:report_card :card]     [:= :qe.card_id :card.id]
                                                [:metabase_database :db] [:= :card.database_id :db.id]
                                                [:metabase_table :t]     [:= :card.table_id :t.id]]
                                    :where     [:and
                                                [:not= :qe.card_id nil]
                                                [:not= :card.database_id nil]
                                                [:not= :card.table_id nil]
                                                [:not= :db.id perms/audit-db-id]]}]]
               :select   [[(h2x/concat :db_name (h2x/literal " ") :db_schema) :schema]
                          [[:avg :running_time] :avg_running_time]]
               :from     [:counts]
               :group-by [:db_name :db_schema]
               :order-by [[:avg_running_time :desc]]
               :limit    10})})

WITH cards AS ( SELECT t.dbid AS databaseid, t."schema", count(*) AS saved_count FROM report_card c LEFT JOIN metabase_table t ON c.table_id = t.id WHERE c.table_id IS NOT NULL GROUP BY t.db_id, t."schema" ),

schemas AS ( SELECT db.id AS databaseid, db.name AS databasename, t."schema", COUNT(*) AS tables FROM metabase_table t LEFT JOIN metabase_database db ON t.db_id = db.id WHERE db.id != audit-db-id GROUP BY db.id, t."schema" ORDER BY db.name ASC, t."schema" ASC )

SELECT s.databasename AS "database", s."schema", s.tables, c.savedcount AS saved_queries FROM schemas LEFT JOIN cards c ON s.databaseid = c.databaseid AND s."schema" = c."schema"

DEPRECATED Query that returns a data for a table full of fascinating information about the different schemas in use in our application.

(mu/defmethod audit.i/internal-query ::table
  ([query-type]
   (audit.i/internal-query query-type nil))
  ([_query-type query-string :- [:maybe :string]]
   {:metadata [[:database_id   {:display_name "Database ID",   :base_type :type/Integer, :remapped_to   :database}]
               [:database      {:display_name "Database",      :base_type :type/Title,   :remapped_from :database_id}]
               [:schema_id     {:display_name "Schema ID",     :base_type :type/Text,    :remapped_to   :schema}]
               [:schema        {:display_name "Schema",        :base_type :type/Title,   :remapped_from :schema_id}]
               [:tables        {:display_name "Tables",        :base_type :type/Integer}]
               [:saved_queries {:display_name "Saved Queries", :base_type :type/Integer}]]
    :results  (common/reducible-query
               (->
                {:with      [[:cards {:select    [[:t.db_id :database_id]
                                                  :t.schema
                                                  [:%count.* :saved_count]]
                                      :from      [[:report_card :c]]
                                      :left-join [[:metabase_table :t] [:= :c.table_id :t.id]]
                                      :where     [:not= :c.table_id nil]
                                      :group-by  [:t.db_id :t.schema]}]
                             [:schemas {:select    [[:db.id :database_id]
                                                    [:db.name :database_name]
                                                    :t.schema
                                                    [:%count.* :tables]]
                                        :from      [[:metabase_table :t]]
                                        :left-join [[:metabase_database :db] [:= :t.db_id :db.id]]
                                        :where     [:not= :db.id perms/audit-db-id]
                                        :group-by  [:db.id :t.schema]
                                        :order-by  [[:db.id :asc] [:t.schema :asc]]}]]
                 :select    [:s.database_id
                             [:s.database_name :database]
                             [(h2x/concat :s.database_id (h2x/literal ".") :s.schema) :schema_id]
                             :s.schema
                             :s.tables
                             [:c.saved_count :saved_queries]]
                 :from      [[:schemas :s]]
                 :left-join [[:cards :c] [:and
                                          [:= :s.database_id :c.database_id]
                                          [:= :s.schema :c.schema]]]}
                (common/add-search-clause query-string :s.schema)))}))
 
(ns metabase-enterprise.audit-app.pages.table-detail
  (:require
   [metabase-enterprise.audit-app.interface :as audit.i]
   [metabase-enterprise.audit-app.pages.common :as common]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [ring.util.codec :as codec]))

View log for a specific Table.

(mu/defmethod audit.i/internal-query ::audit-log
  [_query-type table-id :- ms/PositiveInt]
  {:metadata [[:started_at {:display_name "Viewed on",  :base_type :type/DateTime}]
              [:card_id    {:display_name "Card ID",    :base_type :type/Integer, :remapped_to   :query}]
              [:query      {:display_name "Query",      :base_type :type/Text,    :remapped_from :card_id}]
              [:query_hash {:display_name "Query Hash", :base_type :type/Text}]
              [:user_id    {:display_name "User ID",    :base_type :type/Integer, :remapped_to   :user}]
              [:user       {:display_name "Queried by", :base_type :type/Text,    :remapped_from :user_id}]]
   :results (common/reducible-query
             {:select    [:qe.started_at
                          [:card.id :card_id]
                          [(common/card-name-or-ad-hoc :card) :query]
                          [:qe.hash :query_hash]
                          [:u.id :user_id]
                          [(common/user-full-name :u) :user]]
              :from      [[:query_execution :qe]]
              :where     [:= :card.table_id table-id]
              :join      [[:core_user :u] [:= :qe.executor_id :u.id]
                          [:report_card :card] [:= :qe.card_id :card.id]]
              :order-by  [[:qe.started_at :desc]]})
   :xform (map #(update (vec %) 3 codec/base64-encode))})
 
(ns metabase-enterprise.audit-app.pages.tables
  (:require
   [metabase-enterprise.audit-app.interface :as audit.i]
   [metabase-enterprise.audit-app.pages.common :as common]
   [metabase.models.permissions :as perms]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.malli :as mu]))

WITH table_executions AS ( SELECT t.id AS table_id, count(*) AS executions FROM query_execution qe JOIN reportcard card ON qe.cardid = card.id JOIN metabasetable t ON card.tableid = t.id WHERE t.db_id != audit-db-id GROUP BY t.id ORDER BY count(*) {{asc-or-desc}} LIMIT 10 )

SELECT tx.tableid, (db.name || ' ' || t.schema || ' ' t.name) AS tablename, tx.executions FROM table_executions tx JOIN metabasetable t ON tx.tableid = t.id JOIN metabasedatabase db ON t.dbid = db.id ORDER BY executions {{asc-or-desc}}

(defn- query-counts [asc-or-desc]
  {:metadata [[:table_id   {:display_name "Table ID",   :base_type :type/Integer, :remapped_to   :table_name}]
              [:table_name {:display_name "Table",      :base_type :type/Title,   :remapped_from :table_id}]
              [:executions {:display_name "Executions", :base_type :type/Integer}]]
   :results  (common/reducible-query
              {:with [[:table_executions {:select   [[:t.id :table_id]
                                                     [:%count.* :executions]]
                                          :from     [[:query_execution :qe]]
                                          :join     [[:report_card :card]     [:= :qe.card_id :card.id]
                                                     [:metabase_table :t]     [:= :card.table_id :t.id]]
                                          :group-by [:t.id]
                                          :order-by [[:%count.* asc-or-desc]]
                                          :where    [:not= :t.db_id perms/audit-db-id]
                                          :limit    10}]]
               :select [:tx.table_id
                        [(h2x/concat :db.name (h2x/literal " ") :t.schema (h2x/literal " ") :t.name) :table_name]
                        :tx.executions]
               :from [[:table_executions :tx]]
               :join [[:metabase_table :t]     [:= :tx.table_id :t.id]
                      [:metabase_database :db] [:= :t.db_id :db.id]]
               :order-by [[:executions asc-or-desc]]})})

Query that returns the top-10 most-queried Tables, in descending order.

(defmethod audit.i/internal-query ::most-queried
  [_]
  (query-counts :desc))

Query that returns the top-10 least-queried Tables (with at least one query execution), in ascending order.

(defmethod audit.i/internal-query ::least-queried
  [_]
  (query-counts :asc))

A table of Tables.

(mu/defmethod audit.i/internal-query ::table
  ([query-type]
   (audit.i/internal-query query-type nil))
  ([_query-type query-string :- [:maybe :string]]
   {:metadata [[:database_id        {:display_name "Database ID",        :base_type :type/Integer, :remapped_to   :database_name}]
               [:database_name      {:display_name "Database",           :base_type :type/Text,    :remapped_from :database_id}]
               [:schema_id          {:display_name "Schema ID",          :base_type :type/Text,   :remapped_to   :schema_name}]
               [:table_schema       {:display_name "Schema",             :base_type :type/Text,    :remapped_from :schema_id}]
               [:table_id           {:display_name "Table ID",           :base_type :type/Integer, :remapped_to   :table_name}]
               [:table_name         {:display_name "Table Name in DB",   :base_type :type/Name,    :remapped_from :table_id}]
               [:table_display_name {:display_name "Table Display Name", :base_type :type/Text}]]
    :results (common/reducible-query
              (->
               {:select   [[:db.id :database_id]
                           [:db.name :database_name]
                           [(h2x/concat :db.id (h2x/literal ".") :t.schema) :schema_id]
                           [:t.schema :table_schema]
                           [:t.id :table_id]
                           [:t.name :table_name]
                           [:t.display_name :table_display_name]]
                :from     [[:metabase_table :t]]
                :join     [[:metabase_database :db] [:= :t.db_id :db.id]]
                :order-by [[[:lower :db.name]  :asc]
                           [[:lower :t.schema] :asc]
                           [[:lower :t.name]   :asc]]
                :where    [:and
                           [:= :t.active true]
                           [:not= :t.db_id perms/audit-db-id]]}
               (common/add-search-clause query-string :db.name :t.schema :t.name :t.display_name)))}))
 
(ns metabase-enterprise.audit-app.pages.user-detail
  (:require
   [metabase-enterprise.audit-app.interface :as audit.i]
   [metabase-enterprise.audit-app.pages.common :as common]
   [metabase-enterprise.audit-app.pages.common.cards :as cards]
   [metabase-enterprise.audit-app.pages.common.dashboards :as dashboards]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [metabase.util.urls :as urls]
   [ring.util.codec :as codec]))

Query that probides a single row of information about a given User, similar to the users/table query but restricted to a single result.

(TODO - in the designs, this is pivoted; should we do that here in Clojure-land?)

(mu/defmethod audit.i/internal-query ::table
  [_query-type user-id :- ms/PositiveInt]
  {:metadata [[:name             {:display_name "Name",             :base_type :type/Name}]
              [:role             {:display_name "Role",             :base_type :type/Text}]
              [:groups           {:display_name "Groups",           :base_type :type/Text}]
              [:date_joined      {:display_name "Date Joined",      :base_type :type/DateTime}]
              [:last_active      {:display_name "Last Active",      :base_type :type/DateTime}]
              [:signup_method    {:display_name "Signup Method",    :base_type :type/Text}]
              [:questions_saved  {:display_name "Questions Saved",  :base_type :type/Integer}]
              [:dashboards_saved {:display_name "Dashboards Saved", :base_type :type/Integer}]
              [:pulses_saved     {:display_name "Pulses Saved",     :base_type :type/Integer}]]
   :results  (common/reducible-query
              {:with   [[:last_query {:select [[:%max.started_at :started_at]]
                                      :from   [:query_execution]
                                      :where  [:= :executor_id user-id]}]
                        [:groups {:select    [[(common/group-concat :pg.name ", ") :groups]]
                                  :from      [[:permissions_group_membership :pgm]]
                                  :left-join [[:permissions_group :pg] [:= :pgm.group_id :pg.id]]
                                  :where     [:= :pgm.user_id user-id]}]
                        [:questions_saved {:select [[:%count.* :count]]
                                           :from   [:report_card]
                                           :where  [:= :creator_id user-id]}]
                        [:dashboards_saved {:select [[:%count.* :count]]
                                            :from   [:report_dashboard]
                                            :where  [:= :creator_id user-id]}]
                        [:pulses_saved {:select [[:%count.* :count]]
                                        :from   [:pulse]
                                        :where  [:= :creator_id user-id]}]
                        [:users {:select [[(common/user-full-name :u) :name]
                                          [[:case
                                            [:= :u.is_superuser true]
                                            (h2x/literal "Admin")
                                            :else
                                            (h2x/literal "User")]
                                           :role]
                                          :id
                                          :date_joined
                                          [[:case
                                            [:= nil :u.sso_source]
                                            (h2x/literal "Email")
                                            :else
                                            :u.sso_source]
                                           :signup_method]
                                          :last_name]
                                 :from   [[:core_user :u]]
                                 :where  [:= :u.id user-id]}]]
               :select [:u.name
                        :u.role
                        :groups.groups
                        :u.date_joined
                        [:last_query.started_at :last_active]
                        :u.signup_method
                        [:questions_saved.count :questions_saved]
                        [:dashboards_saved.count :dashboards_saved]
                        [:pulses_saved.count :pulses_saved]]
               :from   [[:users :u]
                        :groups
                        :last_query
                        :questions_saved
                        :dashboards_saved
                        :pulses_saved]})})

Return the 10 most-viewed Dashboards for a given User, in descending order.

(mu/defmethod audit.i/internal-query ::most-viewed-dashboards
  [_query-type user-id :- ms/PositiveInt]
  {:metadata [[:dashboard_id   {:display_name "Dashboard ID", :base_type :type/Integer, :remapped_to   :dashboard_name}]
              [:dashboard_name {:display_name "Dashboard",    :base_type :type/Name,    :remapped_from :dashboard_id}]
              [:count          {:display_name "Views",        :base_type :type/Integer}]]
   :results  (common/reducible-query
              {:select    [[:d.id :dashboard_id]
                           [:d.name :dashboard_name]
                           [:%count.* :count]]
               :from      [[:view_log :vl]]
               :left-join [[:report_dashboard :d] [:= :vl.model_id :d.id]]
               :where     [:and
                           [:= :vl.user_id user-id]
                           [:= :vl.model (h2x/literal "dashboard")]]
               :group-by  [:d.id]
               :order-by  [[:%count.* :desc]]
               :limit     10})})

Return the 10 most-viewed Questions for a given User, in descending order.

(mu/defmethod audit.i/internal-query ::most-viewed-questions
  [_query-type user-id :- ms/PositiveInt]
  {:metadata [[:card_id   {:display_name "Card ID", :base_type :type/Integer, :remapped_to   :card_name}]
              [:card_name {:display_name "Query",   :base_type :type/Name,    :remapped_from :card_id}]
              [:count     {:display_name "Views",   :base_type :type/Integer}]]
   :results  (common/reducible-query
              {:select    [[:d.id :card_id]
                           [:d.name :card_name]
                           [:%count.* :count]]
               :from      [[:view_log :vl]]
               :left-join [[:report_card :d] [:= :vl.model_id :d.id]]
               :where     [:and
                           [:= :vl.user_id user-id]
                           [:= :vl.model (h2x/literal "card")]]
               :group-by  [:d.id]
               :order-by  [[:%count.* :desc]]
               :limit     10})})

Query views by a specific User.

(mu/defmethod audit.i/internal-query ::query-views
  [_query-type user-id :- ms/PositiveInt]
  {:metadata [[:viewed_on     {:display_name "Viewed On",      :base_type :type/DateTime}]
              [:card_id       {:display_name "Card ID"         :base_type :type/Integer, :remapped_to   :card_name}]
              [:card_name     {:display_name "Query",          :base_type :type/Text,    :remapped_from :card_id}]
              [:query_hash    {:display_name "Query Hash",     :base_type :type/Text}]
              [:type          {:display_name "Type",           :base_type :type/Text}]
              [:collection_id {:display_name "Collection ID",  :base_type :type/Integer, :remapped_to   :collection}]
              [:collection    {:display_name "Collection",     :base_type :type/Text,    :remapped_from :collection_id}]
              [:saved_by_id   {:display_name "Saving User ID", :base_type :type/Integer, :remapped_to   :saved_by}]
              [:saved_by      {:display_name "Saved By",       :base_type :type/Text,    :remapped_from :saved_by_id}]
              [:database_id   {:display_name "Database ID",    :base_type :type/Integer, :remapped_to   :source_db}]
              [:source_db     {:display_name "Source DB",      :base_type :type/Text,    :remapped_from :database_id}]
              [:table_id      {:display_name "Table ID"        :base_type :type/Integer, :remapped_to   :table}]
              [:table         {:display_name "Table",          :base_type :type/Text,    :remapped_from :table_id}]]
   :results (common/reducible-query
             {:select    [[:qe.started_at :viewed_on]
                          [:card.id :card_id]
                          [(common/card-name-or-ad-hoc :card) :card_name]
                          [:qe.hash :query_hash]
                          [(common/native-or-gui :qe) :type]
                          [:collection.id :collection_id]
                          [:collection.name :collection]
                          [:u.id :saved_by_id]
                          [(common/user-full-name :u) :saved_by]
                          [:db.id :database_id]
                          [:db.name :source_db]
                          [:t.id :table_id]
                          [:t.display_name :table]]
              :from      [[:query_execution :qe]]
              :join      [[:metabase_database :db] [:= :qe.database_id :db.id]]
              :left-join [[:report_card :card]     [:= :qe.card_id :card.id]
                          :collection              [:= :card.collection_id :collection.id]
                          [:core_user :u]          [:= :card.creator_id :u.id]
                          [:metabase_table :t]     [:= :card.table_id :t.id]]
              :where     [:= :qe.executor_id user-id]
              :order-by  [[:qe.started_at :desc]]})
   :xform    (map #(update (vec %) 3 codec/base64-encode))})

Dashboard views by a specific User.

(mu/defmethod audit.i/internal-query ::dashboard-views
  [_query-type user-id :- ms/PositiveInt]
  {:metadata [[:timestamp       {:display_name "Viewed on",     :base_type :type/DateTime}]
              [:dashboard_id    {:display_name "Dashboard ID",  :base_type :type/Integer, :remapped_to   :dashboard_name}]
              [:dashboard_name  {:display_name "Dashboard",     :base_type :type/Text,    :remapped_from :dashboard_id}]
              [:collection_id   {:display_name "Collection ID", :base_type :type/Integer, :remapped_to   :collection_name}]
              [:collection_name {:display_name "Collection",    :base_type :type/Text,    :remapped_from :collection_id}]]
   :results (common/reducible-query
             {:select    [:vl.timestamp
                          [:dash.id :dashboard_id]
                          [:dash.name :dashboard_name]
                          [:coll.id :collection_id]
                          [:coll.name :collection_name]]
              :from      [[:view_log :vl]]
              :where     [:and
                          [:= :vl.model (h2x/literal "dashboard")]
                          [:= :vl.user_id user-id]]
              :join      [[:report_dashboard :dash] [:= :vl.model_id :dash.id]]
              :left-join [[:collection :coll] [:= :dash.collection_id :coll.id]]
              :order-by  [[:vl.timestamp :desc]]})})

Timeseries chart that shows the number of Question or Dashboard views for a User, broken out by datetime-unit.

(mu/defmethod audit.i/internal-query ::object-views-by-time
  [_query-type
   user-id       :- ms/PositiveInt
   model         :- [:enum "card" "dashboard"]
   datetime-unit :- common/DateTimeUnitStr]
  {:metadata [[:date {:display_name "Date",   :base_type (common/datetime-unit-str->base-type datetime-unit)}]
              [:views {:display_name "Views", :base_type :type/Integer}]]
   :results (common/reducible-query
             {:select   [[(common/grouped-datetime datetime-unit :timestamp) :date]
                         [:%count.* :views]]
              :from     [:view_log]
              :where    [:and
                         [:= :user_id user-id]
                         [:= :model model]]
              :group-by [(common/grouped-datetime datetime-unit :timestamp)]
              :order-by [[(common/grouped-datetime datetime-unit :timestamp) :asc]]})})

Dashboards created by a specific User.

(mu/defmethod audit.i/internal-query ::created-dashboards
  ([query-type user-id]
   (audit.i/internal-query query-type user-id nil))
  ([_query-type user-id :- ms/PositiveInt query-string :- [:maybe :string]]
   (dashboards/table query-string [:= :u.id user-id])))

Questions created by a specific User.

(mu/defmethod audit.i/internal-query ::created-questions
  [_query-type user-id :- ms/PositiveInt]
  {:metadata [[:card_id             {:display_name "Card ID",              :base_type :type/Integer, :remapped_to   :card_name}]
              [:card_name           {:display_name "Title",                :base_type :type/Name,    :remapped_from :card_id}]
              [:collection_id       {:display_name "Collection ID",        :base_type :type/Integer, :remapped_to   :collection_name}]
              [:collection_name     {:display_name "Collection",           :base_type :type/Text,    :remapped_from :collection_id}]
              [:created_at          {:display_name "Created At",           :base_type :type/DateTime}]
              [:database_id         {:display_name "Database ID",          :base_type :type/Integer, :remapped_to   :database_name}]
              [:database_name       {:display_name "Database",             :base_type :type/Text,    :remapped_from :database_id}]
              [:table_id            {:display_name "Table ID",             :base_type :type/Integer, :remapped_to   :table_name}]
              [:table_name          {:display_name "Table",                :base_type :type/Text,    :remapped_from :table_id}]
              [:avg_running_time_ms {:display_name "Avg. exec. time (ms)", :base_type :type/Number}]
              [:cache_ttl           {:display_name "Cache Duration",       :base_type :type/Number}]
              [:public_link         {:display_name "Public Link",          :base_type :type/URL}]
              [:total_views         {:display_name "Total Views",          :base_type :type/Integer}]]
   :results  (common/reducible-query
              {:with      [cards/avg-exec-time
                           cards/views]
               :select    [[:card.id :card_id]
                           [:card.name :card_name]
                           [:coll.id :collection_id]
                           [:coll.name :collection_name]
                           :card.created_at
                           :card.database_id
                           [:db.name :database_name]
                           :card.table_id
                           [:t.name :table_name]
                           :avg_exec_time.avg_running_time_ms
                           :card.cache_ttl
                           [[:case
                             [:not= :card.public_uuid nil]
                             (h2x/concat (urls/public-card-prefix) :card.public_uuid)]
                            :public_link]
                           [:card_views.count :total_views]]
               :from      [[:report_card :card]]
               :left-join [:avg_exec_time           [:= :card.id :avg_exec_time.card_id]
                           [:metabase_database :db] [:= :card.database_id :db.id]
                           [:metabase_table :t]     [:= :card.table_id :t.id]
                           [:collection :coll]      [:= :card.collection_id :coll.id]
                           :card_views              [:= :card.id :card_views.card_id]]
               :where     [:= :card.creator_id user-id]
               :order-by  [[[:lower :card.name] :asc]]})})

Table of query downloads (i.e., queries whose results are returned as CSV/JSON/XLS) done by this user, ordered by most recent.

(mu/defmethod audit.i/internal-query ::downloads
  [_query-type user-id :- ms/PositiveInt]
  {:metadata [[:downloaded_at   {:display_name "Downloaded At",   :base_type :type/DateTime}]
              [:rows_downloaded {:display_name "Rows Downloaded", :base_type :type/Integer}]
              [:card_id         {:display_name "Card ID",         :base_type :type/Integer, :remapped_to :card_name}]
              [:card_name       {:display_name "Query",           :base_type :type/Text,    :remapped_from :card_id}]
              [:query_type      {:display_name "Query Type",      :base_type :type/Text}]
              [:database_id     {:display_name "Database ID",     :base_type :type/Integer, :remapped_to :database}]
              [:database        {:display_name "Database",        :base_type :type/Text,    :remapped_from :database_id}]
              [:table_id        {:display_name "Table ID",        :base_type :type/Integer, :remapped_to :source_table}]
              [:source_table    {:display_name "Source Table",    :base_type :type/Text,    :remapped_from :table_id}]]
   :results  (common/reducible-query
              {:select    [[:qe.started_at :downloaded_at]
                           [:qe.result_rows :rows_downloaded]
                           [:card.id :card_id]
                           [(common/card-name-or-ad-hoc :card) :card_name]
                           [(common/native-or-gui :qe) :query_type]
                           [:db.id :database_id]
                           [:db.name :database]
                           [:t.id :table_id]
                           [:t.name :source_table]]
               :from      [[:query_execution :qe]]
               :left-join [[:report_card :card] [:= :card.id :qe.card_id]
                           [:metabase_database :db] [:= :qe.database_id :db.id]
                           [:metabase_table :t] [:= :card.table_id :t.id]]
               :where     [:and
                           [:= :executor_id user-id]
                           (common/query-execution-is-download :qe)]
               :order-by  [[:qe.started_at :desc]]})})
 
(ns metabase-enterprise.audit-app.pages.users
  (:require
   [metabase-enterprise.audit-app.interface :as audit.i]
   [metabase-enterprise.audit-app.pages.common :as common]
   [metabase.util.honey-sql-2 :as h2x]
   [metabase.util.malli :as mu]
   [ring.util.codec :as codec]))

DEPRECATED Query that returns data for a two-series timeseries: the number of DAU (a User is considered active for purposes of this query if they ran at least one query that day), and total number of queries ran. Broken out by day.

(defmethod audit.i/internal-query ::active-users-and-queries-by-day
  [_]
  {:metadata [[:users   {:display_name "Users",   :base_type :type/Integer}]
              [:queries {:display_name "Queries", :base_type :type/Integer}]
              [:day     {:display_name "Date",    :base_type :type/Date}]]
   :results  (common/reducible-query
              {:with     [[:user_qe {:select   [:executor_id
                                                [:%count.* :executions]
                                                [(h2x/cast :date :started_at) :day]]
                                     :from     [:query_execution]
                                     :group-by [:executor_id :day]}]]
               :select   [[:%count.* :users]
                          [:%sum.executions :queries]
                          :day]
               :from     [:user_qe]
               :group-by [:day]
               :order-by [[:day :asc]]})})

Two-series timeseries that returns number of active Users (Users who ran at least one query) and number of new Users, broken out by datetime-unit.

(mu/defmethod audit.i/internal-query ::active-and-new-by-time
  [_query-type datetime-unit :- common/DateTimeUnitStr]
  {:metadata [[:date         {:display_name "Date",         :base_type (common/datetime-unit-str->base-type datetime-unit)}]
              [:active_users {:display_name "Active Users", :base_type :type/Integer}]
              [:new_users    {:display_name "New Users",    :base_type :type/Integer}]]
   ;; this is so nice and easy to implement in a single query with FULL OUTER JOINS but unfortunately only pg supports
   ;; them(!)
   :results  (let [active       (common/query
                                 {:select   [[(common/grouped-datetime datetime-unit :started_at) :date]
                                             [[::h2x/distinct-count :executor_id] :count]]
                                  :from     [:query_execution]
                                  :group-by [(common/grouped-datetime datetime-unit :started_at)]})
                   date->active (zipmap (map :date active) (map :count active))
                   new          (common/query
                                 {:select   [[(common/grouped-datetime datetime-unit :date_joined) :date]
                                             [:%count.* :count]]
                                  :from     [:core_user]
                                  :group-by [(common/grouped-datetime datetime-unit :date_joined)]})
                   date->new    (zipmap (map :date new) (map :count new))
                   all-dates    (sort (keep identity (distinct (concat (keys date->active)
                                                                       (keys date->new)))))]
               (for [date all-dates]
                 {:date         date
                  :active_users (date->active date 0)
                  :new_users    (date->new   date 0)}))})

Query that returns the 10 most active Users (by number of query executions) in descending order.

(defmethod audit.i/internal-query ::most-active
  [_]
  {:metadata [[:user_id {:display_name "User ID",          :base_type :type/Integer, :remapped_to   :name}]
              [:name    {:display_name "Member",           :base_type :type/Name,    :remapped_from :user_id}]
              [:count   {:display_name "Query Executions", :base_type :type/Integer}]]
   :results  (common/reducible-query
              {:with      [[:qe_count {:select   [[:%count.* :count]
                                                  :qe.executor_id]
                                       :from     [[:query_execution :qe]]
                                       :where    [:not= nil :qe.executor_id]
                                       :group-by [:qe.executor_id]
                                       :order-by [[:%count.* :desc]]
                                       :limit    10}]]
               :select    [[:u.id :user_id]
                           [(common/user-full-name :u) :name]
                           [(common/zero-if-null :qe_count.count) :count]]
               :from      [[:core_user :u]]
               :left-join [:qe_count [:= :qe_count.executor_id :u.id]]
               :order-by  [[:count :desc]
                           [[:lower :u.last_name] :asc]
                           [[:lower :u.first_name] :asc]
                           [[:lower :u.email] :asc]]
               :limit     10})})

Query that returns the 10 Users with the most saved objects in descending order.

(defmethod audit.i/internal-query ::most-saves
  [_]
  {:metadata [[:user_id   {:display_name "User ID",       :base_type :type/Integer, :remapped_to :user_name}]
              [:user_name {:display_name "Member",        :base_type :type/Name,    :remapped_from :user_id}]
              [:saves     {:display_name "Saved Objects", :base_type :type/Integer}]]
   :results  (common/reducible-query
              {:with      [[:card_saves       {:select   [:creator_id
                                                          [:%count.* :count]]
                                               :from     [:report_card]
                                               :group-by [:creator_id]}]
                           [:dashboard_saves {:select   [:creator_id
                                                         [:%count.* :count]]
                                              :from     [:report_dashboard]
                                              :group-by [:creator_id]}]
                           [:pulse_saves     {:select   [:creator_id
                                                         [:%count.* :count]]
                                              :from     [:pulse]
                                              :group-by [:creator_id]}]]
               :select    [[:u.id :user_id]
                           [(common/user-full-name :u) :user_name]
                           [(h2x/+ (common/zero-if-null :card_saves.count)
                                  (common/zero-if-null :dashboard_saves.count)
                                  (common/zero-if-null :pulse_saves.count))
                            :saves]]
               :from      [[:core_user :u]]
               :left-join [:card_saves      [:= :u.id :card_saves.creator_id]
                           :dashboard_saves [:= :u.id :dashboard_saves.creator_id]
                           :pulse_saves     [:= :u.id :pulse_saves.creator_id]]
               :order-by  [[:saves :desc]
                           [:u.last_name :asc]
                           [:u.first_name :asc]
                           [:u.email :asc]]
               :limit     10})})

Query that returns the total time spent executing queries, broken out by User, for the top 10 Users.

(defmethod audit.i/internal-query ::query-execution-time-per-user
  [_]
  {:metadata [[:user_id           {:display_name "User ID",                   :base_type :type/Integer, :remapped_to   :name}]
              [:name              {:display_name "Member",                    :base_type :type/Name,    :remapped_from :user_id}]
              [:execution_time_ms {:display_name "Total Execution Time (ms)", :base_type :type/Decimal}]]
   :results  (common/reducible-query
              {:with      [[:exec_time {:select   [[:%sum.running_time :execution_time_ms]
                                                   :qe.executor_id]
                                        :from     [[:query_execution :qe]]
                                        :where    [:not= nil :qe.executor_id]
                                        :group-by [:qe.executor_id]
                                        :order-by [[:%sum.running_time :desc]]
                                        :limit    10}]]
               :select    [[:u.id :user_id]
                           [(common/user-full-name :u) :name]
                           [[:case [:not= :exec_time.execution_time_ms nil] :exec_time.execution_time_ms
                             :else 0]
                            :execution_time_ms]]
               :from      [[:core_user :u]]
               :left-join [:exec_time [:= :exec_time.executor_id :u.id]]
               :order-by  [[:execution_time_ms :desc]
                           [[:lower :u.last_name] :asc]
                           [[:lower :u.first_name] :asc]
                           [[:lower :u.email] :asc]]
               :limit     10})})

A table of all the Users for this instance, and various statistics about them (see metadata below).

(mu/defmethod audit.i/internal-query ::table
  ([query-type]
   (audit.i/internal-query query-type nil))
  ([_query-type query-string :- [:maybe :string]]
   {:metadata [[:user_id          {:display_name "User ID",          :base_type :type/Integer, :remapped_to :name}]
               [:name             {:display_name "Member",           :base_type :type/Name,    :remapped_from :user_id}]
               [:role             {:display_name "Role",             :base_type :type/Text}]
               [:groups           {:display_name "Groups",           :base_type :type/Text}]
               [:date_joined      {:display_name "Date Joined",      :base_type :type/DateTime}]
               [:last_active      {:display_name "Last Active",      :base_type :type/DateTime}]
               [:signup_method    {:display_name "Signup Method",    :base_type :type/Text}]
               [:questions_saved  {:display_name "Questions Saved",  :base_type :type/Integer}]
               [:dashboards_saved {:display_name "Dashboards Saved", :base_type :type/Integer}]
               [:pulses_saved     {:display_name "Pulses Saved",     :base_type :type/Integer}]]
    :results  (common/reducible-query
               (->
                {:with      [[:last_query {:select   [[:executor_id :id]
                                                      [:%max.started_at :started_at]]
                                           :from     [:query_execution]
                                           :group-by [:executor_id]}]
                             [:groups {:select    [[:u.id :id]
                                                   [(common/group-concat :pg.name ", ") :groups]]
                                       :from      [[:core_user :u]]
                                       :left-join [[:permissions_group_membership :pgm] [:= :u.id :pgm.user_id]
                                                   [:permissions_group :pg]             [:= :pgm.group_id :pg.id]]
                                       :group-by  [:u.id]}]
                             [:questions_saved {:select    [[:u.id :id]
                                                            [:%count.* :count]]
                                                :from      [[:report_card :c]]
                                                :left-join [[:core_user :u] [:= :u.id :c.creator_id]]
                                                :group-by  [:u.id]}]
                             [:dashboards_saved {:select    [[:u.id :id]
                                                             [:%count.* :count]]
                                                 :from      [[:report_dashboard :d]]
                                                 :left-join [[:core_user :u] [:= :u.id :d.creator_id]]
                                                 :group-by  [:u.id]}]
                             [:pulses_saved {:select    [[:u.id :id]
                                                         [:%count.* :count]]
                                             :from      [[:pulse :p]]
                                             :left-join [[:core_user :u] [:= :u.id :p.creator_id]]
                                             :group-by  [:u.id]}]
                             [:users {:select [[(common/user-full-name :u) :name]
                                               [[:case
                                                 [:= :u.is_superuser true]
                                                 (h2x/literal "Admin")
                                                 :else
                                                 (h2x/literal "User")]
                                                :role]
                                               :id
                                               :date_joined
                                               [[:case
                                                 [:= "google" :u.sso_source]
                                                 (h2x/literal "Google Sign-In")
                                                 [:= "saml" :u.sso_source]
                                                 (h2x/literal "SAML")
                                                 [:= "jwt" :u.sso_source]
                                                 (h2x/literal "JWT")
                                                 [:= "ldap" :u.sso_source]
                                                 (h2x/literal "LDAP")
                                                 [:= nil :u.sso_source]
                                                 (h2x/literal "Email")
                                                 :else
                                                 :u.sso_source]
                                                :signup_method]
                                               :last_name
                                               :first_name]
                                      :from   [[:core_user :u]]}]]
                 :select    [[:u.id :user_id]
                             :u.name
                             :u.role
                             :groups.groups
                             :u.date_joined
                             [:last_query.started_at :last_active]
                             :u.signup_method
                             [:questions_saved.count :questions_saved]
                             [:dashboards_saved.count :dashboards_saved]
                             [:pulses_saved.count :pulses_saved]]
                 :from      [[:users :u]]
                 :left-join [:groups           [:= :u.id :groups.id]
                             :last_query       [:= :u.id :last_query.id]
                             :questions_saved  [:= :u.id :questions_saved.id]
                             :dashboards_saved [:= :u.id :dashboards_saved.id]
                             :pulses_saved     [:= :u.id :pulses_saved.id]]
                 :order-by  [[[:lower :u.last_name] :asc]
                             [[:lower :u.first_name] :asc]]}
                (common/add-search-clause query-string :u.first_name :u.last_name)))}))

Return a log of all query executions, including information about the Card associated with the query and the Collection it is in (both, if applicable) and Database/Table referenced by the query.

(defmethod audit.i/internal-query ::query-views
  [_]
  {:metadata [[:viewed_on     {:display_name "Viewed On",       :base_type :type/DateTime}]
              [:card_id       {:display_name "Card ID"          :base_type :type/Integer, :remapped_to   :card_name}]
              [:card_name     {:display_name "Query",           :base_type :type/Text,    :remapped_from :card_id}]
              [:query_hash    {:display_name "Query Hash",      :base_type :type/Text}]
              [:type          {:display_name "Type",            :base_type :type/Text}]
              [:collection_id {:display_name "Collection ID",   :base_type :type/Integer, :remapped_to   :collection}]
              [:collection    {:display_name "Collection",      :base_type :type/Text,    :remapped_from :collection_id}]
              [:viewed_by_id  {:display_name "Viewing User ID", :base_type :type/Integer, :remapped_to   :viewed_by}]
              [:viewed_by     {:display_name "Viewed By",       :base_type :type/Text,    :remapped_from :viewed_by_id}]
              [:saved_by_id   {:display_name "Saving User ID",  :base_type :type/Integer, :remapped_to   :saved_by}]
              [:saved_by      {:display_name "Saved By",        :base_type :type/Text,    :remapped_from :saved_by_id}]
              [:database_id   {:display_name "Database ID",     :base_type :type/Integer, :remapped_to   :source_db}]
              [:source_db     {:display_name "Source DB",       :base_type :type/Text,    :remapped_from :database_id}]
              [:table_id      {:display_name "Table ID"         :base_type :type/Integer, :remapped_to   :table}]
              [:table         {:display_name "Table",           :base_type :type/Text,    :remapped_from :table_id}]]
   :results (common/reducible-query
             {:select    [[:qe.started_at :viewed_on]
                          [:card.id :card_id]
                          [(common/card-name-or-ad-hoc :card) :card_name]
                          [:qe.hash :query_hash]
                          [(common/native-or-gui :qe) :type]
                          [:collection.id :collection_id]
                          [:collection.name :collection]
                          [:viewer.id :viewed_by_id]
                          [(common/user-full-name :viewer) :viewed_by]
                          [:creator.id :saved_by_id]
                          [(common/user-full-name :creator) :saved_by]
                          [:db.id :database_id]
                          [:db.name :source_db]
                          [:t.id :table_id]
                          [:t.display_name :table]]
              :from      [[:query_execution :qe]]
              :join      [[:metabase_database :db] [:= :qe.database_id :db.id]
                          [:core_user :viewer]     [:= :qe.executor_id :viewer.id]]
              :left-join [[:report_card :card]     [:= :qe.card_id :card.id]
                          :collection              [:= :card.collection_id :collection.id]
                          [:core_user :creator]    [:= :card.creator_id :creator.id]
                          [:metabase_table :t]     [:= :card.table_id :t.id]]
              :order-by  [[:qe.started_at :desc]]})
   :xform (map #(update (vec %) 3 codec/base64-encode))})

Return a log of when all Dashboard views, including the Collection the Dashboard belongs to.

(defmethod audit.i/internal-query ::dashboard-views
  [_]
  {:metadata [[:timestamp       {:display_name "Viewed on",     :base_type :type/DateTime}]
              [:dashboard_id    {:display_name "Dashboard ID",  :base_type :type/Integer, :remapped_to   :dashboard_name}]
              [:dashboard_name  {:display_name "Dashboard",     :base_type :type/Text,    :remapped_from :dashboard_id}]
              [:collection_id   {:display_name "Collection ID", :base_type :type/Integer, :remapped_to   :collection_name}]
              [:collection_name {:display_name "Collection",    :base_type :type/Text,    :remapped_from :collection_id}]
              [:user_id         {:display_name "User ID",      :base_type :type/Integer,  :remapped_to   :user_name}]
              [:user_name       {:display_name "Viewed By",    :base_type :type/Text,     :remapped_from :user_id}]]
   :results (common/reducible-query
             {:select    [:vl.timestamp
                          [:dash.id :dashboard_id]
                          [:dash.name :dashboard_name]
                          [:coll.id :collection_id]
                          [:coll.name :collection_name]
                          [:u.id :user_id]
                          [(common/user-full-name :u) :user_name]]
              :from      [[:view_log :vl]]
              :where     [:= :vl.model (h2x/literal "dashboard")]
              :join      [[:report_dashboard :dash] [:= :vl.model_id :dash.id]
                          [:core_user :u]           [:= :vl.user_id :u.id]]
              :left-join [[:collection :coll] [:= :dash.collection_id :coll.id]]
              :order-by  [[:vl.timestamp :desc]]})})
 
(ns metabase-enterprise.audit-app.permissions
  (:require
   [metabase-enterprise.audit-db :refer [default-audit-collection]]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.models.interface :as mi]
   [metabase.models.permissions :as perms]
   [metabase.models.query.permissions :as query-perms]
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.query-processor.store :as qp.store]
   [metabase.shared.util.i18n :refer [tru]]
   [metabase.util :as u]
   [toucan2.core :as t2]))

Used for giving granular permissions into the audit db. Instead of granting permissions to all of the audit db, we query the audit db using the names of each view that starts with v_.

(def audit-db-view-names
  #{"v_audit_log"
    "v_content"
    "v_dashboardcard"
    "v_group_members"
    "v_subscriptions"
    "v_users"
    "v_alerts"
    "v_databases"
    "v_fields"
    "v_query_log"
    "v_tables"
    "v_tasks"
    "v_view_log"})

Performs a number of permission checks to ensure that a query on the Audit database can be run. Causes for rejection are: - if the current user does not have access to the analytics collection - native queries - queries that include tables that are not audit views

(defenterprise check-audit-db-permissions
  :feature :audit-app
  [{query-type :type, database-id :database, query :query :as outer-query}]
  ;; Check if the user has access to the analytics collection, since this should be coupled with access to the
  ;; audit database in general.
  (when-not (mi/can-read? (default-audit-collection))
    (throw (ex-info (tru "You do not have access to the audit database") outer-query)))
  ;; query->source-table-ids returns a set of table IDs and/or the ::query-perms/native keyword
  (when (= query-type :native)
    (throw (ex-info (tru "Native queries are not allowed on the audit database")
                    outer-query)))
  (let [table-ids-or-native-kw (query-perms/query->source-table-ids query)]
    (qp.store/with-metadata-provider database-id
      (doseq [table-id table-ids-or-native-kw]
        (when (= table-id ::query-perms/native)
          (throw (ex-info (tru "Native queries are not allowed on the audit database")
                          outer-query)))
        (when-not (audit-db-view-names
                   (u/lower-case-en (:name (lib.metadata/table (qp.store/metadata-provider) table-id))))
          (throw (ex-info (tru "Audit queries are only allowed on audit views")
                          outer-query)))))))

Will remove or grant audit db (AppDB) permissions, if the instance analytics collection permissions changes. This technically isn't necessary, because we block all audit DB queries if a user doesn't have collection permissions. But it's cleaner to keep the audit DB permission paths in the database consistent.

(defenterprise update-audit-collection-permissions!
  :feature :audit-app
  [group-id changes]
  (let [[change-id type] (first (filter #(= (first %) (:id (default-audit-collection))) changes))]
      (when change-id
        (let [change-permissions! (case type
                                    :read  perms/grant-permissions!
                                    :none  perms/delete-related-permissions!
                                    :write (throw (ex-info (tru (str "Unable to make audit collections writable."))
                                                           {:status-code 400})))
              view-tables         (t2/select :model/Table :db_id perms/audit-db-id :name [:in audit-db-view-names])]
          (doseq [table view-tables]
            (change-permissions! group-id (perms/table-query-path table)))))))
 

Middleware that handles special internal type queries. internal queries are implemented directly by various implementations of the [[metabase-enterprise.audit-app.interface/internal-query]] multimethod, and do not necessarily need to query a database to provide results; by default, they completely skip the rest of the normal QP pipeline. internal queries as passed to the Query Processor should look like the following:

{:type :internal :fn "metabase-enterprise.audit-app.pages.dashboards/table" :args []} ; optional vector of args to pass to the fn above

To run an internal query, you must have superuser permissions. This middleware will automatically resolve the function as appropriate, loading its namespace if needed.

(defmethod audit.i/internal-query ::table [_] {:metadata ..., :results ...})

The function should return a map with two keys, :metadata and :results, in either the 'legacy' or 'reducible' format:

LEGACY FORMAT:

  • :metadata is a series of [col-name metadata-map] pairs. See [[metabase-enterprise.audit-app.interface/ResultsMetadata]]
  • :results is a series of maps.

    {:metadata [[:title {:displayname "Title", :basetype :type/Text}] [:count {:displayname "Count", :basetype :type/Integer}]] :results [{:title "Birds", :count 2} {:title "Cans", :count 2}]}

REDUCIBLE FORMAT:

  • :metadata is the same as the legacy format.
  • :results is a function that takes context and returns something that can be reduced.
  • :xform is an optional xform to apply to each result row while reducing the query

    {:metadata ... :results (fn [context] ...) :xform ...}

(ns metabase-enterprise.audit-app.query-processor.middleware.handle-audit-queries
  (:require
   [clojure.data :as data]
   [metabase-enterprise.audit-app.interface :as audit.i]
   [metabase.api.common.validation :as validation]
   [metabase.public-settings.premium-features
    :as premium-features
    :refer [defenterprise]]
   [metabase.query-processor.context :as qp.context]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu]))

Primarily for dev and debugging purposes. We can probably take this out when shipping the finished product.

(defn- check-results-and-metadata-keys-match
  [results metadata]
  (let [results-keys  (set (keys (first results)))
        metadata-keys (set (map (comp keyword first) metadata))]
    (when (and (seq results-keys)
               (not= results-keys metadata-keys))
      (let [[only-in-results only-in-metadata] (data/diff results-keys metadata-keys)]
        (throw
         (Exception.
          (str "results-keys and metadata-keys differ.\n"
               "results-keys: " results-keys "\n"
               "metadata-keys: " metadata-keys "\n"
               "in results, but not metadata: " only-in-results "\n"
               "in metadata, but not results: " only-in-metadata)))))))
(defn- metadata->cols [metadata]
  (for [[k v] metadata]
    (assoc v :name (name k))))
(mu/defn ^:private format-results [{:keys [results metadata]} :- [:map
                                                                  [:results  [:sequential :map]]
                                                                  [:metadata audit.i/ResultsMetadata]]]
  (check-results-and-metadata-keys-match results metadata)
  {:cols (metadata->cols metadata)
   :rows (for [row results]
           (for [[k] metadata]
             (get row (keyword k))))})

Schema for a valid internal type query.

(def InternalQuery
  [:map
   [:type [:enum :internal "internal"]]
   [:fn   [:and
           :string
           [:fn
            {:error/message "namespace-qualified symbol serialized as a string"}
            (fn [s]
              (try
                (when-let [symb (symbol s)]
                  (qualified-symbol? symb))
                (catch Throwable _)))]]]
   [:args {:optional true} [:sequential :any]]])

Additional internal query params beyond type, fn, and args. These are bound to this dynamic var which is a chance to do something clever outside of the normal function args. For example audit app uses limit and offset to implement paging for all audit app queries automatically.

(def ^:dynamic *additional-query-params*
  nil)
(defn- reduce-reducible-results [rff context {:keys [metadata results xform], :or {xform identity}}]
  (let [cols           (metadata->cols metadata)
        reducible-rows (results context)
        rff*           (fn [metadata]
                         (xform (rff metadata)))]
    (assert (some? cols))
    (assert (instance? clojure.lang.IReduceInit reducible-rows))
    (qp.context/reducef rff* context {:cols cols} reducible-rows)))
(defn- reduce-legacy-results [rff context results]
  (let [{:keys [cols rows]} (format-results results)]
    (assert (some? cols))
    (assert (some? rows))
    (qp.context/reducef rff context {:cols cols} rows)))
(defn- reduce-results [rff context {rows :results, :as results}]
  ((if (fn? rows)
     reduce-reducible-results
     reduce-legacy-results) rff context results))
(mu/defn ^:private process-internal-query
  [{qualified-fn-str :fn, args :args, :as query} :- InternalQuery rff context]
  ;; Make sure current user is a superuser or has monitoring permissions
  (validation/check-has-application-permission :monitoring)
  ;; Make sure audit app is enabled (currently the only use case for internal queries). We can figure out a way to
  ;; allow non-audit-app queries if and when we add some
  (when-not (premium-features/enable-audit-app?)
    (throw (ex-info (tru "Audit App queries are not enabled on this instance.")
                    {:type qp.error-type/invalid-query})))
  (binding [*additional-query-params* (dissoc query :fn :args)]
    (let [resolved (apply audit.i/resolve-internal-query qualified-fn-str args)]
      (reduce-results rff context resolved))))

Middleware that handles :internal (Audit App) type queries.

(defenterprise handle-audit-app-internal-queries
  :feature :audit-app
  [qp]
  (fn [{query-type :type, :as query} rff context]
    (if (= :internal (keyword query-type))
      (process-internal-query query rff context)
      (qp query rff context))))
 
(ns metabase-enterprise.audit-db
  (:require
   [babashka.fs :as fs]
   [clojure.java.io :as io]
   [clojure.string :as str]
   [metabase-enterprise.internal-user :as ee.internal-user]
   [metabase-enterprise.serialization.cmd :as serialization.cmd]
   [metabase.db.connection :as mdb.connection]
   [metabase.db.env :as mdb.env]
   [metabase.models.database :refer [Database]]
   [metabase.models.permissions :as perms]
   [metabase.models.setting :refer [defsetting]]
   [metabase.plugins :as plugins]
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.sync.util :as sync-util]
   [metabase.util :as u]
   [metabase.util.files :as u.files]
   [metabase.util.log :as log]
   [toucan2.core :as t2])
  (:import
   (java.util.jar JarEntry JarFile)))
(set! *warn-on-reflection* true)

Returns true iff we are running from a jar.

.getResource will return a java.net.URL, and those start with "jar:" if and only if the app is running from a jar.

More info: https://docs.oracle.com/en/java/javase/11/docs/api/java.base/java/lang/Thread.html

(defn- running-from-jar?
  []
  (-> (Thread/currentThread)
      (.getContextClassLoader)
      (.getResource "")
      (str/starts-with? "jar:")))

Returns the path to the currently running jar file.

More info: https://stackoverflow.com/questions/320542/how-to-get-the-path-of-a-running-jar-file

(defn- get-jar-path
  []
  (assert (running-from-jar?) "Can only get-jar-path when running from a jar.")
  (-> (class {})
      (.getProtectionDomain)
      (.getCodeSource)
      (.getLocation)
      (.toURI) ;; avoid problems with special characters in path.
      (.getPath)))

Recursively copies a subdirectory (at resource-path) from the jar at jar-path into out-dir.

Scans every file in resources, to see which ones are inside of resource-path, since there's no way to "ls" or list a directory inside of a jar's resources.

(defn copy-from-jar!
  [jar-path resource-path out-dir]
  (let [jar-file (JarFile. (str jar-path))
        entries (.entries jar-file)]
     (doseq [^JarEntry entry (iterator-seq entries)
             :let [entry-name (.getName entry)]
             :when (str/starts-with? entry-name resource-path)
             :let [out-file (fs/path out-dir entry-name)]]
       (if (.isDirectory entry)
         (fs/create-dirs out-file)
         (do
           (-> out-file fs/parent fs/create-dirs)
           (with-open [in (.getInputStream jar-file entry)
                       out (io/output-stream (str out-file))]
             (io/copy in out)))))))

Default audit collection entity (instance analytics) id.

(def ^:private default-audit-collection-entity-id
  "vG58R8k-QddHWA7_47umn")

Default custom reports entity id.

(def ^:private default-custom-reports-entity-id
  "okNLSZKdSxaoG58JSQY54")

Returns the collection from entity id for collections. Memoizes from entity id.

(defn collection-entity-id->collection
  [entity-id]
  ((mdb.connection/memoize-for-application-db
    (fn [entity-id]
      (t2/select-one :model/Collection :entity_id entity-id))) entity-id))

Default custom reports collection.

(defenterprise default-custom-reports-collection
  :feature :none
  []
  (collection-entity-id->collection default-custom-reports-entity-id))

Default audit collection (instance analytics) collection.

(defenterprise default-audit-collection
  :feature :none
  []
  (collection-entity-id->collection default-audit-collection-entity-id))

Creates the audit db, a clone of the app db used for auditing purposes.

  • This uses a weird ID because some tests were hardcoded to look for database with ID = 2, and inserting an extra db throws that off since these IDs are sequential.
(defn- install-database!
  [engine id]
  (t2/insert! Database {:is_audit         true
                        :id               id
                        :name             "Internal Metabase Database"
                        :description      "Internal Audit DB used to power metabase analytics."
                        :engine           engine
                        :is_full_sync     true
                        :is_on_demand     false
                        :creator_id       nil
                        :auto_run_queries true})
  ;; guard against someone manually deleting the audit-db entry, but not removing the audit-db permissions.
  (t2/delete! :model/Permissions {:where [:like :object (str "%/db/" id "/%")]}))
(defn- adjust-audit-db-to-source!
  [{audit-db-id :id}]
  ;; We need to move back to a schema that matches the serialized data
  (when (contains? #{:mysql :h2} mdb.env/db-type)
    (t2/update! :model/Database audit-db-id {:engine "postgres"})
    (when (= :mysql mdb.env/db-type)
      (t2/update! :model/Table {:db_id audit-db-id} {:schema "public"}))
    (when (= :h2 mdb.env/db-type)
      (t2/update! :model/Table {:db_id audit-db-id} {:schema [:lower :schema] :name [:lower :name]})
      (t2/update! :model/Field
                  {:table_id
                   [:in
                    {:select [:id]
                     :from [(t2/table-name :model/Table)]
                     :where [:= :db_id audit-db-id]}]}
                  {:name [:lower :name]}))
    (log/infof "Adjusted Audit DB for loading Analytics Content")))
(defn- adjust-audit-db-to-host!
  [{audit-db-id :id :keys [engine]}]
  (when (not= engine mdb.env/db-type)
    ;; We need to move the loaded data back to the host db
    (t2/update! :model/Database audit-db-id {:engine (name mdb.env/db-type)})
    (when (= :mysql mdb.env/db-type)
      (t2/update! :model/Table {:db_id audit-db-id} {:schema nil}))
    (when (= :h2 mdb.env/db-type)
      (t2/update! :model/Table {:db_id audit-db-id} {:schema [:upper :schema] :name [:upper :name]})
      (t2/update! :model/Field
                  {:table_id
                   [:in
                    {:select [:id]
                     :from [(t2/table-name :model/Table)]
                     :where [:= :db_id audit-db-id]}]}
                  {:name [:upper :name]}))
    (log/infof "Adjusted Audit DB to match host engine: %s" (name mdb.env/db-type))))

A resource dir containing analytics content created by Metabase to load into the app instance on startup.

(def ^:private analytics-dir-resource
  (io/resource "instance_analytics"))

The directory analytics content is unzipped or moved to, and subsequently loaded into the app from on startup.

(defn- instance-analytics-plugin-dir
  [plugins-dir]
  (fs/path (fs/absolutize plugins-dir) "instance_analytics"))

Load instance analytics content (collections/dashboards/cards/etc.) from resources dir or a zip file and copies it into the provided directory (by default, plugins/instance_analytics).

(defn- ia-content->plugins
  [plugins-dir]
  (let [ia-dir (instance-analytics-plugin-dir plugins-dir)]
    (when (fs/exists? (u.files/relative-path ia-dir))
      (fs/delete-tree (u.files/relative-path ia-dir)))
    (if (running-from-jar?)
      (let [path-to-jar (get-jar-path)]
        (log/info "The app is running from a jar, starting copy...")
        (copy-from-jar! path-to-jar "instance_analytics/" plugins-dir)
        (log/info "Copying complete."))
      (let [in-path (fs/path analytics-dir-resource)]
        (log/info "The app is not running from a jar, starting copy...")
        (log/info (str "Copying " in-path " -> " ia-dir))
        (fs/copy-tree (u.files/relative-path in-path)
                      (u.files/relative-path ia-dir)
                      {:replace-existing true})
        (log/info "Copying complete.")))))

Whether or not we should load Metabase analytics content on startup. Defaults to true, but can be disabled via environment variable.

(defsetting load-analytics-content
  :type       :boolean
  :default    true
  :visibility :internal
  :setter     :none
  :audit      :never
  :doc        false)
(defn- maybe-load-analytics-content!
  [audit-db]
  (when (and analytics-dir-resource (load-analytics-content))
    (ee.internal-user/ensure-internal-user-exists!)
    (adjust-audit-db-to-source! audit-db)
    (log/info "Loading Analytics Content...")
    (ia-content->plugins (plugins/plugins-dir))
    (log/info (str "Loading Analytics Content from: " (instance-analytics-plugin-dir (plugins/plugins-dir))))
    ;; The EE token might not have :serialization enabled, but audit features should still be able to use it.
    (let [report (log/with-no-logs
                   (serialization.cmd/v2-load-internal! (str (instance-analytics-plugin-dir (plugins/plugins-dir)))
                                                        {}
                                                        :token-check? false))]
      (if (not-empty (:errors report))
        (log/info (str "Error Loading Analytics Content: " (pr-str report)))
        (log/info (str "Loading Analytics Content Complete (" (count (:seen report)) ") entities loaded."))))
    (when-let [audit-db (t2/select-one :model/Database :is_audit true)]
      (adjust-audit-db-to-host! audit-db))))
(defn- maybe-install-audit-db
  []
  (let [audit-db (t2/select-one :model/Database :is_audit true)]
    (cond
      (nil? audit-db)
      (u/prog1 ::installed
       (log/info "Installing Audit DB...")
       (install-database! mdb.env/db-type perms/audit-db-id))
      (not= mdb.env/db-type (:engine audit-db))
      (u/prog1 ::updated
       (log/infof "App DB change detected. Changing Audit DB source to match: %s." (name mdb.env/db-type))
       (adjust-audit-db-to-host! audit-db))
      :else
      ::no-op)))

EE implementation of ensure-db-installed!. Installs audit db if it does not already exist, and loads audit content if it is available.

(defenterprise ensure-audit-db-installed!
  :feature :none
  []
  (u/prog1 (maybe-install-audit-db)
   (let [audit-db (t2/select-one :model/Database :is_audit true)]
       ;; prevent sync while loading
     ((sync-util/with-duplicate-ops-prevented :sync-database audit-db
        (fn [] (maybe-load-analytics-content! audit-db)))))))
 
(ns metabase-enterprise.content-verification.api.review
  (:require
   [compojure.core :refer [POST]]
   [metabase.api.common :as api]
   [metabase.models.moderation-review :as moderation-review]
   [metabase.moderation :as moderation]
   [metabase.util.malli.schema :as ms]))

/

(api/defendpoint POST 
  "Create a new `ModerationReview`."
  [:as {{:keys [text moderated_item_id moderated_item_type status]} :body}]
  {text                [:maybe :string]
   moderated_item_id   ms/PositiveInt
   moderated_item_type moderation/moderated-item-types
   status              [:maybe moderation-review/Statuses]}
  (api/check-superuser)
  (let [review-data {:text                text
                     :moderated_item_id   moderated_item_id
                     :moderated_item_type moderated_item_type
                     :moderator_id        api/*current-user-id*
                     :status              status}]
    (api/check-404 (moderation/moderated-item review-data))
    (moderation-review/create-review! review-data)))
(api/define-routes)
 
(ns metabase-enterprise.content-verification.api.routes
  (:require
   [compojure.core :as compojure :refer [context]]
   [metabase-enterprise.api.routes.common :as ee.api.common]
   [metabase-enterprise.content-verification.api.review :as review]
   [metabase.api.routes.common :refer [+auth]]
   [metabase.util.i18n :refer [deferred-tru]]))
(defn- +require-content-verification [handler]
  (ee.api.common/+require-premium-feature :content-verification (deferred-tru "Content verification") handler))

API routes only available if we have a premium token with the :content-verification feature.

(compojure/defroutes 
  routes
  (context "/moderation-review"  [] (+require-content-verification (+auth review/routes))))
 

Unless otherwise noted, all files © 2024 Metabase, Inc.

Source code in this repository is variously licensed under the GNU Affero General Public License (AGPL), or the Metabase Commercial License.


Empty namespace. This is here solely so we can try to require it and see whether or not EE code is on the classpath.

(ns metabase-enterprise.core)
 
(ns metabase-enterprise.dashboard-subscription-filters.pulse
  (:require
   [metabase.public-settings.premium-features :refer [defenterprise]]))

Enterprise way of getting dashboard filter parameters. Blends parameters from dashboard subscription and the dashboard itself.

(defenterprise the-parameters
  :feature :dashboard-subscription-filters
  [pulse dashboard]
  (let [pulse-params           (:parameters pulse)
        dashboard-params       (:parameters dashboard)
        pulse-params-by-id     (group-by :id pulse-params)
        dashboard-params-by-id (group-by :id dashboard-params)
        ids                    (distinct (map :id (concat pulse-params dashboard-params)))]
    (for [id ids]
      (merge (first (get dashboard-params-by-id id))
             (first (get pulse-params-by-id id))))))
 
(ns metabase-enterprise.enhancements.integrations.google
  (:require
   [metabase.integrations.google.interface :as google.i]
   [metabase.models.setting :as setting]
   [metabase.models.setting.multi-setting :refer [define-multi-setting-impl]]))
(define-multi-setting-impl google.i/google-auth-auto-create-accounts-domain :ee
  :getter (fn [] (setting/get-value-of-type :string :google-auth-auto-create-accounts-domain))
  :setter (fn [domain] (setting/set-value-of-type! :string :google-auth-auto-create-accounts-domain domain)))
 

The Enterprise version of the LDAP integration is basically the same but also supports syncing user attributes.

(ns metabase-enterprise.enhancements.integrations.ldap
  (:require
   [metabase.integrations.common :as integrations.common]
   [metabase.integrations.ldap.default-implementation :as default-impl]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.models.user :as user :refer [User]]
   [metabase.public-settings.premium-features
    :as premium-features
    :refer [defenterprise-schema]]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-tru]]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2])
  (:import
   (com.unboundid.ldap.sdk LDAPConnectionPool)))
(def ^:private EEUserInfo
  [:merge default-impl/UserInfo
   [:map [:attributes [:maybe [:map-of :keyword :any]]]]])
(defsetting ldap-sync-user-attributes
  (deferred-tru "Should we sync user attributes when someone logs in via LDAP?")
  :type    :boolean
  :default true
  :audit   :getter)

TODO - maybe we want to add a csv setting type?

(defsetting ldap-sync-user-attributes-blacklist
  (deferred-tru "Comma-separated list of user attributes to skip syncing for LDAP users.")
  :default "userPassword,dn,distinguishedName"
  :type    :csv
  :audit   :getter)
(defsetting ldap-group-membership-filter
  (deferred-tru "Group membership lookup filter. The placeholders '{dn}' and '{uid}' will be replaced by the user''s Distinguished Name and UID, respectively.")
  :default "(member={dn})"
  :audit   :getter)
(defn- syncable-user-attributes [m]
  (when (ldap-sync-user-attributes)
    (apply dissoc m :objectclass (map (comp keyword u/lower-case-en) (ldap-sync-user-attributes-blacklist)))))
(defn- attribute-synced-user
  [{:keys [attributes first-name last-name email]}]
  (when-let [user (t2/select-one [User :id :last_login :first_name :last_name :login_attributes :is_active]
                                 :%lower.email (u/lower-case-en email))]
    (let [syncable-attributes (syncable-user-attributes attributes)
          old-first-name (:first_name user)
          old-last-name (:last_name user)
          user-changes (merge
                        (when-not (= syncable-attributes (:login_attributes user))
                          {:login_attributes syncable-attributes})
                        (when (not= first-name old-first-name)
                          {:first_name first-name})
                        (when (not= last-name old-last-name)
                          {:last_name last-name}))]
      (if (seq user-changes)
        (do
          (t2/update! User (:id user) user-changes)
          (t2/select-one [User :id :last_login :is_active] :id (:id user))) ; Reload updated user
        user))))
(defenterprise-schema find-user :- [:maybe EEUserInfo]
  "Get user information for the supplied username."
  :feature :sso-ldap
  [ldap-connection :- (ms/InstanceOfClass LDAPConnectionPool)
   username        :- ms/NonBlankString
   settings        :- default-impl/LDAPSettings]
  (when-let [result (default-impl/search ldap-connection username settings)]
    (when-let [user-info (default-impl/ldap-search-result->user-info
                          ldap-connection
                          result
                          settings
                          (ldap-group-membership-filter))]
      (assoc user-info :attributes (syncable-user-attributes result)))))

for some reason the :clj-kondo/ignore doesn't work inside of [[defenterprise-schema]]

#_{:clj-kondo/ignore [:deprecated-var]}
(defenterprise-schema fetch-or-create-user! :- (ms/InstanceOf User)
  "Using the `user-info` (from `find-user`) get the corresponding Metabase user, creating it if necessary."
  :feature :sso-ldap
  [{:keys [first-name last-name email groups attributes], :as user-info} :- EEUserInfo
   {:keys [sync-groups?], :as settings}                                  :- default-impl/LDAPSettings]
  (let [user (or (attribute-synced-user user-info)
                 (-> (user/create-new-ldap-auth-user! {:first_name       first-name
                                                       :last_name        last-name
                                                       :email            email
                                                       :login_attributes attributes})
                     (assoc :is_active true)))]
    (u/prog1 user
      (when sync-groups?
        (let [group-ids            (default-impl/ldap-groups->mb-group-ids groups settings)
              all-mapped-group-ids (default-impl/all-mapped-group-ids settings)]
          (integrations.common/sync-group-memberships! user
                                                       group-ids
                                                       all-mapped-group-ids))))))
 
(ns metabase-enterprise.internal-user
  (:require [metabase.config :as config]
            [metabase.models :refer [User]]
            [metabase.util.log :as log]
            [toucan2.core :as t2]))
(defn- install-internal-user! []
  (t2/insert-returning-instances!
   User
   {:id config/internal-mb-user-id
    :first_name "Metabase"
    :last_name "Internal"
    :email "internal@metabase.com"
    :password (str (random-uuid))
    :is_active false
    :is_superuser false
    :login_attributes nil
    :sso_source nil
    :type :internal}))

Creates the internal user

(defn ensure-internal-user-exists!
  []
  (if-not (t2/exists? User :id config/internal-mb-user-id)
    (do (log/info "No internal user found, creating now...")
        (install-internal-user!)
        ::installed)
    ::no-op))
 
(ns metabase-enterprise.models
  (:require
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings.premium-features :as premium-features :refer [defenterprise]]
   [metabase.util :as u]))

Tries to require a given model in each of the possible enterprise model namespaces, to ensure it is required.

(defenterprise resolve-enterprise-model
  :feature :none
  [x]
  (when (and (keyword? x)
             (= (namespace x) "model")
             ;; Don't try to require if it's already registered as a :metabase/model, since that means it has already
             ;; been required
             (not (isa? x :metabase/model)))
    (doseq [feature @premium-features/premium-features]
      (u/ignore-exceptions
       (let [model-namespace (symbol (str "metabase-enterprise." (name feature) ".models." (u/->kebab-case-en (name x))))]
         ;; use `classloader/require` which is thread-safe and plays nice with our plugins system
         (classloader/require model-namespace)))))
  x)
 

/api/mt/gtap endpoints, for CRUD operations and the like on GTAPs (Group Table Access Policies).

(ns metabase-enterprise.sandbox.api.gtap
  (:require
   [compojure.core :refer [DELETE GET POST PUT]]
   [metabase-enterprise.sandbox.models.group-table-access-policy :as gtap :refer [GroupTableAccessPolicy]]
   [metabase.api.common :as api]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))

/

(api/defendpoint GET 
  "Fetch a list of all GTAPs currently in use, or a single GTAP if both `group_id` and `table_id` are provided."
  [group_id table_id]
  {group_id [:maybe ms/PositiveInt]
   table_id [:maybe ms/PositiveInt]}
  (if (and group_id table_id)
    (t2/select-one GroupTableAccessPolicy :group_id group_id :table_id table_id)
    (t2/select GroupTableAccessPolicy {:order-by [[:id :asc]]})))

/:id

(api/defendpoint GET 
  "Fetch GTAP by `id`"
  [id]
  {id ms/PositiveInt}
  (api/check-404 (t2/select-one GroupTableAccessPolicy :id id)))

TODO - not sure what other endpoints we might need, e.g. for fetching the list above but for a given group or Table

/

#_(def ^:private AttributeRemappings
   (mu/with-api-error-message [:maybe [:map-of ms/NonBlankString ms/NonBlankString]]
     "value must be a valid attribute remappings map (attribute name -> remapped name)"))
(api/defendpoint POST 
  "Create a new GTAP."
  [:as {{:keys [table_id card_id group_id attribute_remappings]} :body}]
  {table_id             ms/PositiveInt
   card_id              [:maybe ms/PositiveInt]
   group_id             ms/PositiveInt
   #_attribute_remappings #_AttributeRemappings} ; TODO -  fix me
  (first (t2/insert-returning-instances! GroupTableAccessPolicy
                                         {:table_id             table_id
                                          :card_id              card_id
                                          :group_id             group_id
                                          :attribute_remappings attribute_remappings})))

/:id

(api/defendpoint PUT 
  "Update a GTAP entry. The only things you're allowed to update for a GTAP are the Card being used (`card_id`) or the
  paramter mappings; changing `table_id` or `group_id` would effectively be deleting this entry and creating a new
  one. If that's what you want to do, do so explicity with appropriate calls to the `DELETE` and `POST` endpoints."
  [id :as {{:keys [card_id #_attribute_remappings], :as body} :body}]
  {id                   ms/PositiveInt
   card_id              [:maybe ms/PositiveInt]
   #_attribute_remappings #_AttributeRemappings} ; TODO -  fix me
  (api/check-404 (t2/select-one GroupTableAccessPolicy :id id))
  ;; Only update `card_id` and/or `attribute_remappings` if the values are present in the body of the request.
  ;; This allows existing values to be "cleared" by being set to nil
  (when (some #(contains? body %) [:card_id :attribute_remappings])
    (t2/update! GroupTableAccessPolicy id
      (u/select-keys-when body
        :present #{:card_id :attribute_remappings})))
  (t2/select-one GroupTableAccessPolicy :id id))

/validate

(api/defendpoint POST 
  "Validate a sandbox which may not have yet been saved. This runs the same validation that is performed when the
  sandbox is saved, but doesn't actually save the sandbox."
  [:as {{:keys [table_id card_id]} :body}]
  {table_id             ms/PositiveInt
   card_id              [:maybe ms/PositiveInt]}
  (gtap/check-columns-match-table {:table_id table_id
                                   :card_id  card_id}))

/:id

(api/defendpoint DELETE 
  "Delete a GTAP entry."
  [id]
  {id ms/PositiveInt}
  (api/check-404 (t2/select-one GroupTableAccessPolicy :id id))
  (t2/delete! GroupTableAccessPolicy :id id)
  api/generic-204-no-content)

Wrap the Ring handler to make sure sandboxes are enabled before allowing access to the API endpoints.

(defn- +check-sandboxes-enabled
  [handler]
  (fn [request respond raise]
    (if-not (premium-features/enable-sandboxes?)
      (raise (ex-info (str (tru "Error: sandboxing is not enabled for this instance.")
                           " "
                           (tru "Please check you have set a valid Enterprise token and try again."))
               {:status-code 403}))
      (handler request respond raise))))

All endpoints in this namespace require superuser perms to view

TODO - does it make sense to have this middleware here? Or should we just wrap routes in the metabase-enterprise.sandbox.api.routes/routes table like we do for everything else?

TODO - defining the check-superuser check here means the API documentation function won't pick up on the "this requires a superuser" stuff since it parses the defendpoint body to look for a call to check-superuser. I suppose this doesn't matter (much) body since this is an enterprise endpoint and won't go in the dox anyway.

(api/define-routes api/+check-superuser +check-sandboxes-enabled)
 

API routes that are only enabled if we have a premium token with the :sandboxes feature.

(ns metabase-enterprise.sandbox.api.routes
  (:require
   [compojure.core :as compojure]
   [metabase-enterprise.api.routes.common :as ee.api.common]
   [metabase-enterprise.sandbox.api.gtap :as gtap]
   [metabase-enterprise.sandbox.api.table :as table]
   [metabase-enterprise.sandbox.api.user :as user]
   [metabase.api.routes.common :refer [+auth]]
   [metabase.util.i18n :refer [deferred-tru]]))

Ring routes for mt API endpoints.

(compojure/defroutes  routes
  ;; EE-only sandboxing routes live under `/mt` for historical reasons. `/mt` is for multi-tenant.
  ;;
  ;; TODO - We should change this to `/sandboxes` or something like that.
  (compojure/context
   "/mt" []
   (ee.api.common/+require-premium-feature
    :sandboxes
    (deferred-tru "Sandboxes")
    (compojure/routes
     (compojure/context "/gtap" [] (+auth gtap/routes))
     (compojure/context "/user" [] (+auth user/routes)))))
  ;; when sandboxing is enabled we *replace* GET /api/table/:id/query_metadata with a special EE version. If
  ;; sandboxing is not enabled, this passes thru to the OSS implementation of the endpoint.
  #_{:clj-kondo/ignore [:deprecated-var]}
  (compojure/context "/table" [] (ee.api.common/+when-premium-feature :sandboxes (+auth table/routes))))
 
(ns metabase-enterprise.sandbox.api.table
  (:require
   [clojure.set :as set]
   [compojure.core :refer [GET]]
   [metabase.api.common :as api]
   [metabase.api.table :as api.table]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.card :refer [Card]]
   [metabase.models.interface :as mi]
   [metabase.models.permissions :as perms]
   [metabase.models.table :as table :refer [Table]]
   [metabase.util :as u]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))
(mu/defn ^:private find-gtap-question :- [:maybe (mi/InstanceOf Card)]
  "Find the associated GTAP question (if there is one) for the given `table-or-table-id` and
  `user-or-user-id`. Returns nil if no question was found."
  [table-or-table-id user-or-user-id]
  (t2/select-one Card
                 {:select [:c.id :c.dataset_query]
                  :from   [[:sandboxes]]
                  :join   [[:permissions_group_membership :pgm] [:= :sandboxes.group_id :pgm.group_id]
                           [:report_card :c] [:= :c.id :sandboxes.card_id]]
                  :where  [:and
                           [:= :sandboxes.table_id (u/the-id table-or-table-id)]
                           [:= :pgm.user_id (u/the-id user-or-user-id)]]}))
(mu/defn only-sandboxed-perms? :- :boolean
  "Returns true if the user has only segemented and not full table permissions. If the user has full table permissions
  we wouldn't want to apply this segment filtering."
  [table :- (mi/InstanceOf Table)]
  (and
   (not (perms/set-has-full-permissions? @api/*current-user-permissions-set*
                                         (perms/table-query-path table)))
   (perms/set-has-full-permissions? @api/*current-user-permissions-set*
                                    (perms/table-sandboxed-query-path table))))
(mu/defn ^:private query->fields-ids :- [:maybe [:sequential :int]]
  [{{{:keys [fields]} :query} :dataset_query} :- [:maybe :map]]
  (mbql.u/match fields [:field (id :guard integer?) _] id))
(defn- maybe-filter-fields [table query-metadata-response]
  ;; If we have sandboxed permissions and the associated GTAP limits the fields returned, we need make sure the
  ;; query_metadata endpoint also excludes any fields the GTAP query would exclude
  (if-let [gtap-field-ids (and (only-sandboxed-perms? table)
                               (seq (query->fields-ids (find-gtap-question table api/*current-user-id*))))]
    (update query-metadata-response :fields #(filter (comp (set gtap-field-ids) u/the-id) %))
    query-metadata-response))

/:id/query_metadata

(api/defendpoint GET 
  "This endpoint essentially acts as a wrapper for the OSS version of this route. When a user has sandboxed permissions
  that only gives them access to a subset of columns for a given table, those inaccessable columns should also be
  excluded from what is show in the query builder. When the user has full permissions (or no permissions) this route
  doesn't add/change anything from the OSS version. See the docs on the OSS version of the endpoint for more
  information."
  [id include_sensitive_fields include_hidden_fields include_editable_data_model]
  {id                          ms/PositiveInt
   include_sensitive_fields    [:maybe ms/BooleanValue]
   include_hidden_fields       [:maybe ms/BooleanValue]
   include_editable_data_model [:maybe ms/BooleanValue]}
  (let [table            (api/check-404 (t2/select-one Table :id id))
        sandboxed-perms? (only-sandboxed-perms? table)
        thunk            (fn []
                           (maybe-filter-fields
                            table
                            (api.table/fetch-query-metadata
                             table
                             {:include-sensitive-fields?    include_sensitive_fields
                              :include-hidden-fields?       include_hidden_fields
                              :include-editable-data-model? include_editable_data_model})))]
    ;; if the user has sandboxed perms, temporarily upgrade their perms to read perms for the Table so they can see the
    ;; metadata
    (if sandboxed-perms?
      (binding [api/*current-user-permissions-set* (atom
                                                    (set/union
                                                     @api/*current-user-permissions-set*
                                                     (mi/perms-objects-set table :read)))]
        (thunk))
      (thunk))))
(api/define-routes)
 

Endpoint(s)for setting user attributes.

(ns metabase-enterprise.sandbox.api.user
  (:require
   [clojure.set :as set]
   [compojure.core :refer [GET PUT]]
   [metabase.api.common :as api]
   [metabase.models.user :refer [User]]
   [metabase.util.i18n :refer [deferred-tru]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))
(def ^:private UserAttributes
  (mu/with-api-error-message
    [:map-of
     :keyword
     :any]
    (deferred-tru "value must be a valid user attributes map (name -> value)")))

/:id/attributes

TODO - not sure we need this endpoint now that we're just letting you edit from the regular `PUT /api/user/:id endpoint

(api/defendpoint PUT 
  "Update the `login_attributes` for a User."
  [id :as {{:keys [login_attributes]} :body}]
  {id ms/PositiveInt
   login_attributes [:maybe UserAttributes]}
  (api/check-404 (t2/select-one User :id id))
  (pos? (t2/update! User id {:login_attributes login_attributes})))

/attributes

(api/defendpoint GET 
  "Fetch a list of possible keys for User `login_attributes`. This just looks at keys that have already been set for
  existing Users and returns those. "
  []
  (->>
   ;; look at the `login_attributes` for the first 1000 users that have them set. Then make a set of the keys
   (for [login-attributes (t2/select-fn-set :login_attributes User :login_attributes [:not= nil] {:limit 1000})
         :when (seq login-attributes)]
     (set (keys login-attributes)))
   ;; combine all the sets of attribute keys into a single set
   (reduce set/union #{})))
(api/define-routes api/+check-superuser)
 

Enterprise specific API utility functions

(ns metabase-enterprise.sandbox.api.util
  (:require
   [clojure.set :as set]
   [metabase-enterprise.sandbox.models.group-table-access-policy
    :refer [GroupTableAccessPolicy]]
   [metabase.api.common :refer [*current-user-id* *is-superuser?*]]
   [metabase.models.permissions :as perms :refer [Permissions]]
   [metabase.models.permissions-group-membership
    :refer [PermissionsGroupMembership]]
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.util.i18n :refer [tru]]
   [toucan2.core :as t2]))

Takes the permission set for each group a user is in, and a sandbox, and determines whether the sandbox should be enforced for the current user. This is done by checking whether the union of permissions in all other groups provides full data access to the sandboxed table. If so, we don't enforce the sandbox, because the other groups' permissions supercede it.

(defn- enforce-sandbox?
  [group-id->perms-set {group-id :group_id, table-id :table_id}]
  (let [perms-set (->> (dissoc group-id->perms-set group-id)
                       (vals)
                       (apply set/union))]
    (not (perms/set-has-full-permissions? perms-set (perms/table-query-path table-id)))))

Given a list of sandboxes and a list of permission group IDs that the current user is in, filter the sandboxes to only include ones that should be enforced for the current user. A sandbox is not enforced if the user is in a different permissions group that grants full access to the table.

(defn enforced-sandboxes
  [sandboxes group-ids]
  (let [perms               (when (seq group-ids)
                             (t2/select Permissions {:where [:in :group_id group-ids]}))
        group-id->perms-set (-> (group-by :group_id perms)
                                (update-vals (fn [perms] (into #{} (map :object) perms))))]
    (filter (partial enforce-sandbox? group-id->perms-set)
            sandboxes)))

Returns true if the currently logged in user has segmented permissions. Throws an exception if no current user is bound.

(defenterprise sandboxed-user?
  :feature :sandboxes
  []
  (boolean
   (when-not *is-superuser?*
     (if *current-user-id*
       (let [group-ids          (t2/select-fn-set :group_id PermissionsGroupMembership :user_id *current-user-id*)
             sandboxes          (when (seq group-ids)
                                  (t2/select GroupTableAccessPolicy :group_id [:in group-ids]))]
         (seq (enforced-sandboxes sandboxes group-ids)))
       ;; If no *current-user-id* is bound we can't check for sandboxes, so we should throw in this case to avoid
       ;; returning `false` for users who should actually be sandboxes.
       (throw (ex-info (str (tru "No current user found"))
                       {:status-code 403}))))))
 

Model definition for Group Table Access Policy, aka GTAP. A GTAP is useed to control access to a certain Table for a certain PermissionsGroup. Whenever a member of that group attempts to query the Table in question, a Saved Question specified by the GTAP is instead used as the source of the query.

See documentation in [[metabase.models.permissions]] for more information about the Metabase permissions system.

(ns metabase-enterprise.sandbox.models.group-table-access-policy
  (:require
   [medley.core :as m]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.models.card :refer [Card]]
   [metabase.models.interface :as mi]
   [metabase.models.permissions :as perms :refer [Permissions]]
   [metabase.models.table :as table]
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.server.middleware.session :as mw.session]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [methodical.core :as methodical]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

Used to be the toucan1 model name defined using [[toucan.models/defmodel]], now it's a reference to the toucan2 model name. We'll keep this till we replace all the symbols in our codebase.

(def GroupTableAccessPolicy
  :model/GroupTableAccessPolicy)
(methodical/defmethod t2/table-name :model/GroupTableAccessPolicy [_model] :sandboxes)
(doto :model/GroupTableAccessPolicy
  (derive :metabase/model)
  ;;; only admins can work with GTAPs
  (derive ::mi/read-policy.superuser)
  (derive ::mi/write-policy.superuser))
(defn- normalize-attribute-remapping-targets [attribute-remappings]
  (m/map-vals
   mbql.normalize/normalize
   attribute-remappings))
(t2/deftransforms :model/GroupTableAccessPolicy
  {:attribute_remappings {:in  (comp mi/json-in normalize-attribute-remapping-targets)
                          :out (comp normalize-attribute-remapping-targets mi/json-out-without-keywordization)}})

Return a mapping of field names to corresponding cols for given table.

(defn table-field-names->cols
  [table-id]
  (classloader/require 'metabase.query-processor)
  (into {} (for [col (mw.session/with-current-user nil
                       ((resolve 'metabase.query-processor/query->expected-cols)
                        {:database (table/table-id->database-id table-id)
                         :type     :query
                         :query    {:source-table table-id}}))]
             [(:name col) col])))

Assert that the base type of col, returned by a GTAP source query, matches the base type of table-col, a column from the original Table being sandboxed.

(defn check-column-types-match
  {:arglists '([col table-col])}
  [col {table-col-base-type :base_type}]
  ;; These errors might get triggered by API endpoints or by the QP (this code is used in the
  ;; `row-level-restrictions` middleware). So include `:type` and `:status-code` information in the ExceptionInfo
  ;; data so it can be passed along if applicable.
  (when table-col-base-type
    (when-not (isa? (keyword (:base_type col)) table-col-base-type)
      (let [msg (tru "Sandbox Questions can''t return columns that have different types than the Table they are sandboxing.")]
        (throw (ex-info msg
                        {:type        qp.error-type/bad-configuration
                         :status-code 400
                         :message     msg
                         :new-col     col
                         :expected    table-col-base-type
                         :actual      (:base_type col)}))))))

Make sure the result metadata data columns for the Card associated with a GTAP match up with the columns in the Table that's getting GTAPped. It's ok to remove columns, but you cannot add new columns. The base types of the Card columns can derive from the respective base types of the columns in the Table itself, but you cannot return an entirely different type.

(mu/defn check-columns-match-table
  ([{card-id :card_id, table-id :table_id}]
   ;; not all GTAPs have Cards
   (when card-id
     ;; not all Cards have saved result metadata
     (when-let [result-metadata (t2/select-one-fn :result_metadata Card :id card-id)]
       (check-columns-match-table table-id result-metadata))))
  ([table-id :- ms/PositiveInt result-metadata-columns]
   ;; prevent circular refs
   (classloader/require 'metabase.query-processor)
   (let [table-cols (table-field-names->cols table-id)]
     (doseq [col  result-metadata-columns
             :let [table-col (get table-cols (:name col))]]
       (check-column-types-match col table-col)))))

If a Card is updated, and its result metadata changes, check that these changes do not violate the constraints placed on GTAPs (the Card cannot add fields or change types vs. the original Table).

(defenterprise pre-update-check-sandbox-constraints
  :feature :sandboxes
  [{new-result-metadata :result_metadata, card-id :id}]
  (when new-result-metadata
    (when-let [gtaps-using-this-card (not-empty (t2/select [GroupTableAccessPolicy :id :table_id] :card_id card-id))]
      (let [original-result-metadata (t2/select-one-fn :result_metadata Card :id card-id)]
        (when-not (= original-result-metadata new-result-metadata)
          (doseq [{table-id :table_id} gtaps-using-this-card]
            (try
              (check-columns-match-table table-id new-result-metadata)
              (catch clojure.lang.ExceptionInfo e
                (throw (ex-info (str (tru "Cannot update Card: Card is used for Sandboxing, and updates would violate sandbox rules.")
                                     " "
                                     (.getMessage e))
                                (ex-data e)
                                e))))))))))

Create new sandboxes or update existing ones. If a sandbox has an :id it will be updated, otherwise it will be created. New sandboxes must have a :table_id corresponding to a sandboxed query path in the permissions table; if this does not exist, the sandbox will not be created.

(defenterprise upsert-sandboxes!
  :feature :sandboxes
  [sandboxes]
  (for [sandbox sandboxes]
    (if-let [id (:id sandbox)]
      ;; Only update `card_id` and/or `attribute_remappings` if the values are present in the body of the request.
      ;; This allows existing values to be "cleared" by being set to nil
      (do
        (when (some #(contains? sandbox %) [:card_id :attribute_remappings])
          (t2/update! GroupTableAccessPolicy
                      id
                      (u/select-keys-when sandbox :present #{:card_id :attribute_remappings})))
        (t2/select-one GroupTableAccessPolicy :id id))
      (let [expected-permission-path (perms/table-sandboxed-query-path (:table_id sandbox))]
        (when-let [permission-path-id (t2/select-one-fn :id Permissions :object expected-permission-path)]
          (first (t2/insert-returning-instances! GroupTableAccessPolicy (assoc sandbox :permission_id permission-path-id))))))))
(t2/define-before-insert :model/GroupTableAccessPolicy
  [gtap]
  (u/prog1 gtap
    (check-columns-match-table gtap)))
(t2/define-before-update :model/GroupTableAccessPolicy
  [{:keys [id], :as updates}]
  (u/prog1 updates
    (let [original (t2/original updates)
          updated  (merge original updates)]
      (when-not (= (:table_id original) (:table_id updated))
        (throw (ex-info (tru "You cannot change the Table ID of a GTAP once it has been created.")
                        {:id          id
                         :status-code 400})))
      (when (:card_id updates)
        (check-columns-match-table updated)))))
 
(ns metabase-enterprise.sandbox.models.params.field-values
  (:require
   [metabase-enterprise.advanced-permissions.api.util
    :as advanced-perms.api.u]
   [metabase-enterprise.sandbox.api.table :as table]
   [metabase-enterprise.sandbox.models.group-table-access-policy
    :refer [GroupTableAccessPolicy]]
   [metabase-enterprise.sandbox.query-processor.middleware.row-level-restrictions
    :as row-level-restrictions]
   [metabase.api.common :as api]
   [metabase.mbql.util :as mbql.u]
   [metabase.models :refer [Field PermissionsGroupMembership]]
   [metabase.models.field :as field]
   [metabase.models.field-values :as field-values]
   [metabase.models.params.field-values :as params.field-values]
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.util :as u]
   [toucan2.core :as t2]))
(comment api/keep-me)

Check if a field is sandboxed.

(defn field-is-sandboxed?
  [{:keys [table], :as field}]
  ;; slight optimization: for the `field-id->field-values` version we can batched hydrate `:table` to avoid having to
  ;; make a bunch of calls to fetch Table. For `get-or-create-field-values` we don't hydrate `:table` so we can fall
  ;; back to fetching it manually with `field/table`
  (table/only-sandboxed-perms? (or table (field/table field))))

Find the GTAP for current user that apply to table table-id.

(defn- table-id->gtap
  [table-id]
  (let [group-ids (t2/select-fn-set :group_id PermissionsGroupMembership :user_id api/*current-user-id*)
        gtaps     (t2/select GroupTableAccessPolicy
                             :group_id [:in group-ids]
                             :table_id table-id)]
    (when gtaps
      (row-level-restrictions/assert-one-gtap-per-table gtaps)
      ;; there shold be only one gtap per table and we only need one table here
      ;; see docs in [[metabase.models.permissions]] for more info
      (t2/hydrate (first gtaps) :card))))

Returns the gtap attributes for current user that applied to field.

The gtap-attributes is a list with 2 elements: 1. card-id - for GTAP that use a saved question 2. the timestamp when the saved question was last updated 3. a map: if query is mbql query: - with key is the user-attribute that applied to the table that field is in - value is the user-attribute of current user corresponding to the key for native query, this map will be the login-attributes of user

For example we have an GTAP rules {:card_id 1 ;; a mbql query :attribute_remappings {"State" [:dimension [:field 3 nil]]}}

And users with login-attributes {"State" "CA"}

;; (field-id->gtap-attributes-for-current-user (t2/select-one Field :id 3)) ;; -> [1, {"State" "CA"}]

(defn- field->gtap-attributes-for-current-user
  [{:keys [table_id] :as _field}]
  (when-let [gtap (table-id->gtap table_id)]
    (let [login-attributes     (:login_attributes @api/*current-user*)
          attribute_remappings (:attribute_remappings gtap)
          field-ids            (t2/select-fn-set :id Field :table_id table_id)]
      [(:card_id gtap)
       (-> gtap :card :updated_at)
       (if (= :native (get-in gtap [:card :query_type]))
         ;; For sandbox that uses native query, we can't narrow down to the exact attribute
         ;; that affect the current table. So we just hash the whole login-attributes of users.
         ;; This makes hashing a bit less efficient but it ensures that user get a new hash
         ;; if they change login attributes
         login-attributes
         (into {} (for [[k v] attribute_remappings
                        ;; get attribute that map to fields of the same table
                        :when (contains? field-ids
                                         (mbql.u/match-one v [:dimension [:field field-id _]] field-id))]
                    {k (get login-attributes k)})))])))

Fetch existing FieldValues for a sequence of field-ids for the current User. Values are returned as a map of {field-id FieldValues-instance} Returns nil if field-ids is empty or no matching FieldValues exist.

(defenterprise field-id->field-values-for-current-user
  :feature :sandboxes
  [field-ids]
  (let [fields                   (when (seq field-ids)
                                   (t2/hydrate (t2/select Field :id [:in (set field-ids)]) :table))
        {unsandboxed-fields false
         sandboxed-fields   true} (group-by (comp boolean field-is-sandboxed?) fields)]
    (merge
     ;; use the normal OSS batched implementation for any Fields that aren't subject to sandboxing.
     (when (seq unsandboxed-fields)
       (params.field-values/default-field-id->field-values-for-current-user
         (map u/the-id unsandboxed-fields)))
     ;; for sandboxed fields, fetch the sandboxed values individually.
     (into {} (for [{field-id :id, :as field} sandboxed-fields]
                [field-id (select-keys (params.field-values/get-or-create-advanced-field-values! :sandbox field)
                                       [:values :human_readable_values :field_id])])))))

Fetch cached FieldValues for a field, creating them if needed if the Field should have FieldValues. These should be filtered as appropriate for the current User (currently this only applies to the EE impl).

(defenterprise get-or-create-field-values-for-current-user!*
  :feature :sandboxes
  [field]
  (cond
    (field-is-sandboxed? field)
    (params.field-values/get-or-create-advanced-field-values! :sandbox field)
    ;; Impersonation can have row-level security enforced by the database, so we still need to store field values per-user.
    ;; TODO: only do this for DBs with impersonation in effect
    (and api/*current-user-id*
         (advanced-perms.api.u/impersonated-user?))
    (params.field-values/get-or-create-advanced-field-values! :impersonation field)
    :else
    (params.field-values/default-get-or-create-field-values-for-current-user! field)))

Returns a hash-key for linked-filter FieldValues if the field is sandboxed, otherwise fallback to the OSS impl.

(defenterprise hash-key-for-linked-filters
  :feature :sandboxes
  [field-id constraints]
  (let [field (t2/select-one Field :id field-id)]
    (if (field-is-sandboxed? field)
      (str (hash (concat [field-id
                          constraints]
                         (field->gtap-attributes-for-current-user field))))
      (field-values/default-hash-key-for-linked-filters field-id constraints))))

Returns a hash-key for FieldValues if the field is sandboxed, otherwise fallback to the OSS impl.

(defenterprise hash-key-for-sandbox
  :feature :sandboxes
  [field-id]
  (let [field (t2/select-one Field :id field-id)]
    (when (field-is-sandboxed? field)
      (str (hash (concat [field-id]
                         (field->gtap-attributes-for-current-user field)))))))
 
(ns metabase-enterprise.sandbox.models.permissions.delete-sandboxes
  (:require
   [metabase-enterprise.sandbox.models.group-table-access-policy
    :refer [GroupTableAccessPolicy]]
   [metabase.db.query :as mdb.query]
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.util :as u]
   [metabase.util.i18n :refer [tru]]
   [metabase.util.log :as log]
   [toucan2.core :as t2]))
(defn- delete-gtaps-with-condition! [group-or-id condition]
  (when (seq condition)
    (let [conditions (into
                      [:and
                       [:= :sandboxes.group_id (u/the-id group-or-id)]]
                      [condition])]
      (log/debugf "Deleting GTAPs for Group %d with conditions %s" (u/the-id group-or-id) (pr-str conditions))
      (try
        (if-let [gtap-ids (not-empty (set (map :id (mdb.query/query
                                                    {:select    [[:sandboxes.id :id]]
                                                     :from      [[:sandboxes]]
                                                     :left-join [[:metabase_table :table]
                                                                 [:= :sandboxes.table_id :table.id]]
                                                     :where     conditions}))))]
          (do
            (log/debugf "Deleting %d matching GTAPs: %s" (count gtap-ids) (pr-str gtap-ids))
            (t2/delete! GroupTableAccessPolicy :id [:in gtap-ids]))
          (log/debug "No matching GTAPs need to be deleted."))
        (catch Throwable e
          (throw (ex-info (tru "Error deleting Sandboxes: {0}" (ex-message e))
                          {:group (u/the-id group-or-id), :conditions conditions}
                          e)))))))
(defn- delete-gtaps-for-group-table! [{:keys [group-id table-id] :as _context} changes]
  (log/debugf "Deleting unneeded GTAPs for Group %d for Table %d. Graph changes: %s"
             group-id table-id (pr-str changes))
  (cond
    (= changes :none)
    (do
      (log/debugf "Group %d no longer has any permissions for Table %d, deleting GTAP for this Table if one exists"
                 group-id table-id)
      (delete-gtaps-with-condition! group-id [:= :table.id table-id]))
    (= changes :all)
    (do
      (log/debugf "Group %d now has full data perms for Table %d, deleting GTAP for this Table if one exists"
                 group-id table-id)
      (delete-gtaps-with-condition! group-id [:= :table.id table-id]))
    :else
    (let [new-query-perms (get changes :query :none)]
      (case new-query-perms
        :none
        (do
          (log/debugf "Group %d no longer has any query perms for Table %d; deleting GTAP for this Table if one exists"
                     group-id table-id)
          (delete-gtaps-with-condition! group-id [:= :table.id table-id]))
        :all
        (do
          (log/debugf "Group %d now has full non-sandboxed query perms for Table %d; deleting GTAP for this Table if one exists"
                     group-id table-id)
          (delete-gtaps-with-condition! group-id [:= :table.id table-id]))
        :segmented
        (log/debugf "Group %d now has full segmented query perms for Table %d. Do not need to delete GTAPs."
                   group-id table-id)))))
(defn- delete-gtaps-for-group-schema! [{:keys [group-id database-id schema-name], :as context} changes]
  (log/debugf "Deleting unneeded GTAPs for Group %d for Database %d, schema %s. Graph changes: %s"
             group-id database-id (pr-str schema-name) (pr-str changes))
  (cond
    (= changes :none)
    (do
      (log/debugf "Group %d no longer has any permissions for Database %d schema %s, deleting all GTAPs for this schema"
                  group-id database-id (pr-str schema-name))
      (delete-gtaps-with-condition! group-id [:and [:= :table.db_id database-id] [:= :table.schema schema-name]]))
    (= changes :all)
    (do
      (log/debugf "Group %d changes has full data perms for Database %d schema %s, deleting all GTAPs for this schema"
                  group-id database-id (pr-str schema-name))
      (delete-gtaps-with-condition! group-id [:and [:= :table.db_id database-id] [:= :table.schema schema-name]]))
    :else
    (doseq [table-id (set (keys changes))]
      (delete-gtaps-for-group-table! (assoc context :table-id table-id) (get changes table-id)))))
(defn- delete-gtaps-for-group-database! [{:keys [group-id database-id], :as context} changes]
  (log/debugf "Deleting unneeded GTAPs for Group %d for Database %d. Graph changes: %s"
              group-id database-id (pr-str changes))
  (if (#{:none :all :block :impersonated} changes)
    (do
      (log/debugf "Group %d %s for Database %d, deleting all GTAPs for this DB"
                  group-id
                  (case changes
                    :none  "no longer has any perms"
                    :all   "now has full data perms"
                    :block "is now BLOCKED from all non-data-perms access")
                  database-id)
      (delete-gtaps-with-condition! group-id [:= :table.db_id database-id]))
    (doseq [schema-name (set (keys changes))]
      (delete-gtaps-for-group-schema!
       (assoc context :schema-name schema-name)
       (get changes schema-name)))))
(defn- delete-gtaps-for-group! [{:keys [group-id]} changes]
  (log/debugf "Deleting unneeded GTAPs for Group %d. Graph changes: %s" group-id (pr-str changes))
  (doseq [database-id (set (keys changes))]
    (when-let [data-perm-changes (get-in changes [database-id :data :schemas])]
      (delete-gtaps-for-group-database!
       {:group-id group-id, :database-id database-id}
       data-perm-changes))))

For use only inside metabase.models.permissions; don't call this elsewhere. Delete GTAPs (sandboxes) that are no longer needed after the permissions graph is updated. changes are the parts of the graph that have changed, i.e. the things-only-in-new returned by clojure.data/diff.

(defenterprise delete-gtaps-if-needed-after-permissions-change!
  :feature :sandboxes
  [changes]
  (log/debug "Permissions updated, deleting unneeded GTAPs...")
  (doseq [group-id (set (keys changes))]
    (delete-gtaps-for-group! {:group-id group-id} (get changes group-id)))
  (log/debug "Done deleting unneeded GTAPs."))
 
(ns metabase-enterprise.sandbox.query-processor.middleware.column-level-perms-check
  (:require
   [medley.core :as m]
   [metabase.api.common :refer [*current-user-id*]]
   [metabase.mbql.util :as mbql.u]
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]))
(defn- field-ids [form]
  (set (mbql.u/match form
         [:field (id :guard integer?) _]
         id)))
(defn- maybe-apply-column-level-perms-check*
  {:arglists '([query context])}
  [{{{source-query-fields :fields} :source-query} :query, :as query} {:keys [gtap-perms]}]
  (let [restricted-field-ids (and gtap-perms
                                  (field-ids source-query-fields))]
    (when (seq restricted-field-ids)
      (let [fields-ids-in-query (field-ids (m/dissoc-in query [:query :source-query]))]
        (when-not (every? restricted-field-ids fields-ids-in-query)
          (log/warn (trs "User ''{0}'' attempted to access an inaccessible field. Accessible fields {1}, fields in query {2}"
                         *current-user-id* (pr-str restricted-field-ids) (pr-str fields-ids-in-query)))
          (throw (ex-info (str (tru "User not able to query field")) {:status 403})))))))

Check column-level permissions if applicable.

(defenterprise maybe-apply-column-level-perms-check
  :feature :sandboxes
  [qp]
  (fn [query rff context]
    (maybe-apply-column-level-perms-check* query context)
    (qp query rff context)))
 

Apply segmented a.k.a. sandboxing anti-permissions to the query, i.e. replace sandboxed Tables with the appropriate [[metabase-enterprise.sandbox.models.group-table-access-policy]]s (GTAPs). See dox for [[metabase.models.permissions]] for a high-level overview of the Metabase permissions system.

(ns metabase-enterprise.sandbox.query-processor.middleware.row-level-restrictions
  (:require
   [clojure.core.memoize :as memoize]
   [medley.core :as m]
   [metabase-enterprise.sandbox.api.util :as mt.api.u]
   [metabase-enterprise.sandbox.models.group-table-access-policy
    :as gtap
    :refer [GroupTableAccessPolicy]]
   [metabase.api.common :as api :refer [*current-user* *current-user-id*]]
   [metabase.db.connection :as mdb.connection]
   [metabase.lib.metadata :as lib.metadata]
   [metabase.lib.metadata.protocols :as lib.metadata.protocols]
   [metabase.mbql.schema :as mbql.s]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.card :refer [Card]]
   [metabase.models.permissions :as perms]
   [metabase.models.permissions-group-membership
    :refer [PermissionsGroupMembership]]
   [metabase.models.query.permissions :as query-perms]
   [metabase.permissions.util :as perms.u]
   [metabase.plugins.classloader :as classloader]
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.query-processor.error-type :as qp.error-type]
   [metabase.query-processor.middleware.fetch-source-query
    :as fetch-source-query]
   [metabase.query-processor.middleware.permissions :as qp.perms]
   [metabase.query-processor.store :as qp.store]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   #_{:clj-kondo/ignore [:discouraged-namespace]}
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)
(comment mdb.connection/keep-me) ; used for [[memoize/ttl]]

+----------------------------------------------------------------------------------------------------------------+ | query->gtap | +----------------------------------------------------------------------------------------------------------------+

(defn- all-table-ids [m]
  (into #{} cat (mbql.u/match m
                  (_ :guard (every-pred map? :source-table (complement ::gtap?)))
                  (let [recursive-ids (all-table-ids (dissoc &match :source-table))]
                    (cons (:source-table &match) recursive-ids)))))
(defn- query->all-table-ids [query]
  (let [ids (all-table-ids query)]
    (when (seq ids)
      (qp.store/bulk-metadata :metadata/table ids)
      (set ids))))

Make sure all referenced Tables have at most one GTAP.

(defn assert-one-gtap-per-table
  [gtaps]
  (doseq [[table-id gtaps] (group-by :table_id gtaps)
          :when            (> (count gtaps) 1)]
    (throw (ex-info (tru "Found more than one group table access policy for user ''{0}''"
                         (:email @*current-user*))
                    {:type      qp.error-type/client
                     :table-id  table-id
                     :gtaps     gtaps
                     :user      *current-user-id*
                     :group-ids (map :group_id gtaps)}))))
(defn- tables->sandboxes [table-ids]
  (qp.store/cached [*current-user-id* table-ids]
    (let [group-ids           (qp.store/cached *current-user-id*
                                (t2/select-fn-set :group_id PermissionsGroupMembership :user_id *current-user-id*))
          sandboxes           (when (seq group-ids)
                               (t2/select GroupTableAccessPolicy :group_id [:in group-ids]
                                 :table_id [:in table-ids]))
          enforced-sandboxes (mt.api.u/enforced-sandboxes sandboxes group-ids)]
       (when (seq enforced-sandboxes)
         (assert-one-gtap-per-table enforced-sandboxes)
         enforced-sandboxes))))
(defn- query->table-id->gtap [query]
  {:pre [(some? *current-user-id*)]}
  (let [table-ids (query->all-table-ids query)
        gtaps     (some-> table-ids tables->sandboxes)]
    (when (seq gtaps)
      (m/index-by :table_id gtaps))))

+----------------------------------------------------------------------------------------------------------------+ | Applying a GTAP | +----------------------------------------------------------------------------------------------------------------+

(mu/defn ^:private target-field->base-type :- [:maybe ms/FieldType]
  "If the `:target` of a parameter contains a `:field` clause, return the base type corresponding to the Field it
  references. Otherwise returns `nil`."
  [[_ target-field-clause]]
  (when-let [field-id (mbql.u/match-one target-field-clause [:field (field-id :guard integer?) _] field-id)]
    (:base-type (lib.metadata.protocols/field (qp.store/metadata-provider) field-id))))

Take an attr-value with a desired target-type and coerce to that type if need be. If not type is given or it's already correct, return the original attr-value

(defn- attr-value->param-value
  [target-type attr-value]
  (let [attr-string? (string? attr-value)]
    (cond
      ;; If the attr-value is a string and the target type is integer, parse it as a long
      (and attr-string? (isa? target-type :type/Integer))
      (parse-long attr-value)
      ;; If the attr-value is a string and the target type is float, parse it as a double
      (and attr-string? (isa? target-type :type/Float))
      (parse-double attr-value)
      ;; No need to parse it if the type isn't numeric or if it's already a number
      :else
      attr-value)))
(defn- attr-remapping->parameter [login-attributes [attr-name target]]
  (let [attr-value      (get login-attributes attr-name)
        field-base-type (target-field->base-type target)]
    (when (not attr-value)
      (throw (ex-info (tru "Query requires user attribute `{0}`" (name attr-name))
                      {:type qp.error-type/missing-required-parameter})))
    {:type   :category
     :target target
     :value  (attr-value->param-value field-base-type attr-value)}))
(defn- gtap->parameters [{attribute-remappings :attribute_remappings}]
  (mapv (partial attr-remapping->parameter (:login_attributes @*current-user*))
        attribute-remappings))
(mu/defn ^:private preprocess-source-query :- mbql.s/SourceQuery
  [source-query :- mbql.s/SourceQuery]
  (try
    (let [query        {:database (u/the-id (lib.metadata/database (qp.store/metadata-provider)))
                        :type     :query
                        :query    source-query}
          preprocessed (binding [*current-user-id* nil]
                         (classloader/require 'metabase.query-processor)
                         ((resolve 'metabase.query-processor/preprocess) query))]
      (select-keys (:query preprocessed) [:source-query :source-metadata]))
    (catch Throwable e
      (throw (ex-info (tru "Error preprocessing source query when applying GTAP: {0}" (ex-message e))
                      {:source-query source-query}
                      e)))))
(defn- card-gtap->source
  [{card-id :card_id :as gtap}]
  (update-in (fetch-source-query/card-id->source-query-and-metadata card-id)
             [:source-query :parameters]
             concat
             (gtap->parameters gtap)))
(defn- table-gtap->source [{table-id :table_id, :as gtap}]
  {:source-query {:source-table table-id, :parameters (gtap->parameters gtap)}})
(mu/defn ^:private mbql-query-metadata :- [:+ :map]
  [inner-query]
  (binding [*current-user-id* nil]
    ((requiring-resolve 'metabase.query-processor/query->expected-cols)
     {:database (u/the-id (lib.metadata/database (qp.store/metadata-provider)))
      :type     :query
      :query    inner-query})))

cache the original metadata for a little bit so we don't have to preprocess a query every time we apply sandboxing

(def ^:private ^{:arglists '([table-id])} original-table-metadata
  (memoize/ttl
   ^{::memoize/args-fn (fn [[table-id]]
                         [(mdb.connection/unique-identifier) table-id])}
   (fn [table-id]
     (mbql-query-metadata {:source-table table-id}))
   :ttl/threshold (u/minutes->ms 1)))
(mu/defn ^:private reconcile-metadata :- [:+ :map]
  "Combine the metadata in `source-query-metadata` with the `table-metadata` from the Table being sandboxed."
  [source-query-metadata :- [:+ :map] table-metadata]
  (let [col-name->table-metadata (m/index-by :name table-metadata)]
    (vec
     (for [col   source-query-metadata
           :let  [table-col (get col-name->table-metadata (:name col))]
           :when table-col]
       (do
         (gtap/check-column-types-match col table-col)
         table-col)))))
(mu/defn ^:private native-query-metadata :- [:+ :map]
  [source-query :- [:map [:source-query :any]]]
  (let [result (binding [*current-user-id* nil]
                 ((requiring-resolve 'metabase.query-processor/process-query)
                  {:database (u/the-id (lib.metadata/database (qp.store/metadata-provider)))
                   :type     :query
                   :query    {:source-query source-query
                              :limit        0}}))]
    (or (-> result :data :results_metadata :columns not-empty)
        (throw (ex-info (tru "Error running query to determine metadata")
                        {:source-query source-query
                         :result       result})))))
(mu/defn ^:private source-query-form-ensure-metadata :- [:and [:map-of :keyword :any]
                                                         [:map
                                                          [:source-query :any]
                                                          [:source-metadata [:+ :map]]]]
  "Add `:source-metadata` to a `source-query` if needed. If the source metadata had to be resolved (because Card with
  `card-id`) didn't already have it, save it so we don't have to resolve it again next time around."
  [{:keys [source-metadata], :as source-query} :- [:and [:map-of :keyword :any] [:map [:source-query :any]]]
   table-id                                    :- ms/PositiveInt
   card-id                                     :- [:maybe ms/PositiveInt]]
  (let [table-metadata   (original-table-metadata table-id)
        ;; make sure source query has `:source-metadata`; add it if needed
        [metadata save?] (cond
                          ;; if it already has `:source-metadata`, we're good to go.
                          (seq source-metadata)
                          [source-metadata false]
                          ;; if it doesn't have source metadata, but it's an MBQL query, we can preprocess the query to
                          ;; get the expected metadata.
                          (not (get-in source-query [:source-query :native]))
                          [(mbql-query-metadata source-query) true]
                          ;; otherwise if it's a native query we'll have to run the query really quickly to get the
                          ;; expected metadata.
                          :else
                          [(native-query-metadata source-query) true])
        metadata (reconcile-metadata metadata table-metadata)]
    (assert (seq metadata))
    ;; save the result metadata so we don't have to do it again next time if applicable
    (when (and card-id save?)
      (log/tracef "Saving results metadata for GTAP Card %s" card-id)
      (t2/update! Card card-id {:result_metadata metadata}))
    ;; make sure the fetched Fields are present the QP store
    (when-let [field-ids (not-empty (filter some? (map :id metadata)))]
      (qp.store/bulk-metadata :metadata/column field-ids))
    (assoc source-query :source-metadata metadata)))
(mu/defn ^:private gtap->source :- [:map
                                    [:source-query :any]
                                    [:source-metadata {:optional true} [:sequential mbql.s/SourceQueryMetadata]]]
  "Get the source query associated with a `gtap`."
  [{card-id :card_id, table-id :table_id, :as gtap} :- :map]
  (-> ((if card-id
         card-gtap->source
         table-gtap->source) gtap)
      preprocess-source-query
      (source-query-form-ensure-metadata table-id card-id)))

Returns the set of table IDs which are used by the given sandbox. These are the sandboxed table itself, as well as any linked tables referenced via fields in the attribute remappings. This is the set of tables which need to be excluded from subsequent permission checks in order to run the sandboxed query.

(defn- sandbox->table-ids
  [{table-id :table_id, attribute-remappings :attribute_remappings}]
  (->>
   (for [target-field-clause (vals attribute-remappings)]
     (mbql.u/match-one target-field-clause
       [:field (field-id :guard integer?) _]
       (:table-id (lib.metadata.protocols/field (qp.store/metadata-provider) field-id))))
   (cons table-id)
   (remove nil?)
   set))
(mu/defn ^:private sandbox->perms-set :- [:set perms.u/PathSchema]
  "Calculate the set of permissions needed to run the query associated with a sandbox; this set of permissions is excluded
  during the normal QP perms check.
  Background: when applying sandboxing, we don't want the QP perms check middleware to throw an Exception if the Current
  User doesn't have permissions to run the underlying sandboxed query, which will likely be greater than what they
  actually have. (For example, a User might have sandboxed query perms for Table 15, which is why we're applying a
  sandbox in the first place; the actual perms required to normally run the underlying sandbox query is more likely
  something like *full* query perms for Table 15.) The QP perms check middleware subtracts this set from the set of
  required permissions, allowing the user to run their sandboxed query."
  [{card-id :card_id :as sandbox}]
  (if card-id
    (qp.store/cached card-id
      (query-perms/perms-set (:dataset-query (lib.metadata.protocols/card (qp.store/metadata-provider) card-id))
                             :throw-exceptions? true))
    (set (map perms/table-query-path (sandbox->table-ids sandbox)))))
(defn- sandboxes->perms-set [sandboxes]
  (set (mapcat sandbox->perms-set sandboxes)))

+----------------------------------------------------------------------------------------------------------------+ | Middleware | +----------------------------------------------------------------------------------------------------------------+

------------------------------------------ apply-row-level-permissions -------------------------------------------

Apply a GTAP to map m (e.g. a Join or inner query), replacing its :source-table/:source-query with the GTAP :source-query.

(defn- apply-gtap
  [m gtap]
  ;; Only infer source query metadata for JOINS that use `:fields :all`. That's the only situation in which we
  ;; absolutely *need* to infer source query metadata (we need to know the columns returned by the source query so we
  ;; can generate the join against ALL fields). It's better not to infer the source metadata if we don't NEED to,
  ;; because we might be inferring the wrong thing. See comments above -- in practice a GTAP should have the same
  ;; columns as the Table it replaces, but this constraint is not enforced anywhere. If we infer metadata and the GTAP
  ;; turns out *not* to match exactly, the query could break. So only infer it in cases where the query would
  ;; definitely break otherwise.
  (u/prog1 (merge
            (dissoc m :source-table :source-query)
            (gtap->source gtap))
    (log/tracef "Applied GTAP: replaced\n%swith\n%s"
                (u/pprint-to-str 'yellow m)
                (u/pprint-to-str 'green <>))))

Replace :source-table entries that refer to Tables for which we have applicable GTAPs with :source-query entries from their GTAPs.

(defn- apply-gtaps
  [m table-id->gtap]
  ;; replace maps that have `:source-table` key and a matching entry in `table-id->gtap`, but do not have `::gtap?` key
  (mbql.u/replace m
    (_ :guard (every-pred map? (complement ::gtap?) :source-table #(get table-id->gtap (:source-table %))))
    (let [updated             (apply-gtap &match (get table-id->gtap (:source-table &match)))
          ;; now recursively apply gtaps anywhere else they might exist at this level, e.g. `:joins`
          recursively-updated (merge
                               (select-keys updated [:source-table :source-query])
                               (apply-gtaps (dissoc updated :source-table :source-query) table-id->gtap))]
      ;; add a `::gtap?` key next to every `:source-table` key so when we do a second pass after adding JOINs they
      ;; don't get processed again
      (mbql.u/replace recursively-updated
        (_ :guard (every-pred map? :source-table))
        (assoc &match ::gtap? true)))))
(defn- expected-cols [query]
  (binding [*current-user-id* nil]
    ((requiring-resolve 'metabase.query-processor/query->expected-cols) query)))

Apply GTAPs to query and return the updated version of query.

(defn- gtapped-query
  [original-query table-id->gtap]
  (let [sandboxed-query (apply-gtaps original-query table-id->gtap)]
    (if (= sandboxed-query original-query)
      original-query
      (-> sandboxed-query
          (assoc ::original-metadata (expected-cols original-query))
          (update-in [::qp.perms/perms :gtaps] (fn [perms] (into (set perms) (sandboxes->perms-set (vals table-id->gtap)))))))))
(def ^:private default-recursion-limit 20)
(def ^:private ^:dynamic *recursion-limit* default-recursion-limit)

Pre-processing middleware. Replaces source tables a User was querying against with source queries that (presumably) restrict the rows returned, based on presence of sandboxes.

(defenterprise apply-sandboxing
  :feature :sandboxes
  [query]
  (if-not api/*is-superuser?*
    (or (when-let [table-id->gtap (when *current-user-id*
                                    (query->table-id->gtap query))]
          (let [gtapped-query (gtapped-query query table-id->gtap)]
            (if (not= query gtapped-query)
              ;; Applying GTAPs to the query may have introduced references to tables that are also sandboxed,
              ;; so we need to recursively appby the middleware until new queries are not returned.
              (if (= *recursion-limit* 0)
                (throw (ex-info (trs "Reached recursion limit of {0} in \"apply-sandboxing\" middleware"
                                     default-recursion-limit)
                                query))
                (binding [*recursion-limit* (dec *recursion-limit*)]
                  (apply-sandboxing gtapped-query)))
              gtapped-query)))
        query)
    query))

Post-processing

Merge column metadata from the non-sandboxed version of the query into the sandboxed results metadata. This way the final results metadata coming back matches what we'd get if the query was not running in a sandbox.

(defn- merge-metadata
  [original-metadata metadata]
  (letfn [(merge-cols [cols]
            (let [col-name->expected-col (m/index-by :name original-metadata)]
              (for [col cols]
                (merge
                 col
                 (get col-name->expected-col (:name col))))))]
    (update metadata :cols merge-cols)))

Post-processing middleware. Merges in column metadata from the original, unsandboxed version of the query.

(defenterprise merge-sandboxing-metadata
  :feature :sandboxes
  [{::keys [original-metadata] :as query} rff]
  (fn merge-sandboxing-metadata-rff* [metadata]
    (let [metadata (assoc metadata :is_sandboxed (some? (get-in query [::qp.perms/perms :gtaps])))
          metadata (if original-metadata
                     (merge-metadata original-metadata metadata)
                     metadata)]
      (rff metadata))))
 
(ns metabase-enterprise.search.scoring
  ;; TODO -- move to `metabase-enterprise.<feature>.*`
  (:require
   [metabase.public-settings.premium-features :as premium-features :refer [defenterprise]]
   [metabase.search.scoring :as scoring]))

A scorer for items in official collections

(defn- official-collection-score
  [{:keys [collection_authority_level]}]
  (if (contains? #{"official"} collection_authority_level)
    1
    0))

A scorer for verified items.

(defn- verified-score
  [{:keys [moderated_status]}]
  (if (contains? #{"verified"} moderated_status)
    1
    0))

Scoring implementation that adds score for items in official collections.

(defenterprise score-result
  :feature :none
  [result]
  (cond-> (scoring/weights-and-scores result)
    (premium-features/has-feature? :official-collections)
    (conj {:weight 2
            :score  (official-collection-score result)
            :name   "official collection score"})
    (premium-features/has-feature? :content-verification)
    (conj {:weight 2
           :score  (verified-score result)
           :name   "verified"})))
 
(ns metabase-enterprise.serialization.cmd
  (:refer-clojure :exclude [load])
  (:require
   [clojure.java.io :as io]
   [metabase-enterprise.serialization.dump :as dump]
   [metabase-enterprise.serialization.load :as load]
   [metabase-enterprise.serialization.v2.entity-ids :as v2.entity-ids]
   [metabase-enterprise.serialization.v2.extract :as v2.extract]
   [metabase-enterprise.serialization.v2.ingest :as v2.ingest]
   [metabase-enterprise.serialization.v2.load :as v2.load]
   [metabase-enterprise.serialization.v2.storage :as v2.storage]
   [metabase.db :as mdb]
   [metabase.models.card :refer [Card]]
   [metabase.models.collection :refer [Collection]]
   [metabase.models.dashboard :refer [Dashboard]]
   [metabase.models.database :refer [Database]]
   [metabase.models.field :as field :refer [Field]]
   [metabase.models.metric :refer [Metric]]
   [metabase.models.native-query-snippet :refer [NativeQuerySnippet]]
   [metabase.models.pulse :refer [Pulse]]
   [metabase.models.segment :refer [Segment]]
   [metabase.models.serialization :as serdes]
   [metabase.models.table :refer [Table]]
   [metabase.models.user :refer [User]]
   [metabase.plugins :as plugins]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.util :as u]
   [metabase.util.i18n :refer [deferred-trs trs]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)
(def ^:private Mode
  (mu/with-api-error-message [:enum :skip :update]
    (deferred-trs "invalid --mode value")))
(def ^:private OnError
  (mu/with-api-error-message [:enum :continue :abort]
    (deferred-trs "invalid --on-error value")))
(def ^:private Context
  (mu/with-api-error-message
    [:map {:closed true}
     [:on-error {:optional true} OnError]
     [:mode     {:optional true} Mode]]
    (deferred-trs "invalid context seed value")))
(defn- check-premium-token! []
  (premium-features/assert-has-feature :serialization (trs "Serialization")))

Load serialized metabase instance as created by [[dump]] command from directory path.

(mu/defn v1-load!
  [path context :- Context]
  (plugins/load-plugins!)
  (mdb/setup-db!)
  (check-premium-token!)
  (when-not (load/compatible? path)
    (log/warn (trs "Dump was produced using a different version of Metabase. Things may break!")))
  (let [context (merge {:mode     :skip
                        :on-error :continue}
                       context)]
    (try
      (log/info (trs "BEGIN LOAD from {0} with context {1}" path context))
      (let [all-res    [(load/load! (str path "/users") context)
                        (load/load! (str path "/databases") context)
                        (load/load! (str path "/collections") context)
                        (load/load-settings! path context)]
            reload-fns (filter fn? all-res)]
        (when (seq reload-fns)
          (log/info (trs "Finished first pass of load; now performing second pass"))
          (doseq [reload-fn reload-fns]
            (reload-fn)))
        (log/info (trs "END LOAD from {0} with context {1}" path context)))
      (catch Throwable e
        (log/error e (trs "ERROR LOAD from {0}: {1}" path (.getMessage e)))
        (throw e)))))

SerDes v2 load entry point for internal users.

opts are passed to [[v2.load/load-metabase]].

(mu/defn v2-load-internal!
  [path :- :string
   opts :- [:map [:abort-on-error {:optional true} [:maybe :boolean]]]
   ;; Deliberately separate from the opts so it can't be set from the CLI.
   & {:keys [token-check?]
      :or   {token-check? true}}]
  (plugins/load-plugins!)
  (mdb/setup-db!)
  (when token-check?
    (check-premium-token!))
  ; TODO This should be restored, but there's no manifest or other meta file written by v2 dumps.
  ;(when-not (load/compatible? path)
  ;  (log/warn (trs "Dump was produced using a different version of Metabase. Things may break!")))
  (log/info (trs "Loading serialized Metabase files from {0}" path))
  (serdes/with-cache
    (v2.load/load-metabase! (v2.ingest/ingest-yaml path) opts)))

SerDes v2 load entry point.

opts are passed to load-metabase

(mu/defn v2-load!
  [path :- :string
   opts :- [:map [:abort-on-error {:optional true} [:maybe :boolean]]]]
  (v2-load-internal! path opts :token-check? true))
(defn- select-entities-in-collections
  ([model collections]
   (select-entities-in-collections model collections :all))
  ([model collections state]
   (let [state-filter (case state
                        :all nil
                        :active [:= :archived false])]
     (t2/select model {:where [:and
                               [:or [:= :collection_id nil]
                                (if (not-empty collections)
                                  [:in :collection_id (map u/the-id collections)]
                                  false)]
                               state-filter]}))))
(defn- select-segments-in-tables
  ([tables]
   (select-segments-in-tables tables :all))
  ([tables state]
   (case state
     :all
     (mapcat #(t2/select Segment :table_id (u/the-id %)) tables)
     :active
     (filter
      #(not (:archived %))
      (mapcat #(t2/select Segment :table_id (u/the-id %)) tables)))))

Selects the collections for a given user-id, or all collections without a personal ID if the passed user-id is nil. If state is passed (by default, :active), then that will be used to filter for collections that are archived (if the value is passed as :all).

(defn- select-collections
  ([users]
   (select-collections users :active))
  ([users state]
   (let [state-filter     (case state
                            :all nil
                            :active [:= :archived false])
         base-collections (t2/select Collection {:where [:and [:= :location "/"]
                                                              [:or [:= :personal_owner_id nil]
                                                                   [:= :personal_owner_id
                                                                       (some-> users first u/the-id)]]
                                                              state-filter]})]
     (if (empty? base-collections)
       []
       (-> (t2/select Collection
                             {:where [:and
                                      (reduce (fn [acc coll]
                                                (conj acc [:like :location (format "/%d/%%" (:id coll))]))
                                              [:or] base-collections)
                                      state-filter]})
           (into base-collections))))))

Legacy Metabase app data dump

(defn v1-dump!
  [path {:keys [state user] :or {state :active} :as opts}]
  (log/info (trs "BEGIN DUMP to {0} via user {1}" path user))
  (mdb/setup-db!)
  (check-premium-token!)
  (t2/select User) ;; TODO -- why??? [editor's note: this comment originally from Cam]
  (let [users       (if user
                      (let [user (t2/select-one User
                                                :email        user
                                                :is_superuser true)]
                        (assert user (trs "{0} is not a valid user" user))
                        [user])
                      [])
        databases   (if (contains? opts :only-db-ids)
                      (t2/select Database :id [:in (:only-db-ids opts)] {:order-by [[:id :asc]]})
                      (t2/select Database))
        tables      (if (contains? opts :only-db-ids)
                      (t2/select Table :db_id [:in (:only-db-ids opts)] {:order-by [[:id :asc]]})
                      (t2/select Table))
        fields      (if (contains? opts :only-db-ids)
                      (t2/select Field :table_id [:in (map :id tables)] {:order-by [[:id :asc]]})
                      (t2/select Field))
        metrics     (if (contains? opts :only-db-ids)
                      (t2/select Metric :table_id [:in (map :id tables)] {:order-by [[:id :asc]]})
                      (t2/select Metric))
        collections (select-collections users state)]
    (dump/dump! path
               databases
               tables
               (mapcat field/with-values (u/batches-of 32000 fields))
               metrics
               (select-segments-in-tables tables state)
               collections
               (select-entities-in-collections NativeQuerySnippet collections state)
               (select-entities-in-collections Card collections state)
               (select-entities-in-collections Dashboard collections state)
               (select-entities-in-collections Pulse collections state)
               users))
  (dump/dump-settings! path)
  (dump/dump-dimensions! path)
  (log/info (trs "END DUMP to {0} via user {1}" path user)))

Exports Metabase app data to directory at path

(defn v2-dump!
  [path {:keys [collection-ids] :as opts}]
  (log/info (trs "Exporting Metabase to {0}" path) (u/emoji "🏭 🚛💨"))
  (mdb/setup-db!)
  (check-premium-token!)
  (t2/select User) ;; TODO -- why??? [editor's note: this comment originally from Cam]
  (let [f (io/file path)]
    (.mkdirs f)
    (when-not (.canWrite f)
      (throw (ex-info (format "Destination path is not writeable: %s" path) {:filename path}))))
  (serdes/with-cache
    (-> (cond-> opts
          (seq collection-ids) (assoc :targets (v2.extract/make-targets-of-type "Collection" collection-ids)))
        v2.extract/extract
        (v2.storage/store! path)))
  (log/info (trs "Export to {0} complete!" path) (u/emoji "🚛💨 📦"))
  ::v2-dump-complete)

Add entity IDs for instances of serializable models that don't already have them.

Returns truthy if all entity IDs were added successfully, or falsey if any errors were encountered.

(defn seed-entity-ids!
  []
  (v2.entity-ids/seed-entity-ids!))

Drop entity IDs for all instances of serializable models.

This is needed for some cases of migrating from v1 to v2 serdes. v1 doesn't dump entity_id, so they may have been randomly generated independently in both instances. Then when v2 serdes is used to export and import, the randomly generated IDs don't match and the entities get duplicated. Dropping entity_id from both instances first will force them to be regenerated based on the hashes, so they should match up if the receiving instance is a copy of the sender.

Returns truthy if all entity IDs have been dropped, or falsey if any errors were encountered.

(defn drop-entity-ids!
  []
  (v2.entity-ids/drop-entity-ids!))
 

Serialize entities into a directory structure of YAMLs.

(ns metabase-enterprise.serialization.dump
  (:require
   [clojure.edn :as edn]
   [clojure.java.io :as io]
   [metabase-enterprise.serialization.names
    :refer [fully-qualified-name name-for-logging safe-name]]
   [metabase-enterprise.serialization.serialize :as serialize]
   [metabase.config :as config]
   [metabase.models.dashboard :refer [Dashboard]]
   [metabase.models.database :refer [Database]]
   [metabase.models.dimension :refer [Dimension]]
   [metabase.models.field :refer [Field]]
   [metabase.models.interface :as mi]
   [metabase.models.metric :refer [Metric]]
   [metabase.models.pulse :refer [Pulse]]
   [metabase.models.segment :refer [Segment]]
   [metabase.models.setting :as setting]
   [metabase.models.table :refer [Table]]
   [metabase.models.user :refer [User]]
   [metabase.util.i18n :as i18n :refer [trs]]
   [metabase.util.log :as log]
   [metabase.util.yaml :as yaml]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)
(def ^:private serialization-order
  (delay (-> (edn/read-string (slurp (io/resource "serialization-order.edn")))
             (update-vals (fn [order]
                            (into {} (map vector order (range))))))))
(defn- serialization-sorted-map* [order-key]
  (if-let [order (or (get @serialization-order order-key)
                     (get @serialization-order (last order-key)))]
    ;; known columns are sorted by their order, then unknown are sorted alphabetically
    (let [getter #(if (contains? order %)
                    [0 (get order %)]
                    [1 %])]
      (sorted-map-by (fn [k1 k2]
                       (compare (getter k1) (getter k2)))))
    (sorted-map)))
(def ^:private serialization-sorted-map (memoize serialization-sorted-map*))
(defn- serialization-deep-sort
  ([m]
   (let [model (-> (:serdes/meta m) last :model)]
     (serialization-deep-sort m [(keyword model)])))
  ([m path]
   (into (serialization-sorted-map path)
         (for [[k v] m]
           [k (cond
                (map? v)               (serialization-deep-sort v (conj path k))
                (and (sequential? v)
                     (map? (first v))) (mapv #(serialization-deep-sort % (conj path k)) v)
                :else                  v)]))))

Writes obj to filename and creates parent directories if necessary.

Writes (even nested) yaml keys in a deterministic fashion.

(defn spit-yaml!
  [filename obj]
  (io/make-parents filename)
  (try
    (spit filename (yaml/generate-string (serialization-deep-sort obj)
                                         {:dumper-options {:flow-style :block :split-lines false}}))
    (catch Exception e
      (if-not (.canWrite (.getParentFile (io/file filename)))
        (throw (ex-info (format "Destination path is not writeable: %s" filename) {:filename filename}))
        (throw e)))))
(defn- as-file?
  [instance]
  (some (fn [model]
          (mi/instance-of? model instance))
        [Pulse Dashboard Metric Segment Field User]))
(defn- spit-entity!
  [path entity]
  (let [filename (if (as-file? entity)
                   (format "%s%s.yaml" path (fully-qualified-name entity))
                   (format "%s%s/%s.yaml" path (fully-qualified-name entity) (safe-name entity)))]
    (when (.exists (io/as-file filename))
      (log/warn (str filename " is about to be overwritten."))
      (log/debug (str "With object: " (pr-str entity))))
    (spit-yaml! filename (serialize/serialize entity))))

Serialize entities into a directory structure of YAMLs at path.

(defn dump!
  [path & entities]
  (doseq [entity (flatten entities)]
    (try
      (spit-entity! path entity)
      (catch Throwable e
        (log/error e (trs "Error dumping {0}" (name-for-logging entity))))))
  (spit-yaml! (str path "/manifest.yaml")
             {:serialization-version serialize/serialization-protocol-version
              :metabase-version      config/mb-version-info}))

Combine all settings into a map and dump it into YAML at path.

(defn dump-settings!
  [path]
  (spit-yaml! (str path "/settings.yaml")
             (into {} (for [{:keys [key value]} (setting/admin-writable-site-wide-settings
                                                 :getter (partial setting/get-value-of-type :string))]
                        [key value]))))

Combine all dimensions into a vector and dump it into YAML at in the directory for the corresponding schema starting at path.

(defn dump-dimensions!
  [path]
  (doseq [[table-id dimensions] (group-by (comp :table_id Field :field_id) (t2/select Dimension))
          :let [table (t2/select-one Table :id table-id)]]
    (spit-yaml! (if (:schema table)
                 (format "%s%s/schemas/%s/dimensions.yaml"
                         path
                         (->> table :db_id (fully-qualified-name Database))
                         (:schema table))
                 (format "%s%s/dimensions.yaml"
                         path
                         (->> table :db_id (fully-qualified-name Database))))
               (map serialize/serialize dimensions))))
 

Load entities serialized by metabase-enterprise.serialization.dump.

(ns metabase-enterprise.serialization.load
  (:refer-clojure :exclude [load])
  (:require
   [clojure.java.io :as io]
   [clojure.string :as str]
   [medley.core :as m]
   [metabase-enterprise.serialization.names
    :as names
    :refer [fully-qualified-name->context]]
   [metabase-enterprise.serialization.upsert :refer [maybe-upsert-many!]]
   [metabase.config :as config]
   [metabase.db.connection :as mdb.connection]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.card :refer [Card]]
   [metabase.models.collection :refer [Collection]]
   [metabase.models.dashboard :refer [Dashboard]]
   [metabase.models.dashboard-card :refer [DashboardCard]]
   [metabase.models.dashboard-card-series :refer [DashboardCardSeries]]
   [metabase.models.database :as database :refer [Database]]
   [metabase.models.dimension :refer [Dimension]]
   [metabase.models.field :refer [Field]]
   [metabase.models.field-values :refer [FieldValues]]
   [metabase.models.metric :refer [Metric]]
   [metabase.models.native-query-snippet :refer [NativeQuerySnippet]]
   [metabase.models.pulse :refer [Pulse]]
   [metabase.models.pulse-card :refer [PulseCard]]
   [metabase.models.pulse-channel :refer [PulseChannel]]
   [metabase.models.segment :refer [Segment]]
   [metabase.models.setting :as setting]
   [metabase.models.table :refer [Table]]
   [metabase.models.user :as user :refer [User]]
   [metabase.shared.models.visualization-settings :as mb.viz]
   [metabase.util.date-2 :as u.date]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [metabase.util.yaml :as yaml]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)
(defn- slurp-dir
  [path]
  (doall
   (for [^java.io.File file (.listFiles ^java.io.File (io/file path))
         :when (-> file (.getName) (str/ends-with? ".yaml"))]
     (yaml/from-file file))))
(defn- slurp-many
  [paths]
  (apply concat (map slurp-dir paths)))
(defn- list-dirs
  [path]
  (for [^java.io.File file (.listFiles ^java.io.File (io/file path))
        :when (.isDirectory file)]
    (.getPath file)))
(defn- source-table
  [source-table]
  (if (and (string? source-table) (str/starts-with? source-table "card__"))
    source-table
    (let [{:keys [card table]} (fully-qualified-name->context source-table)]
      (if card
        (str "card__" card)
        table))))

Returns true if the given nm is either a fully qualified table name OR fully qualified card name.

(defn- fq-table-or-card?
  [nm]
  (or (names/fully-qualified-table-name? nm) (names/fully-qualified-card-name? nm)))
(defn- update-capture-missing*
  [m ks resolve-fn get-fn update-fn]
  (let [orig-v (get-fn m ks)
        res    (update-fn m ks resolve-fn)
        new-v  (get-fn res ks)]
    (if (and (some? orig-v) (nil? new-v))
      (update res ::unresolved-names #(assoc % orig-v ks))
      res)))
(defn- update-in-capture-missing
  [m ks resolve-fn]
  (update-capture-missing* m ks resolve-fn get-in update-in))
(defn- update-existing-in-capture-missing
  [m ks resolve-fn]
  (update-capture-missing* m ks resolve-fn get-in m/update-existing-in))
(defn- update-existing-capture-missing
  [m k resolve-fn]
  (update-capture-missing* m [k] resolve-fn get-in m/update-existing-in))

Assocs the given value v to the given key sequence ks in the given map m. If the given v contains any ::unresolved-names, these are "pulled into" m directly by prepending ks to their existing paths and dissocing them from v.

(defn- pull-unresolved-names-up
  ([m ks]
   (pull-unresolved-names-up m ks (get-in m ks)))
  ([m ks v]
   (if-let [unresolved-names (::unresolved-names v)]
     (-> (update m ::unresolved-names (fn [nms] (merge nms (m/map-vals #(vec (concat ks %)) unresolved-names))))
         (assoc-in ks (dissoc v ::unresolved-names)))
     (assoc-in m ks v))))

Finds all paths to a particular key anywhere in the structure m (recursively). m must be a map, but values inside can also be vectors (in which case, the index will be used as the key).

Adapted from: https://dnaeon.github.io/clojure-map-ks-paths/

(defn- paths-to-key-in
  [m match-key]
  (letfn [(children [node]
            (let [v (get-in m node)]
              (cond
                (map? v)
                (map (fn [x] (conj node x)) (keys v))
                (vector? v)
                (map (fn [x] (conj node x)) (range (count v)))
                :else
                [])))
          (branch? [node] (-> (children node) seq boolean))]
    (->> (keys m)
         (map vector)
         (mapcat #(tree-seq branch? children %))
         (filter #(= match-key (last %))))))

This is less efficient than calling pull-unresolved-names-up because it walks the entire tree, but is necessary when dealing with the full MBQL query tree (which can have arbitrary nesting of maps and vectors).

(defn- gather-all-unresolved-names
  [m]
  (let [paths (paths-to-key-in m ::unresolved-names)]
    (if-not (empty? paths)
      (reduce (fn [acc ks]
                (let [ks* (drop-last ks)]
                  (if-not (empty? ks*)
                    (pull-unresolved-names-up acc ks*)
                    acc)))
              m
              paths)
      m)))
(defn- mbql-fully-qualified-names->ids*
  [entity]
  (mbql.u/replace entity
    ;; handle legacy `:field-id` forms encoded prior to 0.39.0
    ;; and also *current* expresion forms used in parameter mapping dimensions
    ;; example relevant clause - [:dimension [:fk-> [:field-id 1] [:field-id 2]]]
    [:field-id (fully-qualified-name :guard string?)]
    (mbql-fully-qualified-names->ids* [:field fully-qualified-name nil])
    [:field (fully-qualified-name :guard names/fully-qualified-field-name?) opts]
    [:field (:field (fully-qualified-name->context fully-qualified-name)) (mbql-fully-qualified-names->ids* opts)]
    ;; source-field is also used within parameter mapping dimensions
    ;; example relevant clause - [:field 2 {:source-field 1}]
    {:source-field (fully-qualified-name :guard string?)}
    (assoc &match :source-field (:field (fully-qualified-name->context fully-qualified-name)))
    [:metric (fully-qualified-name :guard string?)]
    [:metric (:metric (fully-qualified-name->context fully-qualified-name))]
    [:segment (fully-qualified-name :guard string?)]
    [:segment (:segment (fully-qualified-name->context fully-qualified-name))]
    (_ :guard (every-pred map? #(fq-table-or-card? (:source-table %))))
    (-> (mbql-fully-qualified-names->ids* (dissoc &match :source-table)) ;; process other keys
        (assoc :source-table (:source-table &match))                     ;; add :source-table back in for lookup
        (update-existing-capture-missing :source-table source-table))))  ;; look up :source-table and capture missing

look up :source-table and capture missing

(defn- mbql-fully-qualified-names->ids
  [entity]
  (mbql-fully-qualified-names->ids* (mbql.normalize/normalize-tokens entity)))
(def ^:private ^{:arglists '([])} default-user-id
  (mdb.connection/memoize-for-application-db
   (fn []
     (let [user (t2/select-one-pk User :is_superuser true)]
       (assert user (trs "No admin users found! At least one admin user is needed to act as the owner for all the loaded entities."))
       user))))

Return the last path component (presumably a dir)

(defn- terminal-dir
  [path]
  (.getName (io/file path)))
(defn- unresolved-names->string
  ([model]
   (unresolved-names->string model nil))
  ([model insert-id]
   (str
    (when-let [nm (:name model)] (str "\ nm "\))
    (when insert-id (format " (inserted as ID %d) " insert-id))
    "missing:\n  "
    (str/join
     "\n  "
     (map
      (fn [[k v]]
        (format "at %s -> %s" (str/join "/" v) k))
      (::unresolved-names model))))))

Load an entity of type model stored at path in the context context.

Passing in parent entities as context instead of decoding them from the path each time, saves a lot of queriying.

(defmulti load!
  {:arglists '([path context])}
  (fn [path _context]
    (terminal-dir path)))
(defn- load-dimensions!
  [path context]
  (maybe-upsert-many! context Dimension
    (for [dimension (yaml/from-file (str path "/dimensions.yaml"))]
      (-> dimension
          (update :human_readable_field_id (comp :field fully-qualified-name->context))
          (update :field_id (comp :field fully-qualified-name->context))))))
(defmethod load! "databases"
  [path context]
  (doseq [path (list-dirs path)]
    ;; If we failed to load the DB no use in trying to load its tables
    (when-let [db (first (maybe-upsert-many! context Database (slurp-dir path)))]
      (doseq [inner-path (conj (list-dirs (str path "/schemas")) path)
              :let [context (merge context {:database db
                                            :schema   (when (not= inner-path path)
                                                        (terminal-dir path))})]]
        (load! (str inner-path "/tables") context)
        (load-dimensions! inner-path context)))))
(defmethod load! "tables"
  [path context]
  (let [paths     (list-dirs path)
        table-ids (maybe-upsert-many! context Table
                    (for [table (slurp-many paths)]
                      (assoc table :db_id (:database context))))]
    ;; First load fields ...
    (doseq [[path table-id] (map vector paths table-ids)
            :when table-id]
      (let [context (assoc context :table table-id)]
        (load! (str path "/fields") context)))
    ;; ... then everything else so we don't have issues with cross-table referencess
    (doseq [[path table-id] (map vector paths table-ids)
            :when table-id]
      (let [context (assoc context :table table-id)]
        (load! (str path "/fks") context)
        (load! (str path "/metrics") context)
        (load! (str path "/segments") context)))))
(def ^:private fully-qualified-name->card-id
  (comp :card fully-qualified-name->context))
(defn- load-fields!
  [path context]
  (let [fields       (slurp-dir path)
        field-values (map :values fields)
        field-ids    (maybe-upsert-many! context Field
                       (for [field fields]
                         (-> field
                             (update :parent_id (comp :field fully-qualified-name->context))
                             (update :last_analyzed u.date/parse)
                             (update :fk_target_field_id (comp :field fully-qualified-name->context))
                             (dissoc :values)
                             (assoc :table_id (:table context)))))]
    (maybe-upsert-many! context FieldValues
      (for [[field-value field-id] (map vector field-values field-ids)
            :when field-id]
        (assoc field-value :field_id field-id)))))
(defmethod load! "fields"
  [path context]
  (load-fields! path context))
(defmethod load! "fks"
  [path context]
  (load-fields! path context))
(defmethod load! "metrics"
  [path context]
  (maybe-upsert-many! context Metric
    (for [metric (slurp-dir path)]
      (-> metric
          (assoc :table_id   (:table context)
                 :creator_id (default-user-id))
          (assoc-in [:definition :source-table] (:table context))
          (update :definition mbql-fully-qualified-names->ids)))))
(defmethod load! "segments"
  [path context]
  (maybe-upsert-many! context Segment
    (for [metric (slurp-dir path)]
      (-> metric
          (assoc :table_id   (:table context)
                 :creator_id (default-user-id))
          (assoc-in [:definition :source-table] (:table context))
          (update :definition mbql-fully-qualified-names->ids)))))
(defn- update-card-parameter-mappings
  [parameter-mappings]
  (for [parameter-mapping parameter-mappings]
    (-> parameter-mapping
        (update-existing-capture-missing :card_id fully-qualified-name->card-id)
        (update-existing-capture-missing :target mbql-fully-qualified-names->ids))))
(defn- resolve-column-settings-key
  [col-key]
  (if-let [field-name (::mb.viz/field-str col-key)]
    (let [field-id ((comp :field fully-qualified-name->context) field-name)]
      (if (nil? field-id)
        {::unresolved-names {field-name [::column-settings-key]}}
        {::mb.viz/field-id field-id}))
    col-key))
(defn- resolve-param-mapping-key [k]
  (mbql-fully-qualified-names->ids k))
(defn- resolve-dimension [dimension]
  (mbql-fully-qualified-names->ids dimension))
(defn- resolve-param-ref [param-ref]
  (cond-> param-ref
    (= "dimension" (::mb.viz/param-ref-type param-ref))
    (-> ; from outer cond->
        (m/update-existing ::mb.viz/param-ref-id mbql-fully-qualified-names->ids)
        (m/update-existing ::mb.viz/param-dimension resolve-dimension))))
(defn- resolve-param-mapping-val [v]
  (-> v
      (m/update-existing ::mb.viz/param-mapping-id mbql-fully-qualified-names->ids)
      (m/update-existing ::mb.viz/param-mapping-source resolve-param-ref)
      (m/update-existing ::mb.viz/param-mapping-target resolve-param-ref)))
(defn- resolve-click-behavior-parameter-mapping [parameter-mapping]
  (->> parameter-mapping
       mb.viz/db->norm-param-mapping
       (reduce-kv (fn [acc k v]
                    (assoc acc (resolve-param-mapping-key k)
                               (resolve-param-mapping-val v))) {})
       mb.viz/norm->db-param-mapping))
(defn- resolve-click-behavior
  [click-behavior]
  (-> (if-let [link-type (::mb.viz/link-type click-behavior)]
        (case link-type
          ::mb.viz/card (let [card-id (::mb.viz/link-target-id click-behavior)]
                          (when (string? card-id)
                            (update-existing-in-capture-missing
                             click-behavior
                             [::mb.viz/link-target-id]
                             (comp :card fully-qualified-name->context))))
          ::mb.viz/dashboard (let [dashboard-id (::mb.viz/link-target-id click-behavior)]
                               (when (string? dashboard-id)
                                 (update-existing-in-capture-missing
                                  click-behavior
                                  [::mb.viz/link-target-id]
                                  (comp :dashboard fully-qualified-name->context))))
          click-behavior)
        click-behavior)
      (m/update-existing ::mb.viz/parameter-mapping resolve-click-behavior-parameter-mapping)))
(defn- update-col-settings-click-behavior [col-settings-value]
  (let [new-cb (resolve-click-behavior (::mb.viz/click-behavior col-settings-value))]
    (pull-unresolved-names-up col-settings-value [::mb.viz/click-behavior] new-cb)))
(defn- resolve-column-settings-value
  [col-value]
  (cond-> col-value
    (::mb.viz/click-behavior col-value) update-col-settings-click-behavior))
(defn- accumulate-converted-column-settings
  [acc col-key v]
  (let [new-key (resolve-column-settings-key col-key)
        new-val (resolve-column-settings-value v)]
    (-> (pull-unresolved-names-up acc [::column-settings-key] new-key)
        (dissoc ::column-settings-key)
        (pull-unresolved-names-up [new-key] new-val))))
(defn- resolve-top-level-click-behavior [vs-norm]
  (if-let [click-behavior (::mb.viz/click-behavior vs-norm)]
    (let [resolved-cb (resolve-click-behavior click-behavior)]
      (pull-unresolved-names-up vs-norm [::mb.viz/click-behavior] resolved-cb))
    vs-norm))

Resolve the entries in a :columnsettings map (which is under a :visualizationsettings map). These map entries may contain fully qualified field names, or even other cards. In case of an unresolved name (i.e. a card that hasn't yet been loaded), we will track it under ::unresolved-names and revisit on the next pass.

(defn- resolve-column-settings
  [vs-norm]
  (if-let [col-settings (::mb.viz/column-settings vs-norm)]
    (let [resolved-cs (reduce-kv accumulate-converted-column-settings {} col-settings)]
      (pull-unresolved-names-up vs-norm [::mb.viz/column-settings] resolved-cs))
    vs-norm))
(defn- resolve-table-column-field-ref [[f-type f-str f-md]]
  (if (names/fully-qualified-field-name? f-str)
    [f-type ((comp :field fully-qualified-name->context) f-str) f-md]
    [f-type f-str f-md]))

Resolve the entries in a :pivottable.columnsplit map (which is under a :visualization_settings map). These map entries may contain fully qualified field names, or even other cards. In case of an unresolved name (i.e. a card that hasn't yet been loaded), we will track it under ::unresolved-names and revisit on the next pass.

(defn- resolve-pivot-table-settings
  [vs-norm]
  (if (:pivot_table.column_split vs-norm)
    (letfn [(resolve-vec [pivot vec-type]
              (update-in pivot [:pivot_table.column_split vec-type] (fn [tbl-vecs]
                                                                      (mapv resolve-table-column-field-ref tbl-vecs))))]
      (-> vs-norm
          (resolve-vec :rows)
          (resolve-vec :columns)))
    vs-norm))

Resolve the :table.columns key from a :visualization_settings map, which may contain fully qualified field names. Such fully qualified names will be converted to the numeric field ID before being filled into the loaded card. Only other field names (not cards, or other collection based entity types) should be referenced here, so there is no need to detect or track ::unresolved-names.

(defn- resolve-table-columns
  [vs-norm]
  (if (::mb.viz/table-columns vs-norm)
    (letfn [(resolve-field-id [tbl-col]
              (update tbl-col ::mb.viz/table-column-field-ref resolve-table-column-field-ref))]
      (update vs-norm ::mb.viz/table-columns (fn [tbl-cols]
                                               (mapv resolve-field-id tbl-cols))))
    vs-norm))

Resolve all references from a :visualization_settings map, the various submaps of which may contain: - fully qualified field names - fully qualified card or dashboard names

Any unresolved entities from this resolution process will be tracked via ::unresolved-named so that the card or dashboard card holding these visualization settings can be revisited in a future pass.

(defn- resolve-visualization-settings
  [entity]
  (if-let [viz-settings (:visualization_settings entity)]
    (let [resolved-vs (-> (mb.viz/db->norm viz-settings)
                          resolve-top-level-click-behavior
                          resolve-column-settings
                          resolve-table-columns
                          resolve-pivot-table-settings
                          mb.viz/norm->db)]
      (pull-unresolved-names-up entity [:visualization_settings] resolved-vs))
    entity))
(defn- resolve-dashboard-parameters
  [parameters]
  (for [p parameters]
    ;; Note: not using the full ::unresolved-names functionality here because this is a fix
    ;; for a deprecated feature
    (m/update-existing-in p [:values_source_config :card_id] fully-qualified-name->card-id)))

Loads dashboards (which is a sequence of maps parsed from a YAML dump of dashboards) in a given context.

(defn load-dashboards!
  {:added "0.40.0"}
  [context dashboards]
  (let [dashboard-ids   (maybe-upsert-many! context Dashboard
                                            (for [dashboard dashboards]
                                              (-> dashboard
                                                  (update :parameters resolve-dashboard-parameters)
                                                  (dissoc :dashboard_cards)
                                                  (assoc :collection_id (:collection context)
                                                         :creator_id    (default-user-id)))))
        ;; MEGA HACK -- if `load` is ran with `--mode update` we should delete any Cards that were removed from a
        ;; Dashboard (according to #20786). However there are literally zero facilities for doing this sort of thing in
        ;; the current dump/load codebase. So for now we'll just delete ALL DashboardCards for the dumped Dashboard when
        ;; running with `--mode update` and recreate them from the serialized definitions. This is definitely a wack way
        ;; of doing things but no one actually understands how this code is supposed to work so this will have to do
        ;; until we can come in here and clean things up. -- Cam 2022-03-24
        _               (when (and (= (:mode context) :update)
                                   (seq dashboard-ids))
                          (t2/delete! DashboardCard :dashboard_id [:in (set dashboard-ids)]))
        dashboard-cards (map :dashboard_cards dashboards)
        ;; a function that prepares a dash card for insertion, while also validating to ensure the underlying
        ;; card_id could be resolved from the fully qualified name
        prepare-card-fn (fn [dash-idx dashboard-id acc card-idx card]
                          (let [proc-card  (-> card
                                               (update-existing-capture-missing :card_id fully-qualified-name->card-id)
                                               (assoc :dashboard_id dashboard-id))
                                new-pm     (update-card-parameter-mappings (:parameter_mappings proc-card))
                                with-pm    (pull-unresolved-names-up proc-card [:parameter_mappings] new-pm)
                                with-viz   (resolve-visualization-settings with-pm)]
                            (if-let [unresolved (::unresolved-names with-viz)]
                              ;; prepend the dashboard card index and :visualization_settings to each unresolved
                              ;; name path for better debugging
                              (let [add-keys         [:dashboard_cards card-idx :visualization_settings]
                                    fixed-names      (m/map-vals #(concat add-keys %) unresolved)
                                    with-fixed-names (assoc with-viz ::unresolved-names fixed-names)]
                                (-> acc
                                    (update ::revisit (fn [revisit-map]
                                                        (update revisit-map dash-idx #(cons with-fixed-names %))))
                                    ;; index means something different here than in the Card case (it's actually the index
                                    ;; of the dashboard)
                                    (update ::revisit-index #(conj % dash-idx))))
                              (update acc ::process #(conj % with-viz)))))
        prep-init-acc   {::process [] ::revisit-index #{} ::revisit {}}
        filtered-cards  (reduce-kv
                         (fn [acc idx [cards dash-id]]
                           (if dash-id
                             (let [res (reduce-kv (partial prepare-card-fn idx dash-id) prep-init-acc (vec cards))]
                               (merge-with concat acc res))
                             acc))
                         prep-init-acc
                         (mapv vector dashboard-cards dashboard-ids))
        revisit-indexes (vec (::revisit-index filtered-cards))
        proceed-cards   (vec (::process filtered-cards))
        dashcard-ids    (maybe-upsert-many! context DashboardCard (map #(dissoc % :series) proceed-cards))
        series-pairs    (map vector (map :series proceed-cards) dashcard-ids)]
    (maybe-upsert-many! context DashboardCardSeries
                        (for [[series dashboard-card-id] series-pairs
                              dashboard-card-series      series
                              :when (and dashboard-card-series dashboard-card-id)]
                          (-> dashboard-card-series
                              (assoc :dashboardcard_id dashboard-card-id)
                              (update :card_id fully-qualified-name->card-id))))
    (let [revisit-dashboards (map (partial nth dashboards) revisit-indexes)]
      (when (seq revisit-dashboards)
        (let [revisit-map    (::revisit filtered-cards)
              revisit-inf-fn (fn [[dash-idx dashcards]]
                               (format
                                "For dashboard %s:%n%s"
                                (->> dash-idx (nth dashboards) :name)
                                (str/join "\n" (map unresolved-names->string dashcards))))]
          (log/infof
           "Unresolved references found for dashboard cards in collection %d; will reload after first pass%n%s%n"
           (:collection context)
           (str/join "\n" (map revisit-inf-fn revisit-map)))
          (fn []
            (log/infof
             "Retrying dashboards for collection %s: %s"
             (or (:collection context) "root")
             (str/join ", " (map :name revisit-dashboards)))
            (load-dashboards! (assoc context :mode :update) revisit-dashboards)))))))
(defmethod load! "dashboards"
  [path context]
  (binding [names/*suppress-log-name-lookup-exception* true]
    (load-dashboards! context (slurp-dir path))))
(defn- load-pulses! [pulses context]
  (let [cards       (map :cards pulses)
        channels    (map :channels pulses)
        pulse-ids   (maybe-upsert-many! context Pulse
                      (for [pulse pulses]
                        (-> pulse
                            (assoc :collection_id (:collection context)
                                   :creator_id    (default-user-id))
                            (dissoc :channels :cards))))
        pulse-cards (for [[cards pulse-id pulse-idx] (map vector cards pulse-ids (range 0 (count pulse-ids)))
                          card             cards
                          :when pulse-id]
                      (-> card
                          (assoc :pulse_id pulse-id)
                          ;; gather the pulse's name and index for easier bookkeeping later
                          (assoc ::pulse-index pulse-idx)
                          (assoc ::pulse-name (:name (nth pulses pulse-idx)))
                          (update-in-capture-missing [:card_id] fully-qualified-name->card-id)))
        grouped     (group-by #(empty? (::unresolved-names %)) pulse-cards)
        process     (get grouped true)
        revisit     (get grouped false)]
    (maybe-upsert-many! context PulseCard (map #(dissoc % ::pulse-index ::pulse-name) process))
    (maybe-upsert-many! context PulseChannel
      (for [[channels pulse-id] (map vector channels pulse-ids)
            channel             channels
            :when pulse-id]
        (assoc channel :pulse_id pulse-id)))
    (when (seq revisit)
      (let [revisit-info-map (group-by ::pulse-name revisit)]
        (log/infof "Unresolved references for pulses in collection %s; will reload after first pass complete:%n%s%n"
                   (or (:collection context) "root")
                   (str/join "\n" (map
                                   (fn [[pulse-name revisit-cards]]
                                     (format " for %s:%n%s"
                                           pulse-name
                                           (str/join "\n" (map (comp unresolved-names->string #(into {} %)) revisit-cards))))
                                   revisit-info-map)))
        (fn []
          (log/infof "Reloading pulses from collection %d" (:collection context))
          (let [pulse-indexes (map ::pulse-index revisit)]
            (load-pulses! (map (partial nth pulses) pulse-indexes) (assoc context :mode :update))))))))
(defmethod load! "pulses"
  [path context]
  (binding [names/*suppress-log-name-lookup-exception* true]
    (load-pulses! (slurp-dir path) context)))
(defn- resolve-source-query [query]
  (if (:source-query query)
    (update-in-capture-missing query [:source-query] resolve-source-query)
    query))
(defn- source-card
  [fully-qualified-name]
  (try
    (-> (fully-qualified-name->context fully-qualified-name) :card)
    (catch Throwable e
      (log/warn e (trs "Could not find context for fully qualified card name {0}" fully-qualified-name)))))
(defn- resolve-snippet
  [fully-qualified-name]
  (try
    (-> (fully-qualified-name->context fully-qualified-name) :snippet)
    (catch Throwable e
      (log/debug e (trs "Could not find context for fully qualified snippet name {0}" fully-qualified-name)))))
(defn- resolve-native
  [card]
  (let [ks                [:dataset_query :native :template-tags]
        template-tags     (get-in card ks)
        new-template-tags (reduce-kv
                           (fn [m k v]
                             (let [new-v (-> (update-existing-capture-missing v :card-id source-card)
                                             (update-existing-capture-missing :snippet-id resolve-snippet))]
                               (pull-unresolved-names-up m [k] new-v)))
                           {}
                           template-tags)]
    (pull-unresolved-names-up card ks new-template-tags)))
(defn- resolve-card-dataset-query [card]
  (let [ks    [:dataset_query :query]
        new-q (update-in-capture-missing card ks resolve-source-query)]
    (-> (pull-unresolved-names-up card ks (get-in new-q ks))
        (gather-all-unresolved-names))))
(defn- resolve-card [card context]
  (-> card
      (update :table_id (comp :table fully-qualified-name->context))
      (update :database_id (comp :database fully-qualified-name->context))
      (update :dataset_query mbql-fully-qualified-names->ids)
      (assoc :creator_id    (default-user-id)
             :collection_id (:collection context))
      (update-in [:dataset_query :database] (comp :database fully-qualified-name->context))
      resolve-visualization-settings
      (cond->
          (-> card
              :dataset_query
              :type
              mbql.u/normalize-token
              (= :query)) resolve-card-dataset-query
          (-> card
              :dataset_query
              :native
              :template-tags
              not-empty) (resolve-native))))

Make a dummy card for first pass insertion

(defn- make-dummy-card
  [card]
  (-> card
      (assoc :dataset_query {:type     :native
                             :native   {:query "-- DUMMY QUERY FOR SERIALIZATION FIRST PASS INSERT"}
                             :database (:database_id card)})
      (dissoc ::unresolved-names)))

Loads cards in a given context, from a given sequence of paths (strings). If specified, then only-cards (maps having the structure of cards loaded from YAML dumps) will be used instead of loading data from paths (to serve as a retry mechanism).

(defn load-cards!
  {:added "0.40.0"}
  [context paths only-cards]
  (let [cards              (or only-cards (slurp-many paths))
        resolved-cards     (for [card cards]
                             (resolve-card card context))
        grouped-cards      (reduce-kv
                            (fn [acc idx card]
                              (if (::unresolved-names card)
                                (-> acc
                                    (update ::revisit #(conj % card))
                                    (update ::revisit-index #(conj % idx)))
                                (update acc ::process #(conj % card))))
                            {::revisit [] ::revisit-index #{} ::process []}
                            (vec resolved-cards))
        dummy-insert-cards (not-empty (::revisit grouped-cards))
        process-cards      (::process grouped-cards)]
    (maybe-upsert-many! context Card process-cards)
    (when dummy-insert-cards
      (let [dummy-inserted-ids (maybe-upsert-many!
                                context
                                Card
                                (map make-dummy-card dummy-insert-cards))
            id-and-cards       (map vector dummy-insert-cards dummy-inserted-ids)
            retry-info-fn      (fn [[card card-id]]
                                 (unresolved-names->string card card-id))]
        (log/infof
         "Unresolved references found for cards in collection %d; will reload after first pass%n%s%n"
         (:collection context)
         (str/join "\n" (map retry-info-fn id-and-cards)))
        (fn []
          (log/infof "Attempting to reload cards in collection %d" (:collection context))
          (let [revisit-indexes (::revisit-index grouped-cards)]
            (load-cards! (assoc context :mode :update) paths (mapv (partial nth cards) revisit-indexes))))))))
(defmethod load! "cards"
  [path context]
  (binding [names/*suppress-log-name-lookup-exception* true]
    (load-cards! context (list-dirs path) nil)))

A function called on each User instance before it is inserted (via upsert).

(defn- pre-insert-user
  [user]
  (log/infof "User with email %s is new to target DB; setting a random password" (:email user))
  (assoc user :password (str (random-uuid))))

leaving comment out for now (deliberately), because this will send a password reset email to newly inserted users when enabled in a future release; see defmethod load "users" below

#_(defn- post-insert-user
    "A function called on the ID of each `User` instance after it is inserted (via upsert)."
    [user-id]
    (when-let [{email :email, google-auth? :google_auth, is-active? :is_active}
               (t2/select-one [User :email :google_auth :is_active] :id user-id)]
      (let [reset-token        (user/set-password-reset-token! user-id)
            site-url           (public-settings/site-url)
            password-reset-url (str site-url "/auth/reset_password/" reset-token)
            ;; in a web server context, the server-name ultimately comes from ServletRequest/getServerName
            ;; (i.e. the Java class, via Ring); this is the closest approximation in our batch context
            server-name        (.getHost (URL. site-url))]
        (let [email-res (email/send-password-reset-email! email google-auth? server-name password-reset-url is-active?)]
          (if (:error email-res)
            (log/infof "Failed to send password reset email generated for user ID %d (%s): %s"
                       user-id
                       email
                       (:message email-res))
            (log/infof "Password reset email generated for user ID %d (%s)" user-id email)))
        user-id)))

(defmethod load! "users"
  [path context]
  ;; Currently we only serialize the new owner user, so it's fine to ignore mode setting
  ;; add :post-insert-fn post-insert-user back to start sending password reset emails
  (maybe-upsert-many! (assoc context :pre-insert-fn pre-insert-user) User
    (for [user (slurp-dir path)]
      (dissoc user :password))))
(defn- derive-location
  [context]
  (if-let [parent-id (:collection context)]
    (str (t2/select-one-fn :location Collection :id parent-id) parent-id "/")
    "/"))
(defn- make-reload-fn [all-results]
  (let [all-fns (filter fn? all-results)]
    (when (seq all-fns)
      (let [new-fns (doall all-fns)]
        (fn []
          (make-reload-fn (for [reload-fn new-fns]
                            (reload-fn))))))))
(defn- load-collections!
  [path context]
  (let [subdirs      (list-dirs path)
        by-ns        (group-by #(let [[_ coll-ns] (re-matches #".*/:([^:/]+)" %)]
                                  coll-ns)
                               subdirs)
        grouped      (group-by (comp nil? first) by-ns)
        ns-paths     (get grouped false)
        entity-paths (->> (get grouped true)
                          (map last)
                          first)
        results      (for [path entity-paths]
                       (let [context (assoc context
                                       :collection (->> (slurp-dir path)
                                                        (map #(assoc % :location  (derive-location context)
                                                                       :namespace (-> context
                                                                                      :collection-namespace)))
                                                        (maybe-upsert-many! context Collection)
                                                        first))]
                         (log/infof "Processing collection at path %s" path)
                         [(load! (str path "/collections") context)
                          (load! (str path "/cards") context)
                          (load! (str path "/pulses") context)
                          (load! (str path "/dashboards") context)
                          (load! (str path "/snippets") context)]))
        load-ns-fns  (for [[coll-ns [coll-ns-path]] ns-paths]
                       (do (log/infof "Loading %s namespace for collection at path %s" coll-ns coll-ns-path)
                           (load-collections! coll-ns-path (assoc context :collection-namespace coll-ns))))]
    (make-reload-fn (concat (apply concat results) ; these are each sequences, so need to flatten those first
                            load-ns-fns))))
(defmethod load! "collections"
  [path context]
  (load-collections! path context))
(defn- prepare-snippet [context snippet]
  (assoc snippet :creator_id    (default-user-id)
                 :collection_id (:collection context)))
(defmethod load! "snippets"
  [path context]
  (let [paths       (list-dirs path)
        snippets    (map (partial prepare-snippet context) (slurp-many paths))]
    (maybe-upsert-many! context NativeQuerySnippet snippets)))

Load a dump of settings.

(defn load-settings!
  [path context]
  (doseq [[k v] (yaml/from-file (str path "/settings.yaml"))
          :when (or (= context :update)
                    (nil? (setting/get-value-of-type :string k)))]
    (setting/set-value-of-type! :string k v)))

Is dump at path path compatible with the currently running version of Metabase?

(defn compatible?
  [path]
  (-> (str path "/manifest.yaml")
      yaml/from-file
      :metabase-version
      (= config/mb-version-info)))
 

Consistent instance-independent naming scheme that replaces IDs with human-readable paths.

(ns metabase-enterprise.serialization.names
  (:require
   [clojure.string :as str]
   [malli.core :as mc]
   [metabase.db.connection :as mdb.connection]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.models.card :refer [Card]]
   [metabase.models.collection :refer [Collection]]
   [metabase.models.dashboard :refer [Dashboard]]
   [metabase.models.database :as database :refer [Database]]
   [metabase.models.field :refer [Field]]
   [metabase.models.interface :as mi]
   [metabase.models.metric :refer [Metric]]
   [metabase.models.native-query-snippet :refer [NativeQuerySnippet]]
   [metabase.models.pulse :refer [Pulse]]
   [metabase.models.segment :refer [Segment]]
   [metabase.models.table :refer [Table]]
   [metabase.models.user :refer [User]]
   [metabase.util.i18n :as i18n :refer [trs]]
   [metabase.util.log :as log]
   [metabase.util.malli.schema :as ms]
   [ring.util.codec :as codec]
   [toucan2.core :as t2]
   [toucan2.protocols :as t2.protocols]))
(set! *warn-on-reflection* true)
(def ^:private root-collection-path "/collections/root")

Return entity name URL encoded except that spaces are retained.

(defn safe-name
  [entity]
  (some-> entity ((some-fn :email :name)) codec/url-encode (str/replace "%20" " ")))

Inverse of safe-name.

(def unescape-name
  codec/url-decode)
(defmulti ^:private fully-qualified-name* mi/model)

Get the logical path for entity entity.

(def ^{:arglists '([entity] [model id])} fully-qualified-name
  (mdb.connection/memoize-for-application-db
   (fn
     ([entity] (fully-qualified-name* entity))
     ([model id]
      (if (string? id)
        id
        (fully-qualified-name* (t2/select-one model :id id)))))))
(defmethod fully-qualified-name* Database
  [db]
  (str "/databases/" (safe-name db)))
(defmethod fully-qualified-name* Table
  [table]
  (if (:schema table)
    (format "%s/schemas/%s/tables/%s"
            (->> table :db_id (fully-qualified-name Database))
            (:schema table)
            (safe-name table))
    (format "%s/tables/%s"
            (->> table :db_id (fully-qualified-name Database))
            (safe-name table))))
(defmethod fully-qualified-name* Field
  [field]
  (if (:fk_target_field_id field)
    (str (->> field :table_id (fully-qualified-name Table)) "/fks/" (safe-name field))
    (str (->> field :table_id (fully-qualified-name Table)) "/fields/" (safe-name field))))
(defmethod fully-qualified-name* Metric
  [metric]
  (str (->> metric :table_id (fully-qualified-name Table)) "/metrics/" (safe-name metric)))
(defmethod fully-qualified-name* Segment
  [segment]
  (str (->> segment :table_id (fully-qualified-name Table)) "/segments/" (safe-name segment)))
(defn- local-collection-name [collection]
  (let [ns-part (when-let [coll-ns (:namespace collection)]
                  (str ":" (if (keyword? coll-ns) (name coll-ns) coll-ns) "/"))]
    (str "/collections/" ns-part (safe-name collection))))
(defmethod fully-qualified-name* Collection
  [collection]
  (let [parents (some->> (str/split (:location collection) #"/")
                         rest
                         not-empty
                         (map #(local-collection-name (t2/select-one Collection :id (Integer/parseInt %))))
                         (apply str))]
    (str root-collection-path parents (local-collection-name collection))))
(defmethod fully-qualified-name* Dashboard
  [dashboard]
  (format "%s/dashboards/%s"
          (or (some->> dashboard :collection_id (fully-qualified-name Collection))
              root-collection-path)
          (safe-name dashboard)))
(defmethod fully-qualified-name* Pulse
  [pulse]
  (format "%s/pulses/%s"
          (or (some->> pulse :collection_id (fully-qualified-name Collection))
              root-collection-path)
          (safe-name pulse)))
(defmethod fully-qualified-name* Card
  [card]
  (format "%s/cards/%s"
          (or (some->> card
                       :collection_id
                       (fully-qualified-name Collection))
              root-collection-path)
          (safe-name card)))
(defmethod fully-qualified-name* User
  [user]
  (str "/users/" (:email user)))
(defmethod fully-qualified-name* NativeQuerySnippet
  [snippet]
  (format "%s/snippets/%s"
          (or (some->> snippet :collection_id (fully-qualified-name Collection))
              root-collection-path)
          (safe-name snippet)))
(defmethod fully-qualified-name* nil
  [_]
  nil)

All the references in the dumps should resolved to entities already loaded.

(def ^:private Context
  [:map {:closed true}
   [:database   {:optional true} ms/PositiveInt]
   [:table      {:optional true} ms/PositiveInt]
   [:schema     {:optional true} [:maybe :string]]
   [:field      {:optional true} ms/PositiveInt]
   [:metric     {:optional true} ms/PositiveInt]
   [:segment    {:optional true} ms/PositiveInt]
   [:card       {:optional true} ms/PositiveInt]
   [:dashboard  {:optional true} ms/PositiveInt]
   [:collection {:optional true} [:maybe ms/PositiveInt]] ; root collection
   [:pulse      {:optional true} ms/PositiveInt]
   [:user       {:optional true} ms/PositiveInt]
   [:snippet    {:optional true} [:maybe ms/PositiveInt]]])
(defmulti ^:private path->context* (fn [_ model _ _]
                                     model))

Extract entities from a logical path.

(def ^:private ^{:arglists '([context model model-attrs entity-name])} path->context
   path->context*)
(defmethod path->context* "databases"
  [context _ _ db-name]
  (assoc context :database (if (= db-name "__virtual")
                             lib.schema.id/saved-questions-virtual-database-id
                             (t2/select-one-pk Database :name db-name))))
(defmethod path->context* "schemas"
  [context _ _ schema]
  (assoc context :schema schema))
(defmethod path->context* "tables"
  [context _ _ table-name]
  (assoc context :table (t2/select-one-pk Table
                          :db_id  (:database context)
                          :schema (:schema context)
                          :name   table-name)))
(defmethod path->context* "fields"
  [context _ _ field-name]
  (assoc context :field (t2/select-one-pk Field
                          :table_id (:table context)
                          :name     field-name)))
(defmethod path->context* "fks"
  [context _ _ field-name]
  (path->context* context "fields" nil field-name))
(defmethod path->context* "metrics"
  [context _ _ metric-name]
  (assoc context :metric (t2/select-one-pk Metric
                           :table_id (:table context)
                           :name     metric-name)))
(defmethod path->context* "segments"
  [context _ _ segment-name]
  (assoc context :segment (t2/select-one-pk Segment
                            :table_id (:table context)
                            :name     segment-name)))
(defmethod path->context* "collections"
  [context _ model-attrs collection-name]
  (if (= collection-name "root")
    (assoc context :collection nil)
    (assoc context :collection (t2/select-one-pk Collection
                                 :name      collection-name
                                 :namespace (:namespace model-attrs)
                                 :location  (or (letfn [(collection-location [id]
                                                          (t2/select-one-fn :location Collection :id id))]
                                                  (some-> context
                                                          :collection
                                                          collection-location
                                                          (str (:collection context) "/")))
                                                "/")))))
(defmethod path->context* "dashboards"
  [context _ _ dashboard-name]
  (assoc context :dashboard (t2/select-one-pk Dashboard
                              :collection_id (:collection context)
                              :name          dashboard-name)))
(defmethod path->context* "pulses"
  [context _ _ pulse-name]
  (assoc context :dashboard (t2/select-one-pk Pulse
                              :collection_id (:collection context)
                              :name          pulse-name)))
(defmethod path->context* "cards"
  [context _ _ dashboard-name]
  (assoc context :card (t2/select-one-pk Card
                         :collection_id (:collection context)
                         :name          dashboard-name)))
(defmethod path->context* "users"
  [context _ _ email]
  (assoc context :user (t2/select-one-pk User
                         :email email)))
(defmethod path->context* "snippets"
  [context _ _ snippet-name]
  (assoc context :snippet (t2/select-one-pk NativeQuerySnippet
                                            :collection_id (:collection context)
                                            :name          snippet-name)))
(def ^:private separator-pattern #"\/")

Dynamic boolean var that controls whether warning messages will NOT be logged on a failed name lookup (from within fully-qualified-name->context). Intended to be bound differently in first pass (i.e. set to true), where we expect some name lookups to fail, in order to avoid polluting the log. On subsequent rounds (i.e. reload fns) then it should be left off because we wouldn't expect to have failed lookups then.

(def ^:dynamic *suppress-log-name-lookup-exception*
  false)

Returns true if the given field-name is a fully-qualified field name for serialization purposes (as opposed to a reference to an in-query alias or some other form).

(defn fully-qualified-field-name?
  [field-name]
  (and (some? field-name)
       (str/starts-with? field-name "/databases/")
       (or (str/includes? field-name "/fks/") (str/includes? field-name "/fields/"))))

Returns true if the given table-name is a fully-qualified table name for serialization purposes (as opposed to a reference to a card).

(defn fully-qualified-table-name?
  [table-name]
  (and (some? table-name)
       (string? table-name)
       (str/starts-with? table-name "/databases/")
       (not (str/starts-with? table-name "card__"))))

Returns true if the given card-name is a fully-qualified card name for serialization purposes.

(defn fully-qualified-card-name?
  [card-name]
  (and (some? card-name)
       (string? card-name)
       (str/starts-with? card-name "/collections/root/")
       (str/includes? card-name "/cards/")))

WARNING: THIS MUST APPEAR AFTER ALL path->context* IMPLEMENTATIONS

(def ^:private all-entities (-> path->context*
                                methods
                                keys
                                set))

This is more complicated than it needs to be due to potential clashes between an entity name (ex: a table called "users" and a model name (ex: "users"). Could fix in a number of ways, including special prefix of model names, but that would require changing the format and updating all the defmethod calls.

(defn- partition-name-components
  ([name-comps]
   (partition-name-components {::name-components [] ::current-component []} name-comps))
  ([acc [c & more-comps]]
   (cond
     (nil? more-comps)
     (conj (::name-components acc) (conj (::current-component acc) c))
     (::prev-model-name? acc)
     (if (= \: (first c))
       (partition-name-components (update acc ::current-component conj c) more-comps)
       (partition-name-components (-> (assoc acc ::prev-model-name? false)
                                      (update ::current-component
                                              conj
                                              c))
                                  more-comps))
     (contains? all-entities c)
     (partition-name-components (cond-> (assoc acc ::prev-model-name? true
                                                   ::current-component [c])
                                  (not-empty (::current-component acc))
                                  (update ::name-components conj (::current-component acc)))
                                more-comps))))

Parse a logical path into a context map.

(defn fully-qualified-name->context
  [fully-qualified-name]
  (when fully-qualified-name
    (let [components (->> (str/split fully-qualified-name separator-pattern)
                          rest ; we start with a /
                          partition-name-components
                          (map (fn [[model-name & entity-parts]]
                                 (cond-> {::model-name model-name ::entity-name (last entity-parts)}
                                   (and (= "collections" model-name) (> (count entity-parts) 1))
                                   (assoc :namespace (->> entity-parts
                                                          first ; ns is first/only item after "collections"
                                                          rest  ; strip the starting :
                                                          (apply str)))))))
          context (loop [acc-context                   {}
                         [{::keys [model-name entity-name] :as model-map} & more] components]
                    (let [model-attrs (dissoc model-map ::model-name ::entity-name)
                          new-context (path->context acc-context model-name model-attrs (unescape-name entity-name))]
                      (if (empty? more)
                        new-context
                        (recur new-context more))))]
      (if (and
           (not (mc/validate [:maybe Context] context))
           (not *suppress-log-name-lookup-exception*))
        (log/warn
         (ex-info (trs "Can''t resolve {0} in fully qualified name {1}"
                       (str/join ", " (map name (keys context)))
                       fully-qualified-name)
                  {:fully-qualified-name fully-qualified-name
                   :resolve-name-failed? true
                   :context              context}))
        context))))

Return a string representation of entity suitable for logs

(defn name-for-logging
  ([entity] (name-for-logging (t2.protocols/model entity) entity))
  ([model {:keys [name id]}]
   (cond
     (and name id) (format "%s \"%s\" (ID %s)" model name id)
     name          (format "%s \"%s\"" model name)
     id            (format "%s %s" model id)
     :else         model)))
 

Transform entity into a form suitable for serialization.

(ns metabase-enterprise.serialization.serialize
  (:require
   [clojure.string :as str]
   [medley.core :as m]
   [metabase-enterprise.serialization.names :refer [fully-qualified-name]]
   [metabase.lib.schema.id :as lib.schema.id]
   [metabase.mbql.normalize :as mbql.normalize]
   [metabase.mbql.util :as mbql.u]
   [metabase.models.card :refer [Card]]
   [metabase.models.dashboard :refer [Dashboard]]
   [metabase.models.dashboard-card :refer [DashboardCard]]
   [metabase.models.dashboard-card-series :refer [DashboardCardSeries]]
   [metabase.models.database :as database :refer [Database]]
   [metabase.models.dimension :refer [Dimension]]
   [metabase.models.field :as field :refer [Field]]
   [metabase.models.interface :as mi]
   [metabase.models.metric :refer [Metric]]
   [metabase.models.native-query-snippet :refer [NativeQuerySnippet]]
   [metabase.models.pulse :refer [Pulse]]
   [metabase.models.pulse-card :refer [PulseCard]]
   [metabase.models.pulse-channel :refer [PulseChannel]]
   [metabase.models.segment :refer [Segment]]
   [metabase.models.table :refer [Table]]
   [metabase.models.user :refer [User]]
   [metabase.shared.models.visualization-settings :as mb.viz]
   [metabase.util :as u]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

Current serialization protocol version.

This gets stored with each dump, so we can correctly recover old dumps.

(def ^:const ^Long serialization-protocol-version
  ;; version 2 - start adding namespace portion to /collections/ paths
  2)

Is given form an MBQL entity reference?

(def ^:private ^{:arglists '([form])} mbql-entity-reference?
  (partial mbql.normalize/is-clause? #{:field :field-id :fk-> :metric :segment}))
(defn- mbql-id->fully-qualified-name
  [mbql]
  (-> mbql
      mbql.normalize/normalize-tokens
      (mbql.u/replace
        ;; `integer?` guard is here to make the operation idempotent
        [:field (id :guard integer?) opts]
        [:field (fully-qualified-name Field id) (mbql-id->fully-qualified-name opts)]
        ;; field-id is still used within parameter mapping dimensions
        ;; example relevant clause - [:dimension [:fk-> [:field-id 1] [:field-id 2]]]
        [:field-id (id :guard integer?)]
        [:field-id (fully-qualified-name Field id)]
        ;; source-field is also used within parameter mapping dimensions
        ;; example relevant clause - [:field 2 {:source-field 1}]
        {:source-field (id :guard integer?)}
        (assoc &match :source-field (fully-qualified-name Field id))
        [:metric (id :guard integer?)]
        [:metric (fully-qualified-name Metric id)]
        [:segment (id :guard integer?)]
        [:segment (fully-qualified-name Segment id)])))
(defn- ids->fully-qualified-names
  [entity]
  (mbql.u/replace entity
    mbql-entity-reference?
    (mbql-id->fully-qualified-name &match)
    map?
    (as-> &match entity
      (m/update-existing entity :database (fn [db-id]
                                            (if (= db-id lib.schema.id/saved-questions-virtual-database-id)
                                              "database/__virtual"
                                              (fully-qualified-name Database db-id))))
      (m/update-existing entity :card_id (partial fully-qualified-name Card)) ; attibutes that refer to db fields use _
      (m/update-existing entity :card-id (partial fully-qualified-name Card)) ; template-tags use dash
      (m/update-existing entity :source-table (fn [source-table]
                                                (if (and (string? source-table)
                                                         (str/starts-with? source-table "card__"))
                                                  (fully-qualified-name Card (-> source-table
                                                                                 (str/split #"__")
                                                                                 second
                                                                                 Integer/parseInt))
                                                  (fully-qualified-name Table source-table))))
      (m/update-existing entity :breakout (fn [breakout]
                                            (map mbql-id->fully-qualified-name breakout)))
      (m/update-existing entity :aggregation (fn [aggregation]
                                               (m/map-vals mbql-id->fully-qualified-name aggregation)))
      (m/update-existing entity :filter (fn [filter]
                                          (m/map-vals mbql-id->fully-qualified-name filter)))
      (m/update-existing entity ::mb.viz/param-mapping-source (partial fully-qualified-name Field))
      (m/update-existing entity :snippet-id (partial fully-qualified-name NativeQuerySnippet))
      (m/map-vals ids->fully-qualified-names entity))))

Removes unneeded fields that can either be reconstructed from context or are meaningless (eg. :created_at).

(defn- strip-crud
  [entity]
  (cond-> (dissoc entity :id :creator_id :created_at :updated_at :db_id :location
                  :dashboard_id :fields_hash :personal_owner_id :made_public_by_id :collection_id
                  :pulse_id :result_metadata :entity_id :action_id)
    (some #(instance? % entity) (map type [Metric Field Segment])) (dissoc :table_id)))
(defmulti ^:private serialize-one
  {:arglists '([instance])}
  mi/model)

Serialize entity entity.

(def ^{:arglists '([entity])} serialize
  (comp ids->fully-qualified-names strip-crud serialize-one))
(defmethod serialize-one :default
  [instance]
  instance)
(defmethod serialize-one Database
  [db]
  (dissoc db :features))
(defmethod serialize-one Field
  [field]
  (let [field (-> field
                  (update :parent_id (partial fully-qualified-name Field))
                  (update :fk_target_field_id (partial fully-qualified-name Field)))]
    (if (contains? field :values)
      (update field :values u/select-non-nil-keys [:values :human_readable_values])
      (assoc field :values (-> field
                               field/values
                               (u/select-non-nil-keys [:values :human_readable_values]))))))
(defn- convert-column-settings-key [k]
  (if-let [field-id (::mb.viz/field-id k)]
    (-> (t2/select-one Field :id field-id)
        fully-qualified-name
        mb.viz/field-str->column-ref)
    k))

The k is something like [:dimension [:fk-> [:field-id ] [:field-id

(defn- convert-param-mapping-key
  [k]
  (mbql-id->fully-qualified-name k))
(defn- convert-param-ref [new-id param-ref]
  (cond-> param-ref
    (= "dimension" (::mb.viz/param-ref-type param-ref)) ids->fully-qualified-names
    (some? new-id) (update ::mb.viz/param-ref-id new-id)))
(defn- convert-param-mapping-val [new-id v]
  (-> v
      (m/update-existing ::mb.viz/param-mapping-source (partial convert-param-ref new-id))
      (m/update-existing ::mb.viz/param-mapping-target (partial convert-param-ref new-id))
      (m/assoc-some ::mb.viz/param-mapping-id (or new-id (::mb.viz/param-mapping-id v)))))
(defn- convert-parameter-mapping [param-mapping]
  (if (nil? param-mapping)
    nil
    (reduce-kv (fn [acc k v]
                 (assoc acc (convert-param-mapping-key k)
                            (convert-param-mapping-val nil v))) {} param-mapping)))
(defn- convert-click-behavior [{:keys [::mb.viz/link-type ::mb.viz/link-target-id] :as click}]
  (-> (if-let [new-target-id (case link-type
                               ::mb.viz/card      (-> (t2/select-one Card :id link-target-id)
                                                      fully-qualified-name)
                               ::mb.viz/dashboard (-> (t2/select-one Dashboard :id link-target-id)
                                                      fully-qualified-name)
                               nil)]
        (assoc click ::mb.viz/link-target-id new-target-id)
        click)
      (m/update-existing ::mb.viz/parameter-mapping convert-parameter-mapping)))
(defn- convert-column-settings-value [{:keys [::mb.viz/click-behavior] :as v}]
  (cond (not-empty click-behavior) (assoc v ::mb.viz/click-behavior (convert-click-behavior click-behavior))
        :else v))
(defn- convert-column-settings [acc k v]
  (assoc acc (convert-column-settings-key k) (convert-column-settings-value v)))
(defn- convert-viz-settings [viz-settings]
  (-> (mb.viz/db->norm viz-settings)
      (m/update-existing ::mb.viz/column-settings (fn [col-settings]
                                                    (reduce-kv convert-column-settings {} col-settings)))
      (m/update-existing ::mb.viz/click-behavior convert-click-behavior)
      mb.viz/norm->db))
(defn- dashboard-cards-for-dashboard
  [dashboard]
  (let [dashboard-cards   (t2/select DashboardCard :dashboard_id (u/the-id dashboard))
        series            (when (not-empty dashboard-cards)
                            (t2/select DashboardCardSeries
                              :dashboardcard_id [:in (map u/the-id dashboard-cards)]))]
    (for [dashboard-card dashboard-cards]
      (-> dashboard-card
          (assoc :series (for [series series
                               :when (= (:dashboardcard_id series) (u/the-id dashboard-card))]
                           (-> series
                               (update :card_id (partial fully-qualified-name Card))
                               (dissoc :id :dashboardcard_id))))
          (assoc :visualization_settings (convert-viz-settings (:visualization_settings dashboard-card)))
          strip-crud))))
(defmethod serialize-one Dashboard
  [dashboard]
  (assoc dashboard :dashboard_cards (dashboard-cards-for-dashboard dashboard)))
(defmethod serialize-one Card
  [card]
  (-> card
      (m/update-existing :table_id (partial fully-qualified-name Table))
      (update :database_id (partial fully-qualified-name Database))
      (m/update-existing :visualization_settings convert-viz-settings)))
(defmethod serialize-one Pulse
  [pulse]
  (assoc pulse
    :cards    (for [card (t2/select PulseCard :pulse_id (u/the-id pulse))]
                (-> card
                    (dissoc :id :pulse_id)
                    (update :card_id (partial fully-qualified-name Card))))
    :channels (for [channel (t2/select PulseChannel :pulse_id (u/the-id pulse))]
                (strip-crud channel))))
(defmethod serialize-one User
  [user]
  (select-keys user [:first_name :last_name :email :is_superuser]))
(defmethod serialize-one Dimension
  [dimension]
  (-> dimension
      (update :field_id (partial fully-qualified-name Field))
      (update :human_readable_field_id (partial fully-qualified-name Field))))
(defmethod serialize-one NativeQuerySnippet
  [snippet]
  (select-keys snippet [:name :description :content]))
 

Upsert-or-skip functionality for our models.

(ns metabase-enterprise.serialization.upsert
  (:require
   [cheshire.core :as json]
   [clojure.data :as data]
   [medley.core :as m]
   [metabase-enterprise.serialization.names :refer [name-for-logging]]
   [metabase.models.card :refer [Card]]
   [metabase.models.collection :refer [Collection]]
   [metabase.models.dashboard :refer [Dashboard]]
   [metabase.models.dashboard-card :refer [DashboardCard]]
   [metabase.models.dashboard-card-series :refer [DashboardCardSeries]]
   [metabase.models.database :as database :refer [Database]]
   [metabase.models.dimension :refer [Dimension]]
   [metabase.models.field :refer [Field]]
   [metabase.models.field-values :refer [FieldValues]]
   [metabase.models.metric :refer [Metric]]
   [metabase.models.native-query-snippet :refer [NativeQuerySnippet]]
   [metabase.models.pulse :refer [Pulse]]
   [metabase.models.pulse-card :refer [PulseCard]]
   [metabase.models.pulse-channel :refer [PulseChannel]]
   [metabase.models.segment :refer [Segment]]
   [metabase.models.setting :as setting :refer [Setting]]
   [metabase.models.table :refer [Table]]
   [metabase.models.user :refer [User]]
   [metabase.util :as u]
   [metabase.util.i18n :as i18n :refer [trs]]
   [metabase.util.log :as log]
   [methodical.core :as methodical]
   [toucan2.core :as t2]
   [toucan2.tools.after :as t2.after]))
(def ^:private identity-condition
  {Database            [:name :engine]
   Table               [:schema :name :db_id]
   Field               [:name :table_id]
   Metric              [:name :table_id]
   Segment             [:name :table_id]
   Collection          [:name :location :namespace]
   Dashboard           [:name :collection_id]
   DashboardCard       [:card_id :dashboard_id :visualization_settings]
   DashboardCardSeries [:dashboardcard_id :card_id]
   FieldValues         [:field_id]
   Dimension           [:field_id :human_readable_field_id]
   Setting             [:key]
   Pulse               [:name :collection_id]
   PulseCard           [:pulse_id :card_id]
   PulseChannel        [:pulse_id :channel_type :details]
   Card                [:name :collection_id]
   User                [:email]
   NativeQuerySnippet  [:name :collection_id]})

This could potentially be unrolled into one giant select

(defn- select-identical
  [model entity]
  (->> (or (identity-condition model)
           (throw (ex-info (trs "Model {0} does not support upsert" model) {:model model})))
       (select-keys entity)
       (m/map-vals (fn [v]
                     (if (coll? v)
                       (json/encode v)
                       v)))
       (m/mapply t2/select-one model)))
(defn- has-post-insert?
  [model]
  (not (methodical/is-default-primary-method? t2.after/each-row-fn [:toucan.query-type/insert.* model])))

Execute body and catch and log any exceptions doing so throws.

(defmacro with-error-handling
  [message & body]
  `(try
     (do ~@body)
     (catch Throwable e#
       (log/error e# (u/format-color 'red "%s: %s" ~message (.getMessage e#)))
       nil)))
(defn- insert-many-individually!
  [model on-error entities]
  (for [entity entities]
    (when-let [entity-id (if (= :abort on-error)
                           (first (t2/insert-returning-pks! model entity))
                           (with-error-handling
                             (trs "Error inserting {0}" (name-for-logging model entity))
                             (first (t2/insert-returning-pks! model entity))))]
      entity-id)))
(defn- maybe-insert-many!
  [model on-error entities]
  (if (has-post-insert? model)
    (insert-many-individually! model on-error entities)
    (if (= :abort on-error)
      (t2/insert-returning-pks! model entities)
      (try
        (t2/insert-returning-pks! model entities)
        ;; Retry each individually so we can do as much as we can
        (catch Throwable _
          (insert-many-individually! model on-error entities))))))

Return entities grouped by the action that needs to be done given the context.

(defn- group-by-action
  [{:keys [mode]} model entities]
  (let [same? (comp nil? second data/diff)]
    (->> entities
         (map-indexed (fn [position entity]
                        [position
                         entity
                         (select-identical model entity)]))
         (group-by (fn [[_ entity existing]]
                     (case mode
                       :update (cond
                                 (same? existing entity) :skip
                                 existing                :update
                                 :else                   :insert)
                       :skip   (if existing
                                 :skip
                                 :insert)))))))

Batch upsert many entities.

Within the context map, the following keys are recognized: mode indicates mode of operation for existing entities (:upsert or :skip), as per the identity-condition on-error indicates what to do in case of upsert error (:continue or :abort) pre-insert-fn (optional) is a function to call on each entity to be inserted, before it is inserted post-insert-fn (optional) is a function to call on each entity to be inserted, after it is inserted

(defn maybe-upsert-many!
  [{:keys [mode on-error pre-insert-fn post-insert-fn]
    :or   {pre-insert-fn  identity
           post-insert-fn identity}
    :as context}
   model
   entities]
  (let [{:keys [update insert skip]} (group-by-action context model entities)]
    (doseq [[_ entity _] insert]
      (log/info (trs "Inserting {0}" (name-for-logging (name model) entity))))
    (doseq [[_ _ existing] skip]
      (if (= mode :skip)
        (log/info (trs "{0} already exists -- skipping"  (name-for-logging (name model) existing)))
        (log/info (trs "Skipping {0} (nothing to update)" (name-for-logging (name model) existing)))))
    (doseq [[_ _ existing] update]
      (log/info (trs "Updating {0}" (name-for-logging (name model) existing))))
    (->> (concat (for [[position _ existing] skip]
                   [(u/the-id existing) position])
                 (map vector (map post-insert-fn
                                  (maybe-insert-many! model on-error (map (comp pre-insert-fn second) insert)))
                      (map first insert))
                 (for [[position entity existing] update]
                   (let [id (u/the-id existing)]
                     (if (= on-error :abort)
                       (t2/update! model id entity)
                       (with-error-handling
                         (trs "Error updating {0}" (name-for-logging (name model) entity))
                         (t2/update! model id entity)))
                     [id position])))
         (sort-by second)
         (map first))))
 

Finds all models with :entity_id columns, scans them for anything without a blank ID, and generates consistent entity_id based on their hashes.

Note that cross-JVM portability is required - but that's specified for [[java.util.Random]], so this should produce identical IDs on all platforms and JVM implementations.

(ns metabase-enterprise.serialization.v2.backfill-ids
  (:require
   [metabase-enterprise.serialization.v2.models :as serdes.models]
   [metabase.models.interface :as mi]
   [metabase.models.serialization :as serdes]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [toucan2.core :as t2]
   [toucan2.model :as t2.model]))

Updates all rows of a particular model to have :entity_id set, based on the [[serdes/identity-hash]].

(defn backfill-ids-for!
  [model]
  (let [missing (t2/select model :entity_id nil)
        pk      (first (t2/primary-keys model))]
    (when (seq missing)
      (log/info (trs "Backfilling entity_id for {0} rows of {1}" (pr-str (count missing)) (name model)))
      (doseq [entity missing
              :let [hashed (serdes/identity-hash entity)
                    eid    (u/generate-nano-id hashed)]]
        (t2/update! model (get entity pk) {:entity_id eid})))))

Returns true if the model has an :entity_id column.

(defn has-entity-id?
  [model]
  (or
    ;; toucan1 models
    (isa? model ::mi/entity-id)
    ;; toucan2 models
    (isa? model :hook/entity-id)))

Updates all rows of all models that are (a) serialized and (b) have entity_id columns to have the entity_id set. If the entity_id is NULL, it is set based on the [[serdes/identity-hash]] for that row.

(defn backfill-ids!
  []
  (doseq [model-name (concat serdes.models/exported-models serdes.models/inlined-models)
          :let [model (t2.model/resolve-model (symbol model-name))]
          :when (has-entity-id? model)]
    (backfill-ids-for! model)))
 
(ns metabase-enterprise.serialization.v2.entity-ids
  (:require
   [clojure.set :as set]
   [clojure.string :as str]
   [metabase.db :as mdb]
   [metabase.db.connection :as mdb.connection]
   [metabase.models]
   [metabase.models.serialization :as serdes]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

make sure all the models get loaded up so we can resolve them based on their table names.

TODO -- what about enterprise models that have entity_id? Don't know of any yet. We'll have to cross that bridge when we get there.

(comment metabase.models/keep-me)

Return a set of lower-cased names of all application database tables that have an entity_id column, excluding views.

(defn- entity-id-table-names
  []
  (with-open [conn (.getConnection mdb.connection/*application-db*)]
    (let [dbmeta (.getMetaData conn)]
      (with-open [tables-rset (.getTables dbmeta nil nil nil (into-array String ["TABLE"]))]
        (let [non-view-tables (into #{} (map (comp u/lower-case-en :table_name)) (resultset-seq tables-rset))]
          (with-open [rset (.getColumns dbmeta nil nil nil (case (mdb.connection/db-type)
                                                             :h2                "ENTITY_ID"
                                                             (:mysql :postgres) "entity_id"))]
            (let [entity-id-tables (into #{} (map (comp u/lower-case-en :table_name)) (resultset-seq rset))]
              (set/intersection non-view-tables entity-id-tables))))))))

Return a list of all toucan models.

(defn toucan-models
  []
  (->> (descendants :metabase/model)
       (filter #(= (namespace %) "model"))))

Create a map of (lower-cased) application DB table name -> corresponding Toucan model.

(defn- make-table-name->model
  []
  (into {}
        (for [model (toucan-models)
              :let  [table-name (some-> model t2/table-name name)]
              :when table-name
              ;; ignore any models defined in test namespaces.
              :when (not (str/includes? (namespace model) "test"))]
         [table-name model])))

Return a set of all Toucan models that have an entity_id column.

(defn- entity-id-models
  []
  (let [entity-id-table-names       (entity-id-table-names)
        table-name->model           (make-table-name->model)
        entity-id-table-name->model (into {}
                                          (map (fn [table-name]
                                                 (if-let [model (table-name->model table-name)]
                                                  [table-name model]
                                                  (throw (ex-info (trs "Model not found for table {0}" table-name)
                                                                  {:table-name table-name})))))
                                          entity-id-table-names)
        entity-id-models            (set (vals entity-id-table-name->model))]
    ;; make sure we've resolved all of the tables that have entity_id to their corresponding models.
    (when-not (= (count entity-id-table-names)
                 (count entity-id-models))
      (throw (ex-info (trs "{0} tables have entity_id; expected to resolve the same number of models, but only got {1}"
                           (count entity-id-table-names)
                           (count entity-id-models))
                      {:tables   entity-id-table-names
                       :resolved entity-id-table-name->model})))
    (set entity-id-models)))
(defn- seed-entity-id-for-instance! [model instance]
  (try
    (let [primary-key (first (t2/primary-keys model))
          pk-value    (get instance primary-key)]
      (when-not (some? pk-value)
        (throw (ex-info (format "Missing value for primary key column %s" (pr-str primary-key))
                        {:model       (name model)
                         :instance    instance
                         :primary-key primary-key})))
      (let [new-hash (serdes/identity-hash instance)]
        (log/infof "Update %s %s entity ID => %s" (name model) (pr-str pk-value) (pr-str new-hash))
        (t2/update! model pk-value {:entity_id new-hash}))
      {:update-count 1})
    (catch Throwable e
      (log/errorf e "Error updating entity ID: %s" (ex-message e))
      {:error-count 1})))
(defn- seed-entity-ids-for-model! [model]
  (log/infof "Seeding Entity IDs for model %s" (name model))
  (let [reducible-instances (t2/reducible-select model :entity_id nil)]
    (transduce
     (map (fn [instance]
            (seed-entity-id-for-instance! model instance)))
     (completing
      (partial merge-with +)
      (fn [{:keys [update-count error-count], :as results}]
        (when (pos? update-count)
          (log/infof "Updated %d %s instance(s) successfully." update-count (name model)))
        (when (pos? error-count)
          (log/infof "Failed to update %d %s instance(s) because of errors." error-count (name model)))
        results))
     {:update-count 0, :error-count 0}
     reducible-instances)))

Create entity IDs for any instances of models that support them but do not have them, i.e. find instances of models that have an entity_id column whose entity_id is nil and populate that column.

Returns truthy if all missing entity IDs were created successfully, and falsey if there were any errors.

(defn seed-entity-ids!
  []
  (log/info "Seeding Entity IDs")
  (mdb/setup-db!)
  (let [{:keys [error-count]} (transduce
                               (map seed-entity-ids-for-model!)
                               (completing (partial merge-with +))
                               {:update-count 0, :error-count 0}
                               (entity-id-models))]
    (zero? error-count)))
(defn- drop-entity-ids-for-model! [model]
  (log/infof "Dropping Entity IDs for model %s" (name model))
  (try
    (let [update-count (t2/update! model {:entity_id nil})]
      (when (pos? update-count)
        (log/infof "Updated %d %s instance(s) successfully." update-count (name model)))
      {:update-count update-count})
    (catch Throwable e
      (log/errorf e "Error dropping entity ID: %s" (ex-message e))
      {:error-count 1})))

Delete entity IDs for any models that have them. See #34871.

Returns truthy if all entity IDs were removed successfully, and falsey if there were any errors.

(defn drop-entity-ids!
  []
  (log/info "Dropping Entity IDs")
  (mdb/setup-db!)
  (let [{:keys [error-count]} (transduce
                                (map drop-entity-ids-for-model!)
                                (completing (partial merge-with +))
                                {:update-count 0, :error-count 0}
                                (entity-id-models))]
    (zero? error-count)))
 

Extraction is the first step in serializing a Metabase appdb so it can be eg. written to disk.

See the detailed descriptions of the (de)serialization processes in [[metabase.models.serialization]].

(ns metabase-enterprise.serialization.v2.extract
  (:require
   [clojure.set :as set]
   [clojure.string :as str]
   [metabase-enterprise.serialization.v2.backfill-ids :as serdes.backfill]
   [metabase-enterprise.serialization.v2.models :as serdes.models]
   [metabase.models :refer [Card Collection Dashboard DashboardCard]]
   [metabase.models.collection :as collection]
   [metabase.models.serialization :as serdes]
   [metabase.util :as u]
   [metabase.util.log :as log]
   [toucan2.core :as t2]))
(set! *warn-on-reflection* true)

Returns a set of models to export based on export opts

(defn- model-set
  [opts]
  (cond-> #{}
    (:include-field-values opts)
    (conj "FieldValues")
    (not (:no-collections opts))
    (into serdes.models/content)
    (not (:no-data-model opts))
    (into serdes.models/data-model)
    (not (:no-settings opts))
    (conj "Setting")))

Returns target seq filtered on given model name

(defn targets-of-type
  [targets model-name]
  (filter #(= (first %) model-name) targets))

Returns a targets seq with model type and given ids

(defn make-targets-of-type
  [model-name ids]
  (mapv vector (repeat model-name) ids))

Returns a set of collection IDs to export for the provided user, if any. If user-id is nil, do not include any personally-owned collections.

(defn- collection-set-for-user
  [user-id]
  (let [roots (t2/select Collection {:where [:and [:= :location "/"]
                                                  [:or [:= :personal_owner_id nil]
                                                       [:= :personal_owner_id user-id]]]})]
    ;; start with the special "nil" root collection ID
    (-> #{nil}
        (into (map :id) roots)
        (into (mapcat collection/descendant-ids) roots))))

Returns reducible stream of serializable entity maps, with :serdes/meta keys. Takes an options map which is passed on to [[serdes/extract-all]] for each model.

(defn- extract-metabase
  [{:keys [user-id] :as opts}]
  (log/tracef "Extracting Metabase with options: %s" (pr-str opts))
  (let [extract-opts (assoc opts :collection-set (collection-set-for-user user-id))]
    (eduction (map #(serdes/extract-all % extract-opts)) cat (model-set opts))))

Given a target seq, explore the contents of any collections looking for "leaks". For example, a Dashboard that contains Cards which are not (transitively) in the given set of collections, or a Card that depends on a Card as a model, which is not in the given collections.

Returns a data structure detailing the gaps. Use [[escape-report]] to output this data in a human-friendly format. Returns nil if there are no escaped values, which is useful for a test.

(defn- escape-analysis
  [targets]
  (let [collection-ids (into #{} (map second) (targets-of-type targets "Collection"))
        collection-set (into collection-ids (mapcat collection/descendant-ids) (t2/select Collection :id [:in collection-ids]))
        dashboards     (t2/select Dashboard :collection_id [:in collection-set])
        ;; All cards that are in this collection set.
        cards          (reduce set/union #{} (for [coll-id collection-set]
                                               (t2/select-pks-set Card :collection_id coll-id)))
        ;; Map of {dashboard-id #{DashboardCard}} for dashcards whose cards OR parameter-bound cards are outside the
        ;; transitive collection set.
        escaped-dashcards  (into {}
                                 (for [dash  dashboards
                                       :let [dcs (t2/select DashboardCard :dashboard_id (:id dash))
                                             escapees (->> dcs
                                                           (keep :card_id) ; Text cards have a nil card_id
                                                           set)
                                             params   (->> dcs
                                                           (mapcat :parameter_mappings)
                                                           (keep :card_id)
                                                           set)
                                             combined (set/difference (set/union escapees params) cards)]
                                       :when (seq combined)]
                                   [(:id dash) combined]))
        ;; {source-card-id target-card-id} the key is in the curated set, the value is not.
        all-cards          (for [id cards]
                             (t2/select-one [Card :id :collection_id :dataset_query] :id id))
        bad-source         (for [card all-cards
                                 :let [^String src (some-> card :dataset_query :query :source-table)]
                                 :when (and (string? src) (.startsWith src "card__"))
                                 :let [card-id (Integer/parseInt (.substring src 6))]
                                 :when (not (cards card-id))]
                             [(:id card) card-id])
        bad-template-tags  (for [card all-cards
                                 :let [card-ids (some->> card :dataset_query :native
                                                         :template-tags vals (keep :card-id))]
                                 card-id card-ids
                                 :when   (not (cards card-id))]
                             [(:id card) card-id])
        escaped-questions  (into {} (concat bad-source bad-template-tags))
        problem-cards      (reduce set/union (set (vals escaped-questions)) (vals escaped-dashcards))]
    (cond-> nil
      (seq escaped-dashcards) (assoc :escaped-dashcards escaped-dashcards)
      (seq escaped-questions) (assoc :escaped-questions escaped-questions)
      (seq problem-cards)     (assoc :problem-cards     problem-cards))))
(defn- collection-label [coll-id]
  (if coll-id
    (let [collection (t2/hydrate (t2/select-one Collection :id coll-id) :ancestors)
          names      (->> (conj (:ancestors collection) collection)
                          (map :name)
                          (str/join " > "))]
      (format "%d: %s" coll-id names))
    "[no collection]"))
(defn- card-label [card-id]
  (let [card (t2/select-one [Card :collection_id :name] :id card-id)]
    (format "Card %d (%s from collection %s)" card-id (:name card) (collection-label (:collection_id card)))))

Given the analysis map from [[escape-analysis]], report the results in a human-readable format with Card titles etc.

(defn- escape-report
  [{:keys [escaped-dashcards escaped-questions]}]
  (when-not (empty? escaped-dashcards)
    (doseq [[dash-id card-ids] escaped-dashcards
            :let [dash-name (t2/select-one-fn :name Dashboard :id dash-id)]]
      (log/warnf "Failed to export Dashboard %d (%s) containing Cards saved outside requested collections: %s"
                 dash-id dash-name (str/join ", " (map card-label card-ids)))))
  (when-not (empty? escaped-questions)
    (log/warnf "Failed to export Cards based on questions outside requested collections: %s"
               (str/join ", " (for [[curated-id alien-id] escaped-questions]
                                (str (card-label curated-id) " -> " (card-label alien-id)))))))

Extracts the targeted entities and all their descendants into a reducible stream of extracted maps.

The targeted entities are specified as a list of ["SomeModel" database-id] pairs.

[[serdes/descendants]] is recursively called on these entities and all their descendants, until the complete transitive closure of all descendants is found. This produces a set of ["ModelName" id] pairs, which entities are then extracted the same way as [[extract-metabase]]. Eg. if Dashboard B includes a Card A that is derived from a Card C that's in an alien collection, warnings will be emitted for C, A and B, and all three will be excluded from the serialized output.

(defn- extract-subtrees
  [{:keys [targets] :as opts}]
  (log/tracef "Extracting subtrees with options: %s" (pr-str opts))
  (if-let [analysis (escape-analysis targets)]
    ;; If that is non-nil, emit the report.
    (escape-report analysis)
    ;; If it's nil, there are no errors, and we can proceed to do the dump.
    ;; TODO This is not handled at all, but we should be able to exclude illegal data - and it should be
    ;; contagious. Eg. a Dashboard with an illegal Card gets excluded too.
    (let [nodes       (set/union
                       (u/traverse targets #(serdes/ascendants (first %) (second %)))
                       (u/traverse targets #(serdes/descendants (first %) (second %))))
          models      (model-set opts)
          ;; filter the selected models based on user options
          by-model    (-> (group-by first nodes)
                          (select-keys models)
                          (update-vals #(set (map second %))))
          extract-ids (fn [[model ids]]
                        (eduction (map #(serdes/extract-one model opts %))
                                  (t2/reducible-select (symbol model) :id [:in ids])))]
      (eduction cat
                [(eduction (map extract-ids) cat by-model)
                 ;; extract all non-content entities like data model and settings if necessary
                 (eduction (map #(serdes/extract-all % opts)) cat (remove (set serdes.models/content) models))]))))

Returns a reducible stream of entities to serialize

(defn extract
  [{:keys [targets] :as opts}]
  (serdes.backfill/backfill-ids!)
  (if (seq targets)
    (extract-subtrees opts)
    (extract-metabase opts)))
 

Ingestion is the first step in deserialization - reading from the export format (eg. a tree of YAML files) and producing Clojure maps with :serdes/meta keys.

See the detailed description of the (de)serialization processes in [[metabase.models.serialization]].

(ns metabase-enterprise.serialization.v2.ingest
  (:require
   [clojure.java.io :as io]
   [clojure.string :as str]
   [metabase.models.serialization :as serdes]
   [metabase.util.date-2 :as u.date]
   [metabase.util.yaml :as yaml]
   [potemkin.types :as p])
  (:import (java.io File)))
(set! *warn-on-reflection* true)
(p/defprotocol+ Ingestable
  ;; Represents a data source for deserializing previously-exported appdb content into this Metabase instance.
  ;; This is written as a protocol since overriding it with [[reify]] is useful for testing.
  (ingest-list
    [this]
    "Return a reducible stream of `:serdes/meta`-style abstract paths, one for each entity in the dump.
    See the description of these abstract paths in [[metabase.models.serialization]].
    Each path is ordered from the root to the leaf.
    The order of the whole list is not specified and should not be relied upon!")
  (ingest-one
    [this path]
    "Given one of the `:serdes/meta` abstract paths returned by [[ingest-list]], read in and return the entire
    corresponding entity."))
(defn- read-timestamps [entity]
  (->> (keys entity)
       (filter #(or (#{:last_analyzed} %)
                    (.endsWith (name %) "_at")))
       (reduce #(update %1 %2 u.date/parse) entity)))

Convert suitable string keys to clojure keywords, ignoring keys with whitespace, etc.

(defn- parse-key
  [{k :key}]
  (if (re-matches #"^[0-9a-zA-Z_\./\-]+$" k)
    (keyword k)
    k))
(defn- strip-labels
  [hierarchy]
  (mapv #(dissoc % :label) hierarchy))

Reads an entity YAML file and clean it up (eg. parsing timestamps) The returned entity is in "extracted" form, ready to be passed to the load step.

(defn- ingest-file
  [file]
  (-> file
      (yaml/from-file {:key-fn parse-key})
      read-timestamps))
(def ^:private legal-top-level-paths
  #{"actions" "collections" "databases" "snippets"}) ; But return the hierarchy without labels.
(defn- ingest-all [^File root-dir]
  ;; This returns a map {unlabeled-hierarchy [original-hierarchy File]}.
  (into {} (for [^File file (file-seq root-dir)
                 :when      (and (.isFile file)
                                 (str/ends-with? (.getName file) ".yaml")
                                 (let [rel (.relativize (.toPath root-dir) (.toPath file))]
                                   (-> rel (.subpath 0 1) (.toString) legal-top-level-paths)))
                 ;; TODO: only load YAML once.
                 :let [hierarchy (serdes/path (ingest-file file))]]
             [(strip-labels hierarchy) [hierarchy file]])))
(deftype YamlIngestion [^File root-dir settings cache]
  Ingestable
  (ingest-list [_]
    (-> (or @cache (reset! cache (ingest-all root-dir)))
        keys
        ;; add settings ingestion paths
        (concat (for [k (keys settings)]
                  [{:model "Setting" :id (name k)}]))))
  (ingest-one [_ abs-path]
    (when-not @cache
      (reset! cache (ingest-all root-dir)))
    (let [{:keys [id]} (first abs-path)
          kw-id        (keyword id)]
      (if (= ["Setting"] (mapv :model abs-path))
        {:serdes/meta abs-path :key kw-id :value (get settings kw-id)}
        (->> abs-path
             strip-labels
             (get @cache)
             second
             ingest-file)))))

Creates a new Ingestable on a directory of YAML files, as created by [[metabase-enterprise.serialization.v2.storage.yaml]].

(defn ingest-yaml
  [root-dir]
  (->YamlIngestion (io/file root-dir) (yaml/from-file (io/file root-dir "settings.yaml")) (atom nil)))
 

Loading is the interesting part of deserialization: integrating the maps "ingested" from files into the appdb. See the detailed breakdown of the (de)serialization processes in [[metabase.models.serialization]].

(ns metabase-enterprise.serialization.v2.load
  (:require
   [medley.core :as m]
   [metabase-enterprise.serialization.v2.backfill-ids :as serdes.backfill]
   [metabase-enterprise.serialization.v2.ingest :as serdes.ingest]
   [metabase.models.serialization :as serdes]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]))
(declare load-one!)

Given a list of deps (hierarchies), [[load-one]] them all. If [[load-one]] throws because it can't find that entity in the filesystem, check if it's already loaded in our database.

(defn- load-deps!
  [ctx deps]
  (if (empty? deps)
    ctx
    (letfn [(loader [ctx dep]
              (try
                (load-one! ctx dep)
                (catch Exception e
                  (if (and (= (:error (ex-data e)) ::not-found)
                           (serdes/load-find-local dep))
                    ;; It was missing but we found it locally, so just return the context.
                    ctx
                    ;; Different error, or couldn't find it locally, so rethrow.
                    (throw e)))))]
      (reduce loader ctx deps))))

Loads a single entity, specified by its :serdes/meta abstract path, into the appdb, doing some bookkeeping to avoid cycles.

If the incoming entity has any dependencies, they are recursively processed first (postorder) so that any foreign key references in this entity can be resolved properly.

This is mostly bookkeeping for the overall deserialization process - the actual load of any given entity is done by [[metabase.models.serialization/load-one!]] and its various overridable parts, which see.

Circular dependencies are not allowed, and are detected and thrown as an error.

(defn- load-one!
  [{:keys [expanding ingestion seen] :as ctx} path]
  (log/info (trs "Loading {0}" (serdes/log-path-str path)))
  (cond
    (expanding path) (throw (ex-info (format "Circular dependency on %s" (pr-str path)) {:path path}))
    (seen path) ctx ; Already been done, just skip it.
    :else (let [ingested (try
                           (serdes.ingest/ingest-one ingestion path)
                           (catch Exception e
                             (throw (ex-info (format "Failed to read file for %s" (pr-str path))
                                             {:path       path
                                              :deps-chain expanding
                                              :error      ::not-found}
                                             e))))
                deps     (serdes/dependencies ingested)
                ctx      (-> ctx
                             (update :expanding conj path)
                             (load-deps! deps)
                             (update :seen conj path)
                             (update :expanding disj path))
                ;; Use the abstract path as attached by the ingestion process, not the original one we were passed.
                rebuilt-path    (serdes/path ingested)
                local-or-nil    (serdes/load-find-local rebuilt-path)]
            (try
              (serdes/load-one! ingested local-or-nil)
              ctx
              (catch Exception e
                (throw (ex-info (format "Failed to load into database for %s" (pr-str path))
                                {:path       path
                                 :deps-chain expanding}
                                e)))))))
(defn- try-load-one!
  [ctx path]
  (try
    (load-one! ctx path)
    (catch Exception e
      (log/error (trs "Error importing {0}. Continuing..." (serdes/log-path-str path)))
      (update ctx :errors conj e))))

Loads in a database export from an ingestion source, which is any Ingestable instance.

(defn load-metabase!
  [ingestion & {:keys [abort-on-error] :or {abort-on-error true}}]
  ;; We proceed in the arbitrary order of ingest-list, deserializing all the files. Their declared dependencies guide
  ;; the import, and make sure all containers are imported before contents, etc.
  (serdes.backfill/backfill-ids!)
  (let [contents (serdes.ingest/ingest-list ingestion)
        ctx      {:expanding #{}
                  :seen      #{}
                  :ingestion ingestion
                  :from-ids  (m/index-by :id contents)
                  :errors    []}
        result   (reduce (if abort-on-error load-one! try-load-one!) ctx contents)]
    (when-let [errors (seq (:errors result))]
      (log/error (trs "Errors were encountered during import."))
      (doseq [e errors]
        (log/error e "Import error details:")))
    result))
 
(ns metabase-enterprise.serialization.v2.models)

Schema model types

(def data-model
  ["Database"
   "Field"
   "Metric"
   "Segment"
   "Table"])

Content model types

(def content
  ["Action"
   "Card"
   "Collection"
   "Dashboard"
   "NativeQuerySnippet"
   "Timeline"])

The list of all models exported by serialization by default. Used for production code and by tests.

(def exported-models
  (concat data-model
          content
          ["FieldValues"
           "Setting"]))

An additional list of models which are inlined into parent entities for serialization. These are not extracted and serialized separately, but they may need some processing done. For example, the models should also have their entity_id fields populated (if they have one).

(def inlined-models
  ["DashboardCard"
   "DashboardTab"
   "Dimension"
   "ParameterCard"
   "TimelineEvent"])

List of models which are not going to be serialized ever.

(def excluded-models
  ["Activity"
   "ApiKey"
   "ApplicationPermissionsRevision"
   "AuditLog"
   "BookmarkOrdering"
   "CardBookmark"
   "CollectionBookmark"
   "CollectionPermissionGraphRevision"
   "ConnectionImpersonation"
   "DashboardBookmark"
   "DashboardCardSeries"
   "GroupTableAccessPolicy"
   "HTTPAction"
   "ImplicitAction"
   "LoginHistory"
   "MetricImportantField"
   "ModelIndex"
   "ModelIndexValue"
   "ModerationReview"
   "Permissions"
   "PermissionsGroup"
   "PermissionsGroupMembership"
   "PermissionsRevision"
   "PersistedInfo"
   "Pulse"
   "PulseCard"
   "PulseChannel"
   "PulseChannelRecipient"
   "Query"
   "QueryAction"
   "QueryCache"
   "QueryExecution"
   "RecentViews"
   "Revision"
   "Secret"
   "Session"
   "TablePrivileges"
   "TaskHistory"
   "User"
   "ViewLog"])
 
(ns metabase-enterprise.serialization.v2.storage
  (:require [clojure.java.io :as io]
            [clojure.string :as str]
            [metabase-enterprise.serialization.dump :refer [spit-yaml!]]
            [metabase.models.serialization :as serdes]
            [metabase.util.i18n :refer [trs]]
            [metabase.util.log :as log]))
(set! *warn-on-reflection* true)

Given a path segment, which is supposed to be the name of a single file or directory, escape any slashes inside it. This occurs in practice, for example with a Field.name containing a slash like "Company/organization website".

(defn- escape-segment
  [segment]
  (-> segment
      (str/replace "/"  "__SLASH__")
      (str/replace "\\" "__BACKSLASH__")))
(defn- file
  [ctx entity]
  (let [;; Get the desired [[serdes/storage-path]].
        base-path   (serdes/storage-path entity ctx)
        dirnames    (drop-last base-path)
        ;; Attach the file extension to the last part.
        basename    (str (last base-path) ".yaml")]
    (apply io/file (:root-dir ctx) (map escape-segment (concat dirnames [basename])))))
(defn- store-entity! [opts entity]
  (log/info (trs "Storing {0}" (serdes/log-path-str (:serdes/meta entity))))
  (spit-yaml! (file opts entity) entity))
(defn- store-settings! [{:keys [root-dir]} settings]
  (when (seq settings)
    (let [as-map (into (sorted-map)
                       (for [{:keys [key value]} settings]
                         [key value]))]
      (spit-yaml! (io/file root-dir "settings.yaml") as-map))))

Helper for storing a serialized database to a tree of YAML files.

(defn store!
  [stream root-dir]
  (let [settings (atom [])
        opts     (merge {:root-dir root-dir} (serdes/storage-base-context))]
    (doseq [entity stream]
      (if (-> entity :serdes/meta last :model (= "Setting"))
        (swap! settings conj entity)
        (store-entity! opts entity)))
    (store-settings! opts @settings)))
 
(ns metabase-enterprise.snippet-collections.api.native-query-snippet
  (:require
   [metabase.public-settings.premium-features :refer [defenterprise]]
   [metabase.util.honey-sql-2 :as h2x]))

Clause to filter out snippet collections from the collection query on OSS instances, and instances without the snippet-collections feature flag. EE implementation returns nil, so as to not filter out snippet collections.

(defenterprise snippets-collection-filter-clause
  :feature :snippet-collections
  [])

Collection children query for snippets on EE.

(defenterprise snippets-collection-children-query
  :feature :snippet-collections
  [collection {:keys [archived?]}]
  {:select [:id :name :entity_id [(h2x/literal "snippet") :model]]
   :from   [[:native_query_snippet :nqs]]
   :where  [:and
            [:= :collection_id (:id collection)]
            [:= :archived (boolean archived?)]]})
 

EE implementation of NativeQuerySnippet permissions.

(ns metabase-enterprise.snippet-collections.models.native-query-snippet.permissions
  (:require
   [metabase.models.interface :as mi]
   [metabase.models.native-query-snippet.permissions :as snippet.perms]
   [metabase.models.permissions :as perms]
   [metabase.public-settings.premium-features
    :as premium-features
    :refer [defenterprise]]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2]))
(mu/defn ^:private has-parent-collection-perms?
  [snippet       :- [:map [:collection_id [:maybe ms/PositiveInt]]]
   read-or-write :- [:enum :read :write]]
  (mi/current-user-has-full-permissions? (perms/perms-objects-set-for-parent-collection "snippets" snippet read-or-write)))

Can the current User read this snippet?

(defenterprise can-read?
  :feature :snippet-collections
  ([snippet]
   (and
    (not (premium-features/sandboxed-user?))
    (snippet.perms/has-any-native-permissions?)
    (has-parent-collection-perms? snippet :read)))
  ([model id]
   (can-read? (t2/select-one [model :collection_id] :id id))))

Can the current User edit this snippet?

(defenterprise can-write?
  :feature :snippet-collections
  ([snippet]
   (and
    (not (premium-features/sandboxed-user?))
    (snippet.perms/has-any-native-permissions?)
    (has-parent-collection-perms? snippet :write)))
  ([model id]
   (can-write? (t2/select-one [model :collection_id] :id id))))

Can the current User save a new Snippet with the values in m?

(defenterprise can-create?
  :feature :snippet-collections
  [_model m]
  (and
   (not (premium-features/sandboxed-user?))
   (snippet.perms/has-any-native-permissions?)
   (has-parent-collection-perms? m :write)))

Can the current User apply a map of changes to a snippet?

(defenterprise can-update?
  :feature :snippet-collections
  [snippet changes]
  (and
   (not (premium-features/sandboxed-user?))
   (snippet.perms/has-any-native-permissions?)
   (has-parent-collection-perms? snippet :write)
   (or (not (contains? changes :collection_id))
       (has-parent-collection-perms? changes :write))))
 
(ns metabase-enterprise.sso.api.interface
  (:require
   [metabase-enterprise.sso.integrations.sso-settings :as sso-settings]
   [metabase.util.i18n :refer [tru]]))

Function that powers the defmulti in figuring out which SSO backend to use. It might be that we need to have more complex logic around this, but now it's just a simple priority. If SAML is configured use that otherwise JWT

(defn- sso-backend
  [_]
  (cond
    (sso-settings/saml-enabled) :saml
    (sso-settings/jwt-enabled)  :jwt
    :else                       nil))

Multi-method for supporting the first part of an SSO signin request. An implementation of this method will usually result in a redirect to an SSO backend

(defmulti sso-get
  sso-backend)

Multi-method for supporting a POST-back from an SSO signin request. An implementation of this method will need to validate the POST from the SSO backend and successfully log the user into Metabase.

(defmulti sso-post
  sso-backend)
(defn- throw-not-configured-error []
  (throw (ex-info (str (tru "SSO has not been enabled and/or configured"))
                  {:status-code 400})))
(defmethod sso-get :default
  [_]
  (throw-not-configured-error))
(defmethod sso-post :default
  [_]
  (throw-not-configured-error))
 
(ns metabase-enterprise.sso.api.routes
  (:require
   [compojure.core :as compojure]
   [metabase-enterprise.sso.api.saml :as saml]
   [metabase-enterprise.sso.api.sso :as sso]))

Ring routes for auth (SAML) API endpoints.

This needs to be injected into [[metabase.server.routes/routes]] -- not [[metabase.api.routes/routes]] !!!

TODO -- should we make a metabase-enterprise.routes namespace where this can live instead of injecting it directly?

TODO -- we need to feature-flag this based on the :sso- feature flags

(compojure/defroutes  routes
  (compojure/context
    "/auth"
    []
    (compojure/routes
     (compojure/context "/sso" [] sso/routes)))
  (compojure/context
    "/api"
    []
    (compojure/routes
     (compojure/context "/saml" [] saml/routes))))
 

/api/saml endpoints

(ns metabase-enterprise.sso.api.saml
  (:require
   [clojure.string :as str]
   [compojure.core :refer [PUT]]
   [metabase.api.common :as api]
   [metabase.models.setting :as setting]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.util.i18n :refer [tru]]
   [saml20-clj.core :as saml]))
(set! *warn-on-reflection* true)

/settings

(api/defendpoint PUT 
  "Update SAML related settings. You must be a superuser to do this."
  [:as {settings :body}]
  {settings :map}
  (api/check-superuser)
  (premium-features/assert-has-feature :sso-saml (tru "SAML-based authentication"))
  (let [filename (:saml-keystore-path settings)
        password (:saml-keystore-password settings)
        alias (:saml-keystore-alias settings)]
    (if (or (every? str/blank? [filename password alias])
            (saml/has-private-key? {:filename filename
                                    :password password
                                    :alias    alias}))
      (setting/set-many! settings)
      ;; test failed, return result message
      {:status 400
       :body   "Error finding private key in provided keystore and alias."})))
(api/define-routes)
 

/auth/sso Routes.

Implements the SSO routes needed for SAML and JWT. This namespace primarily provides hooks for those two backends so we can have a uniform interface both via the API and code

(ns metabase-enterprise.sso.api.sso
  (:require
   [compojure.core :refer [GET POST]]
   [metabase-enterprise.sso.api.interface :as sso.i]
   [metabase-enterprise.sso.integrations.jwt]
   [metabase-enterprise.sso.integrations.saml]
   [metabase.api.common :as api]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs]]
   [metabase.util.log :as log]
   [stencil.core :as stencil]))
(set! *warn-on-reflection* true)

load the SSO integrations so their implementations for the multimethods below are available.

(comment metabase-enterprise.sso.integrations.jwt/keep-me
         metabase-enterprise.sso.integrations.saml/keep-me)

/

(api/defendpoint GET 
  "SSO entry-point for an SSO user that has not logged in yet"
  [:as req]
  (try
    (sso.i/sso-get req)
    (catch Throwable e
      (log/error #_e (trs "Error returning SSO entry point"))
      (throw e))))
(defn- sso-error-page [^Throwable e]
  {:status  (get (ex-data e) :status-code 500)
   :headers {"Content-Type" "text/html"}
   :body    (stencil/render-file "metabase_enterprise/sandbox/api/error_page"
              (let [message    (.getMessage e)
                    data       (u/pprint-to-str (ex-data e))]
                {:errorMessage   message
                 :exceptionClass (.getName Exception)
                 :additionalData data}))})

/

(api/defendpoint POST 
  "Route the SSO backends call with successful login details"
  [:as req]
  (try
    (sso.i/sso-post req)
    (catch Throwable e
      (log/error e (trs "Error logging in"))
      (sso-error-page e))))
(api/define-routes)
 

Implementation of the JWT backend for sso

(ns metabase-enterprise.sso.integrations.jwt
  (:require
   [buddy.sign.jwt :as jwt]
   [clojure.string :as str]
   [java-time.api :as t]
   [metabase-enterprise.sso.api.interface :as sso.i]
   [metabase-enterprise.sso.integrations.sso-settings :as sso-settings]
   [metabase-enterprise.sso.integrations.sso-utils :as sso-utils]
   [metabase.api.common :as api]
   [metabase.api.session :as api.session]
   [metabase.integrations.common :as integrations.common]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.server.middleware.session :as mw.session]
   [metabase.server.request.util :as request.u]
   [metabase.util.i18n :refer [tru]]
   [ring.util.response :as response])
  (:import
   (java.net URLEncoder)))
(set! *warn-on-reflection* true)

Returns a session map for the given email. Will create the user if needed.

(defn fetch-or-create-user!
  [first-name last-name email user-attributes]
  (when-not (sso-settings/jwt-enabled)
    (throw (IllegalArgumentException. (str (tru "Can't create new JWT user when JWT is not configured")))))
  (let [user {:first_name       first-name
              :last_name        last-name
              :email            email
              :sso_source       :jwt
              :login_attributes user-attributes}]
    (or (sso-utils/fetch-and-update-login-attributes! user)
        (sso-utils/create-new-sso-user! user))))
(def ^:private ^{:arglists '([])} jwt-attribute-email     (comp keyword sso-settings/jwt-attribute-email))
(def ^:private ^{:arglists '([])} jwt-attribute-firstname (comp keyword sso-settings/jwt-attribute-firstname))
(def ^:private ^{:arglists '([])} jwt-attribute-lastname  (comp keyword sso-settings/jwt-attribute-lastname))
(def ^:private ^{:arglists '([])} jwt-attribute-groups    (comp keyword sso-settings/jwt-attribute-groups))
(defn- jwt-data->login-attributes [jwt-data]
  (dissoc jwt-data
          (jwt-attribute-email)
          (jwt-attribute-firstname)
          (jwt-attribute-lastname)
          :iat
          :max_age))

JWTs use seconds since Epoch, not milliseconds since Epoch for the iat and max_age time. 3 minutes is the time used by Zendesk for their JWT SSO, so it seemed like a good place for us to start

(def ^:private ^:const three-minutes-in-seconds 180)

Translate a user's group names to a set of MB group IDs using the configured mappings

(defn- group-names->ids
  [group-names]
  (set (mapcat (sso-settings/jwt-group-mappings)
               (map keyword group-names))))

Returns the set of all MB group IDs that have configured mappings

(defn- all-mapped-group-ids
  []
  (-> (sso-settings/jwt-group-mappings)
      vals
      flatten
      set))

Sync a user's groups based on mappings configured in the JWT settings

(defn- sync-groups!
  [user jwt-data]
  (when (sso-settings/jwt-group-sync)
    (when-let [groups-attribute (jwt-attribute-groups)]
      (when-let [group-names (get jwt-data groups-attribute)]
        (integrations.common/sync-group-memberships! user
                                                     (group-names->ids group-names)
                                                     (all-mapped-group-ids))))))
(defn- login-jwt-user
  [jwt {{redirect :return_to} :params, :as request}]
  (let [redirect-url (or redirect (URLEncoder/encode "/"))]
    (sso-utils/check-sso-redirect redirect-url)
    (let [jwt-data     (try
                         (jwt/unsign jwt (sso-settings/jwt-shared-secret)
                                     {:max-age three-minutes-in-seconds})
                         (catch Throwable e
                           (throw (ex-info (ex-message e)
                                           (assoc (ex-data e) :status-code 401)
                                           e))))
          login-attrs  (jwt-data->login-attributes jwt-data)
          email        (get jwt-data (jwt-attribute-email))
          first-name   (get jwt-data (jwt-attribute-firstname))
          last-name    (get jwt-data (jwt-attribute-lastname))
          user         (fetch-or-create-user! first-name last-name email login-attrs)
          session      (api.session/create-session! :sso user (request.u/device-info request))]
      (sync-groups! user jwt-data)
      (mw.session/set-session-cookies request (response/redirect redirect-url) session (t/zoned-date-time (t/zone-id "GMT"))))))
(defn- check-jwt-enabled []
  (api/check (sso-settings/jwt-enabled)
    [400 (tru "JWT SSO has not been enabled and/or configured")]))
(defmethod sso.i/sso-get :jwt
  [{{:keys [jwt redirect]} :params, :as request}]
  (premium-features/assert-has-feature :sso-jwt (tru "JWT-based authentication"))
  (check-jwt-enabled)
  (if jwt
    (login-jwt-user jwt request)
    (let [idp (sso-settings/jwt-identity-provider-uri)
          return-to-param (if (str/includes? idp "?") "&return_to=" "?return_to=")]
      (response/redirect (str idp (when redirect
                                   (str return-to-param redirect)))))))
(defmethod sso.i/sso-post :jwt
  [_]
  (throw (ex-info "POST not valid for JWT SSO requests" {:status-code 400})))
 

Implementation of the SAML backend for SSO.

The basic flow of of a SAML login is:

  1. User attempts to access some url but is not authenticated

  2. User is redirected to GET /auth/sso

  3. Metabase issues another redirect to the identity provider URI

  4. User logs into their identity provider (i.e. Auth0)

  5. Identity provider POSTs to Metabase with successful auth info

  6. Metabase parses/validates the SAML response

  7. Metabase inits the user session, responds with a redirect to back to the original url

(ns metabase-enterprise.sso.integrations.saml
  (:require
   [buddy.core.codecs :as codecs]
   [clojure.string :as str]
   [java-time.api :as t]
   [medley.core :as m]
   [metabase-enterprise.sso.api.interface :as sso.i]
   [metabase-enterprise.sso.integrations.sso-settings :as sso-settings]
   [metabase-enterprise.sso.integrations.sso-utils :as sso-utils]
   [metabase.api.common :as api]
   [metabase.api.session :as api.session]
   [metabase.integrations.common :as integrations.common]
   [metabase.public-settings :as public-settings]
   [metabase.public-settings.premium-features :as premium-features]
   [metabase.server.middleware.session :as mw.session]
   [metabase.server.request.util :as request.u]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [ring.util.response :as response]
   [saml20-clj.core :as saml]
   [schema.core :as s])
  (:import
   (java.net URI URISyntaxException)
   (java.util Base64 UUID)))
(set! *warn-on-reflection* true)

Translate a user's group names to a set of MB group IDs using the configured mappings

(defn- group-names->ids
  [group-names]
  (->> (cond-> group-names (string? group-names) vector)
       (map keyword)
       (mapcat (sso-settings/saml-group-mappings))
       set))

Returns the set of all MB group IDs that have configured mappings

(defn- all-mapped-group-ids
  []
  (-> (sso-settings/saml-group-mappings)
      vals
      flatten
      set))

Sync a user's groups based on mappings configured in the SAML settings

(defn- sync-groups!
  [user group-names]
  (when (sso-settings/saml-group-sync)
    (when group-names
      (integrations.common/sync-group-memberships! user
                                                   (group-names->ids group-names)
                                                   (all-mapped-group-ids)))))
(s/defn ^:private fetch-or-create-user! :- (s/maybe {:id UUID, s/Keyword s/Any})
  "Returns a Session for the given `email`. Will create the user if needed."
  [{:keys [first-name last-name email group-names user-attributes device-info]}]
  (when-not (sso-settings/saml-enabled)
    (throw (IllegalArgumentException. (tru "Can't create new SAML user when SAML is not enabled"))))
  (when-not email
    (throw (ex-info (str (tru "Invalid SAML configuration: could not find user email.")
                         " "
                         (tru "We tried looking for {0}, but couldn't find the attribute."
                              (sso-settings/saml-attribute-email))
                         " "
                         (tru "Please make sure your SAML IdP is properly configured."))
                    {:status-code 400, :user-attributes (keys user-attributes)})))
  (let [new-user {:first_name       first-name
                  :last_name        last-name
                  :email            email
                  :sso_source       :saml
                  :login_attributes user-attributes}]
    (when-let [user (or (sso-utils/fetch-and-update-login-attributes! new-user)
                        (sso-utils/create-new-sso-user! new-user))]
      (sync-groups! user group-names)
      (api.session/create-session! :sso user device-info))))

SAML route supporting functions

(defn- acs-url []
  (str (public-settings/site-url) "/auth/sso"))
(defn- sp-cert-keystore-details []
  (when-let [path (sso-settings/saml-keystore-path)]
    (when-let [password (sso-settings/saml-keystore-password)]
      (when-let [key-name (sso-settings/saml-keystore-alias)]
        {:filename path
         :password password
         :alias    key-name}))))
(defn- check-saml-enabled []
  (api/check (sso-settings/saml-enabled)
    [400 (tru "SAML has not been enabled and/or configured")]))
(defn- has-host? [uri]
  (try
    (-> uri URI. .getHost some?)
    (catch URISyntaxException _ false)))
(defmethod sso.i/sso-get :saml
  ;; Initial call that will result in a redirect to the IDP along with information about how the IDP can authenticate
  ;; and redirect them back to us
  [req]
  (premium-features/assert-has-feature :sso-saml (tru "SAML-based authentication"))
  (check-saml-enabled)
  (let [redirect (get-in req [:params :redirect])
        redirect-url (if (nil? redirect)
                       (do
                         (log/warn (trs "Warning: expected `redirect` param, but none is present"))
                         (public-settings/site-url))
                       (if (has-host? redirect)
                         redirect
                         (str (public-settings/site-url) redirect)))]
    (sso-utils/check-sso-redirect redirect-url)
    (try
      (let [idp-url      (sso-settings/saml-identity-provider-uri)
            saml-request (saml/request
                           {:request-id (str "id-" (random-uuid))
                            :sp-name    (sso-settings/saml-application-name)
                            :issuer     (sso-settings/saml-application-name)
                            :acs-url    (acs-url)
                            :idp-url    idp-url
                            :credential (sp-cert-keystore-details)})
            relay-state  (saml/str->base64 redirect-url)]
        (saml/idp-redirect-response saml-request idp-url relay-state))
     (catch Throwable e
       (let [msg (trs "Error generating SAML request")]
         (log/error e msg)
         (throw (ex-info msg {:status-code 500} e)))))))
(defn- validate-response [response]
  (let [idp-cert (or (sso-settings/saml-identity-provider-certificate)
                     (throw (ex-info (str (tru "Unable to log in: SAML IdP certificate is not set."))
                                     {:status-code 500})))]
    (try
      (saml/validate response idp-cert (sp-cert-keystore-details) {:acs-url (acs-url)
                                                                   :issuer  (sso-settings/saml-identity-provider-issuer)})
      (catch Throwable e
        (log/error e (trs "SAML response validation failed"))
        (throw (ex-info (tru "Unable to log in: SAML response validation failed")
                        {:status-code 401}
                        e))))))
(defn- xml-string->saml-response [xml-string]
  (validate-response (saml/->Response xml-string)))

For some reason all of the user attributes coming back from the saml library are wrapped in a list, instead of 'Ryan', it's ('Ryan'). This function discards the list if there's just a single item in it.

(defn- unwrap-user-attributes
  [m]
  (m/map-vals (fn [maybe-coll]
                (if (and (coll? maybe-coll)
                         (= 1 (count maybe-coll)))
                  (first maybe-coll)
                  maybe-coll))
              m))
(defn- saml-response->attributes [saml-response]
  (let [assertions (saml/assertions saml-response)
        attrs      (-> assertions first :attrs unwrap-user-attributes)]
    (when-not attrs
      (throw (ex-info (str (tru "Unable to log in: SAML info does not contain user attributes."))
                      {:status-code 401})))
    attrs))
(defn- base64-decode [^String s]
  (when (u/base64-string? s)
    (codecs/bytes->str
      (.decode (Base64/getMimeDecoder) s))))
(defmethod sso.i/sso-post :saml
  ;; Does the verification of the IDP's response and 'logs the user in'. The attributes are available in the response:
  ;; `(get-in saml-info [:assertions :attrs])
  [{:keys [params], :as request}]
  (premium-features/assert-has-feature :sso-saml (tru "SAML-based authentication"))
  (check-saml-enabled)
  (let [continue-url  (u/ignore-exceptions
                        (when-let [s (some-> (:RelayState params) base64-decode)]
                          (when-not (str/blank? s)
                            s)))]
    (sso-utils/check-sso-redirect continue-url)
    (let [xml-string    (str/trim (base64-decode (:SAMLResponse params)))
          saml-response (xml-string->saml-response xml-string)
          attrs         (saml-response->attributes saml-response)
          email         (get attrs (sso-settings/saml-attribute-email))
          first-name    (get attrs (sso-settings/saml-attribute-firstname))
          last-name     (get attrs (sso-settings/saml-attribute-lastname))
          groups        (get attrs (sso-settings/saml-attribute-group))
          session       (fetch-or-create-user!
                          {:first-name      first-name
                           :last-name       last-name
                           :email           email
                           :group-names     groups
                           :user-attributes attrs
                           :device-info     (request.u/device-info request)})
          response      (response/redirect (or continue-url (public-settings/site-url)))]
      (mw.session/set-session-cookies request response session (t/zoned-date-time (t/zone-id "GMT"))))))
 

Namesapce for defining settings used by the SSO backends. This is separate as both the functions needed to support the SSO backends and the generic routing code used to determine which SSO backend to use need this information. Separating out this information creates a better dependency graph and avoids circular dependencies.

(ns metabase-enterprise.sso.integrations.sso-settings
  (:require
   [malli.core :as mc]
   [metabase.integrations.common :as integrations.common]
   [metabase.models.setting :as setting :refer [defsetting]]
   [metabase.models.setting.multi-setting :refer [define-multi-setting-impl]]
   [metabase.public-settings :as public-settings]
   [metabase.util.i18n :refer [deferred-tru trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [saml20-clj.core :as saml]
   [schema.core :as s]))
(set! *warn-on-reflection* true)
(def ^:private GroupMappings
  [:maybe [:map-of ms/KeywordOrString [:sequential ms/PositiveInt]]])
(def ^:private ^{:arglists '([group-mappings])} validate-group-mappings
  (mc/validator GroupMappings))
(defsetting saml-identity-provider-uri
  (deferred-tru "This is the URL where your users go to log in to your identity provider. Depending on which IdP you''re
using, this usually looks like https://your-org-name.example.com or https://example.com/app/my_saml_app/abc123/sso/saml")
  :feature :sso-saml
  :audit   :getter)

Validate that an encoded identity provider certificate is valid, or throw an Exception.

(s/defn ^:private validate-saml-idp-cert
  [idp-cert-str :- s/Str]
  (try
    (instance? java.security.cert.X509Certificate (saml/->X509Certificate idp-cert-str))
    (catch Throwable e
      (log/error e (trs "Error parsing SAML identity provider certificate"))
      (throw
       (Exception. (tru "Invalid identity provider certificate. Certificate should be a base-64 encoded string."))))))
(defsetting saml-identity-provider-certificate
  (deferred-tru "Encoded certificate for the identity provider. Depending on your IdP, you might need to download this,
open it in a text editor, then copy and paste the certificate's contents here.")
  :feature :sso-saml
  :audit   :no-value
  :setter  (fn [new-value]
            ;; when setting the idp cert validate that it's something we
             (when new-value
               (validate-saml-idp-cert new-value))
             (setting/set-value-of-type! :string :saml-identity-provider-certificate new-value)))
(defsetting saml-identity-provider-issuer
  (deferred-tru "This is a unique identifier for the IdP. Often referred to as Entity ID or simply 'Issuer'. Depending
on your IdP, this usually looks something like http://www.example.com/141xkex604w0Q5PN724v")
  :feature :sso-saml
  :audit   :getter)
(defsetting saml-application-name
  (deferred-tru "This application name will be used for requests to the Identity Provider")
  :default "Metabase"
  :feature :sso-saml
  :audit   :getter)
(defsetting saml-keystore-path
  (deferred-tru "Absolute path to the Keystore file to use for signing SAML requests")
  :feature :sso-saml
  :audit   :getter)
(defsetting saml-keystore-password
  (deferred-tru "Password for opening the keystore")
  :default    "changeit"
  :sensitive? true
  :feature    :sso-saml
  :audit      :getter)
(defsetting saml-keystore-alias
  (deferred-tru "Alias for the key that {0} should use for signing SAML requests"
                (public-settings/application-name-for-setting-descriptions))
  :default "metabase"
  :feature :sso-saml
  :audit   :getter)
(defsetting saml-attribute-email
  (deferred-tru "SAML attribute for the user''s email address")
  :default "http://schemas.xmlsoap.org/ws/2005/05/identity/claims/emailaddress"
  :feature :sso-saml
  :audit   :getter)
(defsetting saml-attribute-firstname
  (deferred-tru "SAML attribute for the user''s first name")
  :default "http://schemas.xmlsoap.org/ws/2005/05/identity/claims/givenname"
  :feature :sso-saml
  :audit   :getter)
(defsetting saml-attribute-lastname
  (deferred-tru "SAML attribute for the user''s last name")
  :default "http://schemas.xmlsoap.org/ws/2005/05/identity/claims/surname"
  :feature :sso-saml
  :audit   :getter)
(defsetting saml-group-sync
  (deferred-tru "Enable group membership synchronization with SAML.")
  :type    :boolean
  :default false
  :feature :sso-saml
  :audit   :getter)
(defsetting saml-attribute-group
  (deferred-tru "SAML attribute for group syncing")
  :default "member_of"
  :feature :sso-saml
  :audit   :getter)
(defsetting saml-group-mappings
  ;; Should be in the form: {"groupName": [1, 2, 3]} where keys are SAML groups and values are lists of MB groups IDs
  (deferred-tru "JSON containing SAML to {0} group mappings."
                (public-settings/application-name-for-setting-descriptions))
  :type    :json
  :cache?  false
  :default {}
  :feature :sso-saml
  :audit   :getter
  :setter  (comp (partial setting/set-value-of-type! :json :saml-group-mappings)
                 (partial mu/validate-throw validate-group-mappings)))
(defsetting saml-configured
  (deferred-tru "Are the mandatory SAML settings configured?")
  :type    :boolean
  :default false
  :feature :sso-saml
  :setter  :none
  :getter  (fn [] (boolean
                   (and (saml-identity-provider-uri)
                        (saml-identity-provider-certificate)))))
(defsetting saml-enabled
  (deferred-tru "Is SAML authentication configured and enabled?")
  :type    :boolean
  :default false
  :feature :sso-saml
  :audit   :getter
  :getter  (fn []
             (if (saml-configured)
               (setting/get-value-of-type :boolean :saml-enabled)
               false)))
(defsetting jwt-identity-provider-uri
  (deferred-tru "URL of JWT based login page")
  :feature :sso-jwt
  :audit   :getter)
(defsetting jwt-shared-secret
  (deferred-tru (str "String used to seed the private key used to validate JWT messages."
                     " "
                     "A hexadecimal-encoded 256-bit key (i.e., a 64-character string) is strongly recommended."))
  :type    :string
  :feature :sso-jwt
  :audit   :no-value)
(defsetting jwt-attribute-email
  (deferred-tru "Key to retrieve the JWT user's email address")
  :default "email"
  :feature :sso-jwt
  :audit   :getter)
(defsetting jwt-attribute-firstname
  (deferred-tru "Key to retrieve the JWT user's first name")
  :default "first_name"
  :feature :sso-jwt
  :audit   :getter)
(defsetting jwt-attribute-lastname
  (deferred-tru "Key to retrieve the JWT user's last name")
  :default "last_name"
  :feature :sso-jwt
  :audit   :getter)
(defsetting jwt-attribute-groups
  (deferred-tru "Key to retrieve the JWT user's groups")
  :default "groups"
  :feature :sso-jwt
  :audit   :getter)
(defsetting jwt-group-sync
  (deferred-tru "Enable group membership synchronization with JWT.")
  :type    :boolean
  :default false
  :feature :sso-jwt
  :audit   :getter)
(defsetting jwt-group-mappings
  ;; Should be in the form: {"groupName": [1, 2, 3]} where keys are JWT groups and values are lists of MB groups IDs
  (deferred-tru "JSON containing JWT to {0} group mappings."
                (public-settings/application-name-for-setting-descriptions))
  :type    :json
  :cache?  false
  :default {}
  :feature :sso-jwt
  :audit   :getter
  :setter  (comp (partial setting/set-value-of-type! :json :jwt-group-mappings)
                 (partial mu/validate-throw validate-group-mappings)))
(defsetting jwt-configured
  (deferred-tru "Are the mandatory JWT settings configured?")
  :type    :boolean
  :default false
  :feature :sso-jwt
  :setter  :none
  :getter  (fn [] (boolean
                   (and (jwt-identity-provider-uri)
                        (jwt-shared-secret)))))
(defsetting jwt-enabled
  (deferred-tru "Is JWT authentication configured and enabled?")
  :type    :boolean
  :default false
  :feature :sso-jwt
  :audit   :getter
  :getter  (fn []
             (if (jwt-configured)
               (setting/get-value-of-type :boolean :jwt-enabled)
               false)))
(define-multi-setting-impl integrations.common/send-new-sso-user-admin-email? :ee
  :getter (fn [] (setting/get-value-of-type :boolean :send-new-sso-user-admin-email?))
  :setter (fn [send-emails] (setting/set-value-of-type! :boolean :send-new-sso-user-admin-email? send-emails)))

Are we using an SSO integration other than LDAP or Google Auth? These integrations use the /auth/sso endpoint for authorization rather than the normal login form or Google Auth button.

(defsetting other-sso-enabled?
  :visibility :public
  :setter     :none
  :getter     (fn [] (or (saml-enabled) (jwt-enabled))))
 

Functions shared by the various SSO implementations

(ns metabase-enterprise.sso.integrations.sso-utils
  (:require
   [metabase.api.common :as api]
   [metabase.email.messages :as messages]
   [metabase.events :as events]
   [metabase.integrations.common :as integrations.common]
   [metabase.models.user :refer [User]]
   [metabase.public-settings :as public-settings]
   [metabase.util :as u]
   [metabase.util.i18n :refer [trs tru]]
   [metabase.util.log :as log]
   [metabase.util.malli :as mu]
   [metabase.util.malli.schema :as ms]
   [toucan2.core :as t2])
  (:import
   (clojure.lang ExceptionInfo)
   (java.net URI)))
(set! *warn-on-reflection* true)
(def ^:private UserAttributes
  [:map {:closed true}
   [:first_name       [:maybe ms/NonBlankString]]
   [:last_name        [:maybe ms/NonBlankString]]
   [:email            ms/Email]
   ;; TODO - we should avoid hardcoding this to make it easier to add new integrations. Maybe look at something like
   ;; the keys of `(methods sso/sso-get)`
   [:sso_source       [:enum :saml :jwt]]
   [:login_attributes [:maybe :map]]])

This function is basically the same thing as the create-new-google-auth-user from metabase.models.user. We need to refactor the core_user table structure and the function used to populate it so that the enterprise product can reuse it

(mu/defn create-new-sso-user!
  [user :- UserAttributes]
  (try
    (u/prog1 (first (t2/insert-returning-instances! User (merge user {:password (str (random-uuid))})))
      (log/info (trs "New SSO user created: {0} ({1})" (:common_name <>) (:email <>)))
      ;; publish user-invited event for audit logging
      (events/publish-event! :event/user-invited {:object (assoc <> :sso_source (:sso_source user))})
      ;; send an email to everyone including the site admin if that's set
      (when (integrations.common/send-new-sso-user-admin-email?)
        (messages/send-user-joined-admin-notification-email! <>, :google-auth? true)))
    (catch ExceptionInfo e
      (log/error e "Error creating new SSO user")
      (throw (ex-info (trs "Error creating new SSO user")
                      {:user user})))))

Update :first_name, :last_name, and :login_attributes for the user at email. This call is a no-op if the mentioned key values are equal.

(defn fetch-and-update-login-attributes!
  [{:keys [email] :as user-from-sso}]
  (when-let [{:keys [id] :as user} (t2/select-one User :%lower.email (u/lower-case-en email))]
    (let [user-keys (keys user-from-sso)
          ;; remove keys with `nil` values
          user-data (into {} (filter second user-from-sso))]
      (if (= (select-keys user user-keys) user-data)
        user
        (do
          (t2/update! User id user-data)
          (t2/select-one User :id id))))))

Check if open redirect is being exploited in SSO. If so, or if the redirect-url is invalid, throw a 400.

(defn check-sso-redirect
  [redirect-url]
  (try
    (let [host        (some-> redirect-url (URI.) (.getHost))
          our-host    (some-> (public-settings/site-url) (URI.) (.getHost))]
      (api/check-400 (or (nil? redirect-url) (nil? host) (= host our-host))))
    (catch Exception e
      (log/error e "Invalid redirect URL")
      (throw (ex-info (tru "Invalid redirect URL")
                      {:status-code 400
                       :redirect-url redirect-url})))))
 
(ns metabase-enterprise.task.truncate-audit-tables
  (:require
   [metabase.public-settings.premium-features :refer [defenterprise]]))

List of models to truncate, as well as the name of the column containing the row's timestamp. EE version adds audit_log and view_log truncation

(defenterprise audit-models-to-truncate
  :feature :audit-app
  []
  [{:model :model/QueryExecution :timestamp-col :started_at}
   {:model :model/AuditLog       :timestamp-col :timestamp}
   {:model :model/ViewLog        :timestamp-col :timestamp}])